Vm-dev February 2017

vm-dev@lists.squeakfoundation.org

24 participants
79 discussions

pinning & QEMU processor simulation
by Ben Coman 06 Feb '17

06 Feb '17

I understand we already have ARM processor simulation working, but I bumped into this post... http://lists.squeakfoundation.org/pipermail/vm-dev/2012-March/010210.html saying QEMU was not feasible since its dynamic translation is interacts badly with GC moving the ByteArray holding the Cog heap. I was just curious if QEMU would be feasible now have object pinning? cheers -ben

1 0

VM Maker: VMMaker.oscogSPC-eem.2121.mcz
by commits＠source.squeak.org 05 Feb '17

05 Feb '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2121.mcz ==================== Summary ==================== Name: VMMaker.oscogSPC-eem.2121 Author: eem Time: 5 February 2017, 1:33:43.291073 pm UUID: abe8d392-f88f-4a14-9149-ae41afe9ecf2 Ancestors: VMMaker.oscogSPC-eem.2120 Fix a couple of typos that cause the generated C code to miscompile or not compile. =============== Diff against VMMaker.oscogSPC-eem.2120 =============== Item was changed: ----- Method: CogObjectRepresentationForSpur>>branchIf:isNotOop:target: (in category 'sista support') ----- + branchIf: reg isNotOop: oop target: targetFixUp - branchIf: reg isNotOop: oop target: targetFixup <var: #targetFixUp type: #'AbstractInstruction *'> <inline: true> cogit CmpCq: oop R: reg. + cogit JumpNonZero: targetFixUp. + ^0! - cogit JumpNonZero: targetFixup. - ^ 0! Item was changed: ----- Method: CogObjectRepresentationForSpur>>branchIf:isOop:target: (in category 'sista support') ----- + branchIf: reg isOop: oop target: targetFixUp - branchIf: reg isOop: oop target: targetFixup <var: #targetFixUp type: #'AbstractInstruction *'> <inline: true> cogit CmpCq: oop R: reg. + cogit JumpZero: targetFixUp. + ^0! - cogit JumpZero: targetFixup. - ^ 0! Item was changed: ----- Method: SpurPlanningCompactor>>unmarkObjectsAfterLastMobileObject (in category 'compaction') ----- unmarkObjectsAfterLastMobileObject "Sweep the final immobile heap, freeing and coalescing unmarked and free objects, and unmarking all marked objects up to the end of memory." | startOfFree freeBytes | freeBytes := 0. manager allOldSpaceEntitiesFrom: objectAfterLastMobileObject do: [:o| self check: o. (manager isMarked: o) ifFalse: [startOfFree ifNil: [startOfFree := manager startOfObject: o]. + freeBytes := freeBytes + (manager bytesInObject: o)] - freeBytes := freeBytes + manager bytesInObject: o] ifTrue: [startOfFree ifNotNil: [manager addFreeChunkWithBytes: freeBytes at: startOfFree. startOfFree := nil. freeBytes := 0]. + (manager isPinned: o) + ifTrue: [self unmarkPinned: o] + ifFalse: [manager setIsMarkedOf: o to: false]]]! - (manager isSegmentBridge: o) ifFalse: - [manager setIsMarkedOf: o to: false]]]!

1 0

VM Maker: VMMaker.oscogSPC-eem.2120.mcz
by commits＠source.squeak.org 04 Feb '17

04 Feb '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2120.mcz ==================== Summary ==================== Name: VMMaker.oscogSPC-eem.2120 Author: eem Time: 3 February 2017, 5:15:09.757345 pm UUID: aacf677d-aa1a-46a0-8aeb-eba4d634c8ac Ancestors: VMMaker.oscogSPC-eem.2119 SpurPlanningCompactor: Add tests for multi-pass. Get the transition from first to subsequent passes correct (scan starts at firstMobileObject; previous pass must initialize, but not free the memory at toFinger, and set firstFreeObject to this; all objects from firstFreeObject to lastMobileObject must be unmarked to avoid copying them twice). Optimize the three mobile passes to cache startOfPreviousPin since if there are pins, most of the moves will occur under a pin. Rename onePass to finalPass in them because this is what it really means. Simulation: Use simulatorClass throghout SpurMemoryManager in deriving the support classes (scavenger, compactor et al). Move the simulation-obly behaviour down from SpurPlanningCompactor to SpurPlanningCompactorSimulator. =============== Diff against VMMaker.oscogSPC-eem.2119 =============== Item was added: + ----- Method: SpurGenerationScavenger class>>simulatorClass (in category 'simulation') ----- + simulatorClass + ^SpurGenerationScavengerSimulator! Item was changed: ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'spur bootstrap') ----- allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes "Intialize the receiver for bootsraping an image. Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold will be set to sane values." <doNotGenerate> self assert: (memoryBytes \\ self allocationUnit = 0 and: [newSpaceBytes \\ self allocationUnit = 0 and: [codeBytes \\ self allocationUnit = 0]]). self allocateMemoryOfSize: memoryBytes + newSpaceBytes + codeBytes + stackBytes. newSpaceStart := codeBytes + stackBytes. endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes. "leave newSpace empty for the bootstrap" freeStart := newSpaceBytes + newSpaceStart. oldSpaceStart := newSpaceLimit := newSpaceBytes + newSpaceStart. scavengeThreshold := memory size * memory bytesPerElement. "i.e. /don't/ scavenge." + scavenger := SpurGenerationScavenger simulatorClass new. - scavenger := SpurGenerationScavengerSimulator new. scavenger manager: self. scavenger newSpaceStart: newSpaceStart newSpaceBytes: newSpaceBytes survivorBytes: newSpaceBytes // self scavengerDenominator. + compactor := self class compactorClass simulatorClass new manager: self; yourself! - compactor := self class compactorClass new manager: self; yourself.! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. remapBufferCount := extraRootCount := 0. "see below" freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := marking := false. becomeEffectsFlags := gcPhaseInProgress := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := 0. statRootTableOverflows := statMarkCount := statCompactPassCount := statCoalesces := 0. "We can initialize things that are allocated but are lazily initialized." unscannedEphemerons := SpurContiguousObjStack new. "we can initialize things that are virtual in C." + scavenger := SpurGenerationScavenger simulatorClass new manager: self; yourself. + segmentManager := SpurSegmentManager simulatorClass new manager: self; yourself. + compactor := self class compactorClass simulatorClass new manager: self; yourself. - scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. - segmentManager := SpurSegmentManager new manager: self; yourself. - compactor := self class compactorClass new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := CogCheck32BitHeapMap new. "N.B. We *don't* initialize extraRoots because we don't simulate it." maxOldSpaceSize := self class initializationOptions ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]] ifNil: [0]! Item was changed: CogClass subclass: #SpurPlanningCompactor + instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet anomaly objectAfterLastMobileObject' - instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject relocationMap' classVariableNames: '' poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMBytecodeConstants VMSpurObjectRepresentationConstants' category: 'VMMaker-SpurMemoryManager'! !SpurPlanningCompactor commentStamp: 'eem 12/23/2016 17:50' prior: 0! SpurPlanningCompactor implements the classic planning compaction algorithm for Spur. It makes at least three passes through the heap. The first pass plans where live movable objects will go, copying their forwarding field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location. The second pass updates all pointers in live pointer objects to point to objects' final destinations. The third pass moves objects to their final positions, unmarking objects as it does so. If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes are made until the entire heap has been compacted. Instance Variables biasForGC <Boolean> coInterpreter: <StackInterpreter> firstFieldOfRememberedSet <Oop> firstFreeObject <Oop> firstMobileObject <Oop> lastMobileObject <Oop> manager: <SpurMemoryManager> savedFirstFieldsSpace <SpurContiguousObjStack> savedFirstFieldsSpaceWasAllocated <Boolean> scavenger: <SpurGenerationScavenger> biasForGC - true if compacting for GC, in which case do only one pass, or false if compacting for snapshot, in which case do as many passes as necessary to compact the entire heap. firstFieldOfRememberedSet - the saved first field of the rememberedSet. The rememberedSet must be relocated specially because it is not a pointer object. And hence the first field needs to be extracted for proper relocation. firstFreeObject - the first free object in a compaction pass. firstMobileObject - the first mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. lastMobileObject - the last mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. savedFirstFieldsSpace - the space holding the saved first fields, each overwritten by a forwarding pointer, for the objects from firstMobileObject through to lastMobileObject. savedFirstFieldsSpaceWasAllocated - if true, the memory for savedFirstFieldsSpace was obtained via a call of sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:! Item was changed: ----- Method: SpurPlanningCompactor class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator self declareCAsOop: (self instVarNames select: [:iv| iv endsWith: 'Object']) in: aCCodeGenerator. aCCodeGenerator + var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack! - var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack; - removeVariable: 'interestingObj'; - removeVariable: 'relocationMap'! Item was added: + ----- Method: SpurPlanningCompactor class>>simulatorClass (in category 'simulation') ----- + simulatorClass + ^SpurPlanningCompactorSimulator! Item was changed: ----- Method: SpurPlanningCompactor>>check: (in category 'private') ----- check: obj + "No-op in the real class." + <inline: true>! - <inline: true> - self cCode: '' inSmalltalk: [obj = interestingObj ifTrue: [self halt]]. - "this debugged the misuse of the largest free chunk:" - "(manager checkForLeaks bitAnd: GCModeFull+GCModeFreeSpace) = GCModeFull ifTrue: - [self deny: ((manager isEnumerableObject: obj) and: [(manager heapMapAtWord: obj) = 0])]"! Item was changed: ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') ----- compact "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. Let the segmentManager mark which segments contain pinned objects via notePinned:." + | finalPass firstPass | - | onePass firstPass | <inline: #never> "for profiling" self initializeScanCheckingForFullyCompactedHeap ifTrue: [^self unmarkObjectsInFullyCompactedHeap]. self initializeCompaction. firstPass := true. + [finalPass := self planCompactSavingForwarders. + self assert: (self validRelocationPlanInPass: finalPass) = 0. - [onePass := self planCompactSavingForwarders. - self assert: (self validRelocationPlanInPass: onePass) = 0. objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject. self updatePointers. self copyAndUnmark: firstPass. "Would like to check here, but can't if multi-pass." false ifTrue: [manager checkFreeSpace: GCModeFull]. + "Currently we do only a single pass if a normal GC, assuming that a pass will + always compact plenty of space. But we should perhaps check this assumption + by looking at the large free tree and seeing that the ratio of the largest free + chunk to the total ammount of free space is high." + finalPass or: [biasForGC]] whileFalse: - onePass or: [biasForGC]] whileFalse: [firstPass := false. + self reinitializeScanFrom: firstFreeObject; - self reinitializeScanFrom: objectAfterLastMobileObject; updateSavedFirstFieldsSpaceIfNecessary]. manager checkFreeSpace: GCModeFull. self endCompaction! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmark: (in category 'compaction') ----- copyAndUnmark: firstPass "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, restoring their savedFirstFields." <inline: #never> + | finalPass | - | onePass | self logPhase: 'copying and unmarking...'. firstPass ifTrue: [self unmarkInitialImmobileObjects]. "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass." savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self assert: ((self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory) or: [lastMobileObject < firstMobileObject]). ^self]. + finalPass := self copyAndUnmarkMobileObjects. + (finalPass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true." - onePass := self copyAndUnmarkMobileObjects. - (onePass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true." [self unmarkObjectsAfterLastMobileObject]! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') ----- copyAndUnmarkMobileObjects "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects match. We could implement them as a single enumeration method taking several block arguments, but arguably that would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)." <inline: #never> + | toFinger top previousPin startOfPreviousPin | - | toFinger top previousPin | <var: 'o' type: #usqInt> <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> <var: 'previousPin' type: #usqInt> + <var: 'startOfPreviousPin' type: #usqInt> self deny: (manager isMarked: firstFreeObject). toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start. + startOfPreviousPin := 0. manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject to: lastMobileObject do: [:o :n| self check: o. self assert: (previousPin ifNil: [toFinger <= (manager startOfObject: o)] + ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]). - ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]). self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [previousPin ifNil: + [previousPin := o. startOfPreviousPin := manager startOfObject: o]] - [previousPin := o]] ifFalse: [| availableSpace bytes | bytes := manager bytesInObject: o. + [toFinger <= startOfPreviousPin + and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger) + and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: - [previousPin notNil - and: [availableSpace := (manager startOfObject: previousPin) - toFinger. - bytes ~= availableSpace - and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger up to point at the first unmarked or mobile object after previousPin, or, if previousPin is contiguous with o, to the start of this object. Update previousPin to be the next pinned object above toFInger and below this object, or nil if no such pinned object exists. Any unfillable gaps between adjacent pinned objects will be freed." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. [self assert: ((manager isMarked: previousPin) and: [manager isPinned: previousPin]). self unmarkPinned: previousPin. toFinger := manager addressAfter: previousPin. previousPin := manager objectStartingAt: toFinger. (manager isMarked: previousPin) and: [(manager isPinned: previousPin) and: [previousPin < o]]] whileTrue. "Now previousPin is either equal to o or mobile. Move it to the next pinned object below o" [previousPin >= o or: [(manager isMarked: previousPin) and: [manager isPinned: previousPin]]] whileFalse: [previousPin := manager oldSpaceObjectAfter: previousPin]. + previousPin >= o + ifTrue: [previousPin := nil. startOfPreviousPin := 0] + ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]]. - previousPin >= o ifTrue: - [previousPin := nil]]. self copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: (manager longAt: top). toFinger := toFinger + bytes. (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). self assert: n = objectAfterLastMobileObject. + previousPin ifNil: [previousPin := n. startOfPreviousPin := manager startOfObject: n]. + "Create a free object for firstFreeObject to be set to on the next pass, but + do not link it into the free tree as it will be written over in that next pass." + toFinger < startOfPreviousPin + ifTrue: + [firstFreeObject := manager initFreeChunkWithBytes: startOfPreviousPin - toFinger at: toFinger] + ifFalse: + [firstFreeObject := previousPin]. - self freeFrom: toFinger upTo: (manager startOfObject: n) nextObject: (previousPin ifNil: [n]). ^false]]]]. self freeFrom: toFinger upTo: manager endOfMemory nextObject: (previousPin ifNil: [objectAfterLastMobileObject]). self coalesceFrom: toFinger. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>forwardMobileObject:to:savedFirstFieldPtr: (in category 'private') ----- forwardMobileObject: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr "Forward a mobile object to some new location, saving its first field through savedFirstFieldPtr. Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer." <inline: true> lastMobileObject := o. manager longAt: savedFirstFieldPtr put: (manager fetchPointer: 0 ofObject: o); storePointerUnchecked: 0 ofObject: o withValue: ((manager hasOverflowHeader: o) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]). + self recordMovementOf: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr! - self cCode: '' inSmalltalk: [relocationMap ifNotNil: [:rm| rm at: o put: savedFirstFieldPtr]]! Item was changed: ----- Method: SpurPlanningCompactor>>initializeScanCheckingForFullyCompactedHeap (in category 'compaction') ----- initializeScanCheckingForFullyCompactedHeap "Scan for firstFreeObject and firstMobileObject from the start of memory. Answer if the heap is already fully compacted." + firstMobileObject := lastMobileObject := objectAfterLastMobileObject := nil. self reinitializeScanFrom: manager hiddenRootsObject. firstFreeObject ifNil: [self error: 'uncompactable heap; no unmarked objects found']. ^firstMobileObject >= manager endOfMemory! Item was removed: - ----- Method: SpurPlanningCompactor>>interestingObj: (in category 'instance initialization') ----- - interestingObj: obj - interestingObj := obj! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects match. We could implement them as a single enumeration method taking several block arguments, but arguably that would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)." <inline: #never> + | toFinger top previousPin startOfPreviousPin | - | toFinger top previousPin | <var: 'o' type: #usqInt> <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> <var: 'previousPin' type: #usqInt> + <var: 'startOfPreviousPin' type: #usqInt> savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self logPhase: 'planning...']. self deny: (manager isMarked: firstFreeObject). toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start. + startOfPreviousPin := 0. manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin ifNil: [toFinger <= (manager startOfObject: o)] + ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]). - ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]). self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [previousPin ifNil: + [previousPin := o. startOfPreviousPin := manager startOfObject: o]] - [previousPin := o]] ifFalse: [| availableSpace bytes | bytes := manager bytesInObject: o. + [toFinger <= startOfPreviousPin + and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger) + and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: - [previousPin notNil - and: [availableSpace := (manager startOfObject: previousPin) - toFinger. - bytes ~= availableSpace - and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger up to point at the first unmarked or mobile object after previousPin, or, if previousPin is contiguous with o, to the start of this object. Update previousPin to be the next pinned object above toFInger and below this object, or nil if no such pinned object exists. Any unfillable gaps between adjacent pinned objects will be freed." [toFinger := manager addressAfter: previousPin. previousPin := manager objectStartingAt: toFinger. (manager isMarked: previousPin) and: [(manager isPinned: previousPin) and: [previousPin < o]]] whileTrue. "Now previousPin is either equal to o or mobile. Move it to the next pinned object below o" [previousPin >= o or: [(manager isMarked: previousPin) and: [manager isPinned: previousPin]]] whileFalse: [previousPin := manager oldSpaceObjectAfter: previousPin]. + previousPin >= o + ifTrue: [previousPin := nil. startOfPreviousPin := 0] + ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]]. - previousPin >= o ifTrue: - [previousPin := nil]]. self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top. toFinger := toFinger + bytes. (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^false]]]]. savedFirstFieldsSpace top: top - manager bytesPerOop. ^true! Item was added: + ----- Method: SpurPlanningCompactor>>recordMovementOf:to:savedFirstFieldPtr: (in category 'private') ----- + recordMovementOf: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr + "No-op in the real class." + <inline: true>! Item was removed: - ----- Method: SpurPlanningCompactor>>recordMovements (in category 'compaction') ----- - recordMovements - relocationMap := Dictionary new! Item was changed: ----- Method: SpurPlanningCompactor>>reinitializeScanFrom: (in category 'compaction') ----- reinitializeScanFrom: initialObject "Search for firstFreeObject and firstMobileObject from initialObject, which is the hiddenRootsObject on the first pass, and the objectAfterLastMobileObject on subsequent passes)." firstMobileObject := manager endOfMemory. firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: initialObject. firstFreeObject ifNotNil: + [mobileStart := manager startOfObject: firstFreeObject]. + objectAfterLastMobileObject ifNotNil: + [manager allOldSpaceEntitiesFrom: firstFreeObject to: objectAfterLastMobileObject do: + [:o| + ((manager isPinned: o) + or: [(manager isMarked: o) not + or: [objectAfterLastMobileObject = o]]) ifFalse: + [manager setIsMarkedOf: o to: false]]. + firstMobileObject := objectAfterLastMobileObject]! - [mobileStart := manager startOfObject: firstFreeObject]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInInitialImmobileObjects (in category 'compaction') ----- updatePointersInInitialImmobileObjects "Sweep the initial immobile heap, updating all references to mobile objects to their eventual locations." manager allOldSpaceObjectsFrom: manager firstObject do: [:o| self check: o. (self oop: o isGreaterThanOrEqualTo: firstFreeObject) ifTrue: [^self]. + "would like to assert this, but it isn't true if more than one pass: self assert: (manager isMarked: o)." - self assert: (manager isMarked: o). self updatePointersIn: o]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') ----- updatePointersInMobileObjects "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects match. We could implement them as a single enumeration method taking several block arguments, but arguably that would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)." + | toFinger top previousPin startOfPreviousPin | - | toFinger top previousPin | <var: 'o' type: #usqInt> <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> <var: 'previousPin' type: #usqInt> + <var: 'startOfPreviousPin' type: #usqInt> self deny: (manager isMarked: firstFreeObject). toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start. + startOfPreviousPin := 0. manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin ifNil: [toFinger <= (manager startOfObject: o)] + ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]). - ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [previousPin ifNil: + [previousPin := o. startOfPreviousPin := manager startOfObject: o]. - [previousPin := o]. self updatePointersIn: o] ifFalse: [| availableSpace bytes | bytes := manager bytesInObject: o. + [toFinger <= startOfPreviousPin + and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger) + and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: - [previousPin notNil - and: [availableSpace := (manager startOfObject: previousPin) - toFinger. - bytes ~= availableSpace - and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger up to point at the first unmarked or mobile object after previousPin, or, if previousPin is contiguous with o, to the start of this object. Update previousPin to be the next pinned object above toFInger and below this object, or nil if no such pinned object exists. Any unfillable gaps between adjacent pinned objects will be freed." [toFinger := manager addressAfter: previousPin. previousPin := manager objectStartingAt: toFinger. (manager isMarked: previousPin) and: [(manager isPinned: previousPin) and: [previousPin < o]]] whileTrue. "Now previousPin is either equal to o or mobile. Move it to the next pinned object below o" [previousPin >= o or: [(manager isMarked: previousPin) and: [manager isPinned: previousPin]]] whileFalse: [previousPin := manager oldSpaceObjectAfter: previousPin]. + previousPin >= o + ifTrue: [previousPin := nil. startOfPreviousPin := 0] + ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]]. - previousPin >= o ifTrue: - [previousPin := nil]]. self updatePointersIn: o savedFirstFieldPointer: top. toFinger := toFinger + bytes. (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). ^false]]]]. self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). ^true! Item was added: + SpurPlanningCompactor subclass: #SpurPlanningCompactorSimulator + instanceVariableNames: 'interestingObj relocationMap sffsMode' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-SpurMemoryManagerSimulation'! Item was added: + ----- Method: SpurPlanningCompactorSimulator>>check: (in category 'private') ----- + check: obj + <inline: true> + sffsMode ifNotNil: [self deny: ((manager isGrey: obj) or: [(manager isImmutable: obj) or: [manager isRemembered: obj]])]. + obj = interestingObj ifTrue: [self halt]. + "this debugged the misuse of the largest free chunk:" + "(manager checkForLeaks bitAnd: GCModeFull+GCModeFreeSpace) = GCModeFull ifTrue: + [self deny: ((manager isEnumerableObject: obj) and: [(manager heapMapAtWord: obj) = 0])]"! Item was added: + ----- Method: SpurPlanningCompactorSimulator>>forceMultiPass (in category 'accessing') ----- + forceMultiPass + sffsMode := #multiPass! Item was added: + ----- Method: SpurPlanningCompactorSimulator>>interestingObj: (in category 'accessing') ----- + interestingObj: obj + interestingObj := obj! Item was added: + ----- Method: SpurPlanningCompactorSimulator>>recordMovementOf:to:savedFirstFieldPtr: (in category 'private') ----- + recordMovementOf: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr + relocationMap ifNotNil: [:rm| rm at: o put: savedFirstFieldPtr]! Item was added: + ----- Method: SpurPlanningCompactorSimulator>>recordMovements (in category 'accessing') ----- + recordMovements + relocationMap := Dictionary new! Item was added: + ----- Method: SpurPlanningCompactorSimulator>>selectSavedFirstFieldsSpace (in category 'space management') ----- + selectSavedFirstFieldsSpace + "Override to make savedFirstFieldsSpace small enough for multi-pass compaction, if desired (for testing)." + super selectSavedFirstFieldsSpace. + "testRandomAssortment: et al create 1000 objects, aboput 5% pnned and about 33% reclaimable. Sp 512 objects should force multi-pass." + sffsMode == #multiPass ifTrue: + [savedFirstFieldsSpace limit: savedFirstFieldsSpace start + (512 * manager bytesPerOop). + biasForGC := false]! Item was added: + ----- Method: SpurPlanningCompactorTests>>testMultiPassRandomAssortments (in category 'tests') ----- + testMultiPassRandomAssortments + "Test that the compactor can handle multi-pass compaction of some + number of random assortments of live, pinned, dead, and free chunks." + <timeout: 60> + | random | + random := Random new. + 10 timesRepeat: + [| theVM | + theVM := self initializedVM. + theVM objectMemory compactor forceMultiPass. + self testRandomAssortment: (random next: 3000) readStream + with: theVM]! Item was added: + ----- Method: SpurPlanningCompactorTests>>testMultiPassRandomAssortmentsWithNewSegment (in category 'tests') ----- + testMultiPassRandomAssortmentsWithNewSegment + "Test that the compactor can handle multi-pass compaction of some number of + random assortments of live, pinned, dead, and free chunks allocated in a new segment." + <timeout: 60> + | random | + random := Random new. + 10 timesRepeat: + [| theVM | + theVM := self initializedVM. + theVM objectMemory compactor forceMultiPass. + self testRandomAssortmentWithNewSegment: (random next: 5000) readStream + with: theVM]! Item was removed: - ----- Method: SpurPlanningCompactorTests>>testRandomAssortment: (in category 'private') ----- - testRandomAssortment: random - "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks." - | om lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned | - random reset. "random is a read stream on 3000 random numbers; for repeatability" - om := self initializedVM objectMemory. - om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o]. - pinFill := 16r99999900. - liveFill := 16r55AA0000. - liveCount := pinCount := expectedFreeSpace := 0. - pinned := Set new. - 1000 timesRepeat: - [| nSlots next newObj | - nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory." - newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex. - (next := random next) > 0.95 - ifTrue: "pinned" - [om - fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1); - setIsPinnedOf: newObj to: true] - ifFalse: "mobile" - [om - fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)]. - (next := random next) >= 0.333 - ifTrue: - [om setIsMarkedOf: newObj to: true. - (om isPinned: newObj) ifTrue: - [pinned add: newObj]] - ifFalse: "dead or free" - [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj). - (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits" - ifTrue: [pinCount := pinCount - 1] - ifFalse: [liveCount := liveCount - 1]. - next >= 0.2 - ifTrue: [om setIsMarkedOf: newObj to: false] - ifFalse: [om setObjectFree: newObj]]]. - totalPinned := pinCount. - totalLive := liveCount. - self assert: totalPinned < (totalPinned + totalLive / 10). "should average 5%" - - "useful pre-compaction printing:" - false ifTrue: - [liveCount := pinCount := 0. - om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: - [:o| - om coInterpreter print: - ((om isMarked: o) - ifTrue: [(((om isPinned: o) - ifTrue: [pinCount := pinCount + 1] - ifFalse: [liveCount := liveCount + 1]) - printPaddedWith: Character space to: 3 base: 10), ' '] - ifFalse: [' ']). - om printEntity: o]]. - - expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace. - om compactor compact. - self assert: expectedFreeSpace equals: om bytesLeftInOldSpace. - self assert: om allObjectsUnmarked. - - "useful post-compaction printing:" - false ifTrue: - [liveCount := pinCount := 0. - om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: - [:o| - om coInterpreter print: - ((om isFreeObject: o) - ifFalse: [(((om isPinned: o) - ifTrue: [pinCount := pinCount + 1] - ifFalse: [liveCount := liveCount + 1]) - printPaddedWith: Character space to: 3 base: 10), ' '] - ifTrue: [' ']). - om printEntity: o]]. - - "First check and/or count populations..." - liveCount := pinCount := 0. - om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do: - [:o| - (om isPinned: o) - ifTrue: - [pinCount := pinCount + 1. - self assert: (pinned includes: o)] - ifFalse: [liveCount := liveCount + 1]]. - self assert: totalPinned equals: pinCount. - self assert: totalLive equals: liveCount. - - "Now check fills, which also tests update of first field on move..." - liveCount := pinCount := 0. - obj := lastObj. - 1 to: totalLive + totalPinned do: - [:n| | expectedFill actualFill | - [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse. - expectedFill := (om isPinned: obj) - ifTrue: [pinFill + (pinCount := pinCount + 1)] - ifFalse: [liveFill + (liveCount := liveCount + 1)]. - 1 to: (om numSlotsOf: obj) do: - [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]]. - "They should be the last objects..." - self assert: (om isFreeObject: (om objectAfter: obj)). - self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj))! Item was added: + ----- Method: SpurPlanningCompactorTests>>testRandomAssortment:with: (in category 'private') ----- + testRandomAssortment: random with: theVM + "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks." + | om lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned | + random reset. "random is a read stream on 3000 random numbers; for repeatability" + om := theVM objectMemory. + om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o]. + pinFill := 16r99999900. + liveFill := 16r55AA0000. + liveCount := pinCount := expectedFreeSpace := 0. + pinned := Set new. + 1000 timesRepeat: + [| nSlots next newObj | + nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory." + newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex. + (next := random next) > 0.95 + ifTrue: "pinned" + [om + fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1); + setIsPinnedOf: newObj to: true] + ifFalse: "mobile" + [om + fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)]. + (next := random next) >= 0.333 + ifTrue: + [om setIsMarkedOf: newObj to: true. + (om isPinned: newObj) ifTrue: + [pinned add: newObj]] + ifFalse: "dead or free" + [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj). + (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits" + ifTrue: [pinCount := pinCount - 1] + ifFalse: [liveCount := liveCount - 1]. + next >= 0.2 + ifTrue: [om setIsMarkedOf: newObj to: false] + ifFalse: [om setObjectFree: newObj]]]. + totalPinned := pinCount. + totalLive := liveCount. + self assert: totalPinned < (totalPinned + totalLive / 10). "should average 5%" + + "useful pre-compaction printing:" + false ifTrue: + [liveCount := pinCount := 0. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + om coInterpreter print: + ((om isMarked: o) + ifTrue: [(((om isPinned: o) + ifTrue: [pinCount := pinCount + 1] + ifFalse: [liveCount := liveCount + 1]) + printPaddedWith: Character space to: 3 base: 10), ' '] + ifFalse: [' ']). + om printEntity: o]. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + ((om isMarked: o) and: [om isPinned: o]) ifTrue: + [om printEntity: o]]]. + + expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace. + om compactor compact. + self assert: expectedFreeSpace equals: om bytesLeftInOldSpace. + self assert: om allObjectsUnmarked. + + "useful post-compaction printing:" + false ifTrue: + [liveCount := pinCount := 0. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + om coInterpreter print: + ((om isFreeObject: o) + ifFalse: [(((om isPinned: o) + ifTrue: [pinCount := pinCount + 1] + ifFalse: [liveCount := liveCount + 1]) + printPaddedWith: Character space to: 3 base: 10), ' '] + ifTrue: [' ']). + om printEntity: o]. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + (om isPinned: o) ifTrue: + [om printEntity: o]]]. + + "First check and/or count populations..." + liveCount := pinCount := 0. + om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do: + [:o| + (om isPinned: o) + ifTrue: + [pinCount := pinCount + 1. + self assert: (pinned includes: o)] + ifFalse: [liveCount := liveCount + 1]]. + self assert: totalPinned equals: pinCount. + self assert: totalLive equals: liveCount. + + "Now check fills, which also tests update of first field on move..." + liveCount := pinCount := 0. + obj := lastObj. + 1 to: totalLive + totalPinned do: + [:n| | expectedFill actualFill | + [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse. + expectedFill := (om isPinned: obj) + ifTrue: [pinFill + (pinCount := pinCount + 1)] + ifFalse: [liveFill + (liveCount := liveCount + 1)]. + 1 to: (om numSlotsOf: obj) do: + [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]]. + "They should be the last objects..." + self assert: (om isFreeObject: (om objectAfter: obj)). + self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj))! Item was removed: - ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment: (in category 'private') ----- - testRandomAssortmentWithNewSegment: random - "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks, - with some allocation in a new segment. No live pinned objects are created in the new segment - to obtain the situation that the last segment is entirely empty after compaction. This tests shrinkage." - | om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned | - random reset. "random is a read stream on 3000 random numbers; for repeatability" - om := self initializedVM objectMemory. - om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o]. - - pinFill := 16r99999900. - liveFill := 16r55AA0000. - liveCount := pinCount := expectedFreeSpace := 0. - pinned := Set new. - - 1000 timesRepeat: - [| nSlots next newObj | - nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory." - newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex. - (next := random next) > 0.95 - ifTrue: "pinned" - [om - fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1); - setIsPinnedOf: newObj to: true] - ifFalse: "mobile" - [om - fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)]. - (next := random next) >= 0.333 - ifTrue: - [om setIsMarkedOf: newObj to: true. - (om isPinned: newObj) ifTrue: - [pinned add: newObj]] - ifFalse: "dead or free" - [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj). - (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits" - ifTrue: [pinCount := pinCount - 1] - ifFalse: [liveCount := liveCount - 1]. - next >= 0.2 - ifTrue: [om setIsMarkedOf: newObj to: false] - ifFalse: [om setObjectFree: newObj]]]. - - pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex. - self deny: pig isNil. - self assert: 0 equals: om bytesLeftInOldSpace. - om growOldSpaceByAtLeast: om growHeadroom // 2. - self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize. - expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig). - - 1000 timesRepeat: - [| nSlots next newObj | - nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory." - newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex. - "No pinned objects in second segment." - om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1). - (next := random next) >= 0.333 - ifTrue: - [om setIsMarkedOf: newObj to: true. - (om isPinned: newObj) ifTrue: - [pinned add: newObj]] - ifFalse: "dead or free" - [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj). - liveCount := liveCount - 1. - next >= 0.2 - ifTrue: [om setIsMarkedOf: newObj to: false] - ifFalse: [om setObjectFree: newObj]]]. - - totalPinned := pinCount. - totalLive := liveCount. - self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%" - - "useful pre-compaction printing:" - false ifTrue: - [liveCount := pinCount := 0. - om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: - [:o| - om coInterpreter print: - ((om isMarked: o) - ifTrue: [(((om isPinned: o) - ifTrue: [pinCount := pinCount + 1] - ifFalse: [liveCount := liveCount + 1]) - printPaddedWith: Character space to: 3 base: 10), ' '] - ifFalse: [' ']). - om printEntity: o]]. - - expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace. - om compactor compact. - self assert: expectedFreeSpace equals: om bytesLeftInOldSpace. - self assert: om allObjectsUnmarked. - - "useful post-compaction printing:" - false ifTrue: - [liveCount := pinCount := 0. - om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: - [:o| - om coInterpreter print: - ((om isFreeObject: o) - ifFalse: [(((om isPinned: o) - ifTrue: [pinCount := pinCount + 1] - ifFalse: [liveCount := liveCount + 1]) - printPaddedWith: Character space to: 3 base: 10), ' '] - ifTrue: [' ']). - om printEntity: o]]. - - "First check and/or count populations..." - liveCount := pinCount := 0. - om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do: - [:o| - (om isPinned: o) - ifTrue: - [pinCount := pinCount + 1. - self assert: (pinned includes: o)] - ifFalse: [liveCount := liveCount + 1]]. - self assert: totalPinned equals: pinCount. - self assert: totalLive equals: liveCount. - - "Now check fills, which also tests update of first field on move..." - liveCount := pinCount := 0. - obj := lastObj. - 1 to: totalLive + totalPinned do: - [:n| | expectedFill actualFill | - [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse. - expectedFill := (om isPinned: obj) - ifTrue: [pinFill + (pinCount := pinCount + 1)] - ifFalse: [liveFill + (liveCount := liveCount + 1)]. - 1 to: (om numSlotsOf: obj) do: - [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]]. - "the Last segment should be empty" - self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)). - "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it." - self assert: (om isFreeObject: (om objectAfter: obj)). - self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))). - self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))). - self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))). - - "And the memory should shrink if the shrinkThreshold is low enough" - om shrinkThreshold: om growHeadroom. - om attemptToShrink. - self assert: om segmentManager numSegments = 1! Item was added: + ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment:with: (in category 'private') ----- + testRandomAssortmentWithNewSegment: random with: theVM + "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks, + with some allocation in a new segment. No live pinned objects are created in the new segment + to obtain the situation that the last segment is entirely empty after compaction. This tests shrinkage." + | om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned | + random reset. "random is a read stream on 3000 random numbers; for repeatability" + om := theVM objectMemory. + om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o]. + + pinFill := 16r99999900. + liveFill := 16r55AA0000. + liveCount := pinCount := expectedFreeSpace := 0. + pinned := Set new. + + 1000 timesRepeat: + [| nSlots next newObj | + nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory." + newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex. + (next := random next) > 0.95 + ifTrue: "pinned" + [om + fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1); + setIsPinnedOf: newObj to: true] + ifFalse: "mobile" + [om + fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)]. + (next := random next) >= 0.333 + ifTrue: + [om setIsMarkedOf: newObj to: true. + (om isPinned: newObj) ifTrue: + [pinned add: newObj]] + ifFalse: "dead or free" + [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj). + (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits" + ifTrue: [pinCount := pinCount - 1] + ifFalse: [liveCount := liveCount - 1]. + next >= 0.2 + ifTrue: [om setIsMarkedOf: newObj to: false] + ifFalse: [om setObjectFree: newObj]]]. + + pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex. + self deny: pig isNil. + self assert: 0 equals: om bytesLeftInOldSpace. + om growOldSpaceByAtLeast: om growHeadroom // 2. + self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize. + expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig). + + 1000 timesRepeat: + [| nSlots next newObj | + nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory." + newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex. + "No pinned objects in second segment." + om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1). + (next := random next) >= 0.333 + ifTrue: + [om setIsMarkedOf: newObj to: true. + (om isPinned: newObj) ifTrue: + [pinned add: newObj]] + ifFalse: "dead or free" + [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj). + liveCount := liveCount - 1. + next >= 0.2 + ifTrue: [om setIsMarkedOf: newObj to: false] + ifFalse: [om setObjectFree: newObj]]]. + + totalPinned := pinCount. + totalLive := liveCount. + self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%" + + "useful pre-compaction printing:" + false ifTrue: + [liveCount := pinCount := 0. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + om coInterpreter print: + ((om isMarked: o) + ifTrue: [(((om isPinned: o) + ifTrue: [pinCount := pinCount + 1] + ifFalse: [liveCount := liveCount + 1]) + printPaddedWith: Character space to: 3 base: 10), ' '] + ifFalse: [' ']). + om printEntity: o]. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + ((om isMarked: o) and: [om isPinned: o]) ifTrue: + [om printEntity: o]]]. + + expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace. + om compactor compact. + self assert: expectedFreeSpace equals: om bytesLeftInOldSpace. + self assert: om allObjectsUnmarked. + + "useful post-compaction printing:" + false ifTrue: + [liveCount := pinCount := 0. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + om coInterpreter print: + ((om isFreeObject: o) + ifFalse: [(((om isPinned: o) + ifTrue: [pinCount := pinCount + 1] + ifFalse: [liveCount := liveCount + 1]) + printPaddedWith: Character space to: 3 base: 10), ' '] + ifTrue: [' ']). + om printEntity: o]. + om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do: + [:o| + (om isPinned: o) ifTrue: + [om printEntity: o]]]. + + "First check and/or count populations..." + liveCount := pinCount := 0. + om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do: + [:o| + (om isPinned: o) + ifTrue: + [pinCount := pinCount + 1. + self assert: (pinned includes: o)] + ifFalse: [liveCount := liveCount + 1]]. + self assert: totalPinned equals: pinCount. + self assert: totalLive equals: liveCount. + + "Now check fills, which also tests update of first field on move..." + liveCount := pinCount := 0. + obj := lastObj. + 1 to: totalLive + totalPinned do: + [:n| | expectedFill actualFill | + [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse. + expectedFill := (om isPinned: obj) + ifTrue: [pinFill + (pinCount := pinCount + 1)] + ifFalse: [liveFill + (liveCount := liveCount + 1)]. + 1 to: (om numSlotsOf: obj) do: + [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]]. + "the Last segment should be empty" + self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)). + "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it." + self assert: (om isFreeObject: (om objectAfter: obj)). + self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))). + self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))). + self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))). + + "And the memory should shrink if the shrinkThreshold is low enough" + om shrinkThreshold: om growHeadroom. + om attemptToShrink. + self assert: om segmentManager numSegments = 1! Item was changed: ----- Method: SpurPlanningCompactorTests>>testRandomAssortments (in category 'tests') ----- testRandomAssortments "Test that the compactor can handle some number of random assortments of live, pinned, dead, and free chunks." <timeout: 60> | random | random := Random new. + 10 timesRepeat: + [self testRandomAssortment: (random next: 3000) readStream + with: self initializedVM]! - 10 timesRepeat: [self testRandomAssortment: (random next: 3000) readStream]! Item was changed: ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentsWithNewSegment (in category 'tests') ----- testRandomAssortmentsWithNewSegment "Test that the compactor can handle some number of random assortments of live, pinned, dead, and free chunks allocated in a new segment." <timeout: 60> | random | random := Random new. + 10 timesRepeat: + [self testRandomAssortmentWithNewSegment: (random next: 6000) readStream + with: self initializedVM]! - 10 timesRepeat: [self testRandomAssortmentWithNewSegment: (random next: 6000) readStream]! Item was added: + ----- Method: VMClass class>>simulatorClass (in category 'simulation') ----- + simulatorClass + "For running from Smalltalk - answer a class that can be used to simulate the receiver." + + ^self!

1 0

[OpenSmalltalk/opensmalltalk-vm] 184fdd: Revert "Create bert" [skip ci]
by GitHub 03 Feb '17

03 Feb '17

Branch: refs/heads/krono/highdpi-v2 Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 184fdd9b9dd77a6472a8522ffa4f095b782d50c0 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/184fdd9b9dd77a6472… Author: Bert Freudenberg <bert(a)freudenbergs.de> Date: 2017-02-03 (Fri, 03 Feb 2017) Changed paths: R bert Log Message: ----------- Revert "Create bert" [skip ci] This reverts commit 7a081f804ed7bae9277daf170022e4e89a88ef49.

1 0

pb with primitive #primitiveScreenDepth on Linux ?
by Christophe Demarey 03 Feb '17

03 Feb '17

Hello, With Pavel, we discovered a strange behavior of the primitive #primitiveScreenDepth on Linux. It returns a value of 24 bits per pixel (True colors) that looks valid but not supported (at least by Pharo). DisplayScreen actualScreenDepth "(calling the primitive screenDepth)" => 32 on OS X [OK] => 24 on Linux [KO] Also, it is not consistent with the primitive 91 DisplayScreen new supportsDisplayDepth: DisplayScreen actualScreenDepth => true on OS X => false on Linux There are some safeguard image-side but it would be great if someone could check that vm side. Christophe.

2 4

VM Maker: VMMaker.oscogSPC-eem.2119.mcz
by commits＠source.squeak.org 03 Feb '17

03 Feb '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2119.mcz ==================== Summary ==================== Name: VMMaker.oscogSPC-eem.2119 Author: eem Time: 2 February 2017, 5:12:51.57868 pm UUID: 0dfec2b8-8348-4d9c-a393-7a2e8557f439 Ancestors: VMMaker.oscogSPC-eem.2118 SpurPlanningCompactor: Remove reliance on noMobileObjectsAfter:. Simplify the termination condition for copyAndUnmarkMobileObjects by introducing allOldSpaceEntitiesForCompactingFrom:to:do:. Replace freeFrom:upTo:previousPin: with freeFrom:upTo:nextObject: cuz parsing the objects beyond the lastMobileObject always needs a pointer to an object in the sequence. coaleseFrom: must take a start address, not an object. unmarkObjectsAfterLastMobileObject must free unmarked objects. updatePointersInObjectsOverflowingSavedFirstFieldsSpace must ignore unmarked objects. Fix a regression with classAtIndex:; it used to be inlined but the extra phrase in the assert lifted it above the inlinign level (perhaps inlining should ignore asserts). Make printOopsFrom:to: skip free space instead of printing an empty object every 16 bytes. validRelocationPlanInPass: must be written just so to avoid an empty savedFirstFieldsSpace causing unsigned integer overflow. Add a test for compacting a fully compacted heap. Slang: Don't localize globals that are used in only one funciton if they are only written to. Such variables are typically for debugging (observation). =============== Diff against VMMaker.oscogSPC-eem.2118 =============== Item was changed: ----- Method: CCodeGenerator>>localizeGlobalVariables (in category 'utilities') ----- localizeGlobalVariables | candidates elected localized | "find all globals used in only one method" candidates := globalVariableUsage select: [:e | e size = 1]. + "Don't localize globals; nor those that are only assigned to; they're for debugging..." + (candidates keys select: [:k| (vmClass mustBeGlobal: k) + or: [(self methodNamed: (globalVariableUsage at: k) anyOne) + ifNil: [false] + ifNotNil: [:m| (m readsVariable: k) not]]]) do: - (candidates keys select: [:k| vmClass mustBeGlobal: k]) do: [:k| candidates removeKey: k]. + elected := Set new. localized := Dictionary new. "for an ordered report" "move any suitable global to be local to the single method using it" candidates keysAndValuesDo: [:key :targets | targets do: [:name | (methods at: name ifAbsent: []) ifNotNil: [:procedure | | newDeclaration | (procedure isRealMethod and: [self shouldGenerateMethod: procedure]) ifTrue: [(localized at: name ifAbsentPut: [SortedCollection new]) add: key. elected add: (procedure locals add: key). newDeclaration := variableDeclarations at: key ifAbsent: ['sqInt ', key]. (self initializerForInstVar: key inStartClass: procedure definingClass) ifNotNil: [:initializerNode| newDeclaration := String streamContents: [:s| s nextPutAll: newDeclaration; nextPutAll: ' = '. initializerNode emitCCodeOn: s level: 0 generator: self]]. procedure declarationAt: key put: newDeclaration. variableDeclarations removeKey: key ifAbsent: []]]]]. logger ifNotNil: [localized keys asSortedCollection do: [:name| (localized at: name) do: [:var| logger ensureCr; show: var, ' localised to ', name; cr]]]. elected do: [:ea| (variables includes: ea) ifTrue: [self checkDeleteVariable: ea]]. variables removeAllFoundIn: elected! Item was removed: - ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCompactingFrom:do: (in category 'object enumeration') ----- - allOldSpaceEntitiesForCompactingFrom: initialObject do: aBlock - <inline: true> - | prevObj prevPrevObj objOop nextObj | - self assert: (self isOldObject: initialObject). - prevPrevObj := prevObj := nil. - objOop := initialObject. - [self assert: objOop \\ self allocationUnit = 0. - self oop: objOop isLessThan: endOfMemory] whileTrue: - [self assert: (self long64At: objOop) ~= 0. - nextObj := self objectAfter: objOop limit: endOfMemory. - aBlock value: objOop value: nextObj. - prevPrevObj := prevObj. - prevObj := objOop. - objOop := nextObj]. - self touch: prevPrevObj. - self touch: prevObj! Item was added: + ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCompactingFrom:to:do: (in category 'object enumeration') ----- + allOldSpaceEntitiesForCompactingFrom: initialObject to: finalObject do: aBlock + <inline: true> + | limit prevObj prevPrevObj objOop nextObj | + self assert: (self isOldObject: initialObject). + self assert: (self oop: finalObject isLessThanOrEqualTo: endOfMemory). + prevPrevObj := prevObj := nil. + objOop := initialObject. + limit := (self oop: finalObject isLessThan: endOfMemory) ifTrue: [self addressAfter: finalObject] ifFalse: [endOfMemory]. + [self assert: objOop \\ self allocationUnit = 0. + self oop: objOop isLessThan: limit] whileTrue: + [self assert: (self long64At: objOop) ~= 0. + nextObj := self objectAfter: objOop limit: endOfMemory. + aBlock value: objOop value: nextObj. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := nextObj]. + self touch: prevPrevObj. + self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>classAtIndex: (in category 'class table') ----- classAtIndex: classIndex <api> + <inline: true> | classTablePage | self assert: (classIndex >= 0 and: [classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun and: [classIndex <= self classIndexMask]]]). classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift ofObject: hiddenRootsObj. classTablePage = nilObj ifTrue: [^nil]. ^self fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask) ofObject: classTablePage! Item was changed: ----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') ----- printOopsFrom: startAddress to: endAddress <api> + | oop limit firstNonEntity inEmptySpace lastNonEntity | - | oop limit | oop := self objectBefore: startAddress. limit := endAddress asUnsignedIntegerPtr min: endOfMemory. oop := oop ifNil: [startAddress] ifNotNil: [(self objectAfter: oop) = startAddress ifTrue: [startAddress] ifFalse: [oop]]. + inEmptySpace := false. [self oop: oop isLessThan: limit] whileTrue: [self printEntity: oop. + [oop := self objectAfter: oop. + (self long64At: oop) = 0] whileTrue: + [inEmptySpace ifFalse: + [inEmptySpace := true. + firstNonEntity := oop]. + lastNonEntity := oop]. + inEmptySpace ifTrue: + [inEmptySpace := false. + coInterpreter + print: 'skipped empty space from '; printHexPtrnp: firstNonEntity; + print:' to '; printHexPtrnp: lastNonEntity; cr. + oop := self objectStartingAt: oop]]! - oop := self objectAfter: oop]! Item was changed: ----- Method: SpurPlanningCompactor>>coalesceFrom: (in category 'private') ----- + coalesceFrom: maybeStartOfFree + "manager printOopsFrom: maybeStartOfFree to: manager endOfMemory" + <var: 'maybeStartOfFree' type: #usqInt> - coalesceFrom: maybeFirstFree - "manager printOopsFrom: maybeFirstFree to: manager endOfMemory" - <var: 'maybeFirstFree' type: #usqInt> | obj next | <var: 'obj' type: #usqInt> <var: 'next' type: #usqInt> + maybeStartOfFree >= manager endOfMemory ifTrue: - maybeFirstFree >= manager endOfMemory ifTrue: [^self]. + obj := manager objectStartingAt: maybeStartOfFree. - obj := maybeFirstFree. [next := manager oldSpaceObjectAfter: obj. next < manager endOfMemory] whileTrue: [((manager isFreeObject: obj) and: [manager isFreeObject: next]) ifTrue: + [manager unlinkFreeChunk: obj. + manager unlinkFreeChunk: next. + obj := manager freeChunkWithBytes: (manager bytesInObject: obj) + (manager bytesInObject: next) at: (manager startOfObject: obj)] - [manager - unlinkFreeChunk: obj; - unlinkFreeChunk: next; - freeChunkWithBytes: (manager bytesInObject: obj) + (manager bytesInObject: next) at: (manager startOfObject: obj)] ifFalse: [obj := next]]! Item was changed: ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') ----- compact "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. Let the segmentManager mark which segments contain pinned objects via notePinned:." | onePass firstPass | <inline: #never> "for profiling" self initializeScanCheckingForFullyCompactedHeap ifTrue: [^self unmarkObjectsInFullyCompactedHeap]. self initializeCompaction. firstPass := true. [onePass := self planCompactSavingForwarders. self assert: (self validRelocationPlanInPass: onePass) = 0. objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject. self updatePointers. self copyAndUnmark: firstPass. + "Would like to check here, but can't if multi-pass." + false ifTrue: [manager checkFreeSpace: GCModeFull]. - manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: [firstPass := false. self reinitializeScanFrom: objectAfterLastMobileObject; updateSavedFirstFieldsSpaceIfNecessary]. + manager checkFreeSpace: GCModeFull. self endCompaction! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmark: (in category 'compaction') ----- copyAndUnmark: firstPass "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, restoring their savedFirstFields." <inline: #never> | onePass | self logPhase: 'copying and unmarking...'. firstPass ifTrue: [self unmarkInitialImmobileObjects]. "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass." savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: + [self assert: ((self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory) + or: [lastMobileObject < firstMobileObject]). - [self assert: (self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory). ^self]. onePass := self copyAndUnmarkMobileObjects. (onePass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true." [self unmarkObjectsAfterLastMobileObject]! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') ----- copyAndUnmarkMobileObjects "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects match. We could implement them as a single enumeration method taking several block arguments, but arguably that would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)." <inline: #never> | toFinger top previousPin | <var: 'o' type: #usqInt> <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> <var: 'previousPin' type: #usqInt> self deny: (manager isMarked: firstFreeObject). toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start. + manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject to: lastMobileObject do: + [:o :n| - manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: - [:o :n| | done | self check: o. self assert: (previousPin ifNil: [toFinger <= (manager startOfObject: o)] ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]). self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]). (manager isMarked: o) ifTrue: + [(manager isPinned: o) - [o > lastMobileObject ifTrue: - ["If this is onePass (noMobileObjectsFrom: objectAfterLastMobileObject) free up to end of memory. - A bug in this approach is that it may create two free objects at the end of memory. Work around - this with the coalesce pass below. - If this is multi-pass, free up to startOfObject: objectAfterLastMobileObject." - | maybeStartOfFree | - self assert: (self oop: o isGreaterThanOrEqualTo: objectAfterLastMobileObject). - self freeFrom: toFinger upTo: (manager startOfObject: objectAfterLastMobileObject) previousPin: previousPin. - maybeStartOfFree := toFinger < (manager startOfObject: objectAfterLastMobileObject) - ifTrue: [manager objectStartingAt: toFinger] - ifFalse: [objectAfterLastMobileObject]. - done := self noMobileObjectsFrom: objectAfterLastMobileObject. - done ifTrue: - [toFinger := manager startOfObject: objectAfterLastMobileObject. - previousPin := (manager isPinned: objectAfterLastMobileObject) ifTrue: [objectAfterLastMobileObject]. - self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. - self coalesceFrom: maybeStartOfFree]. - ^done]. - (manager isPinned: o) ifTrue: [previousPin ifNil: [previousPin := o]] ifFalse: [| availableSpace bytes | bytes := manager bytesInObject: o. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger up to point at the first unmarked or mobile object after previousPin, or, if previousPin is contiguous with o, to the start of this object. Update previousPin to be the next pinned object above toFInger and below this object, or nil if no such pinned object exists. Any unfillable gaps between adjacent pinned objects will be freed." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. [self assert: ((manager isMarked: previousPin) and: [manager isPinned: previousPin]). self unmarkPinned: previousPin. toFinger := manager addressAfter: previousPin. previousPin := manager objectStartingAt: toFinger. (manager isMarked: previousPin) and: [(manager isPinned: previousPin) and: [previousPin < o]]] whileTrue. "Now previousPin is either equal to o or mobile. Move it to the next pinned object below o" [previousPin >= o or: [(manager isMarked: previousPin) and: [manager isPinned: previousPin]]] whileFalse: [previousPin := manager oldSpaceObjectAfter: previousPin]. previousPin >= o ifTrue: [previousPin := nil]]. self copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: (manager longAt: top). toFinger := toFinger + bytes. (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). + self assert: n = objectAfterLastMobileObject. + self freeFrom: toFinger upTo: (manager startOfObject: n) nextObject: (previousPin ifNil: [n]). + ^false]]]]. + self freeFrom: toFinger upTo: manager endOfMemory nextObject: (previousPin ifNil: [objectAfterLastMobileObject]). + self coalesceFrom: toFinger. - done := self noMobileObjectsFrom: n. - done - ifTrue: [self freeAllUnpinnedObjectsFromObject: (previousPin ifNil: [n]) toFinger: toFinger] - ifFalse: [self freeFrom: toFinger upTo: (manager startOfObject: n) previousPin: previousPin]. - ^done]]]]. - self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. - self coalesceFrom: (manager objectStartingAt: toFinger). ^true! Item was added: + ----- Method: SpurPlanningCompactor>>freeFrom:upTo:nextObject: (in category 'private') ----- + freeFrom: initialToFinger upTo: limit nextObject: nextObject + "Free from toFinger up to limit, dealing with possible intervening pinned objects." + <inline: false> + <var: 'limit' type: #usqInt> + <var: 'initialToFinger' type: #usqInt> + | toFinger obj objStart | + <var: 'objStart' type: #usqInt> + <var: 'toFinger' type: #usqInt> + self cCode: [] inSmalltalk: + [coInterpreter cr; cr; print: 'freeing at '; printHexnp: initialToFinger; print: ' up to '; printHexnp: limit; cr]. + toFinger := initialToFinger. + objStart := manager startOfObject: nextObject. + toFinger < objStart ifTrue: + [manager addFreeChunkWithBytes: objStart - toFinger at: toFinger]. + toFinger := objStart. + [objStart < limit] whileTrue: + [obj := manager objectStartingAt: objStart. + ((manager isMarked: obj) and: [manager isPinned: obj]) + ifTrue: + [self unmarkPinned: obj. + toFinger < objStart ifTrue: + [manager addFreeChunkWithBytes: objStart - toFinger at: toFinger]. + toFinger := objStart := manager addressAfter: obj] + ifFalse: + [objStart := manager addressAfter: obj]]. + limit > toFinger ifTrue: + [manager addFreeChunkWithBytes: limit - toFinger at: toFinger]! Item was removed: - ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') ----- - freeFrom: toFinger upTo: limit previousPin: previousPinOrNil - "Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil." - <inline: false> - <var: 'limit' type: #usqInt> - <var: 'toFinger' type: #usqInt> - <var: 'previousPinOrNil' type: #usqInt> - | effectiveToFinger pin nextUnpinned start seg | - <var: 'nextUnpinned' type: #usqInt> - <var: #seg type: #'SpurSegmentInfo *'> - self cCode: [] inSmalltalk: - [coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr]. - effectiveToFinger := toFinger. - pin := previousPinOrNil. - "If the range toFinger to limit spans segments but there is no pin (as when freeing to the end of memory) - segment boundaries must still be observed. So in this case use the nearest bridge above toFinger as the pin." - pin ifNil: - [seg := manager segmentManager segmentContainingObj: toFinger. - self deny: seg isNil. - seg segLimit < limit ifTrue: - [pin := manager segmentManager bridgeFor: seg]]. - [pin notNil and: [pin < limit]] whileTrue: - [(start := manager startOfObject: pin) > toFinger ifTrue: - [manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger]. - nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin. - nextUnpinned >= limit ifTrue: - [^self]. - effectiveToFinger := manager startOfObject: nextUnpinned. - pin := self findNextMarkedPinnedAfter: nextUnpinned]. - limit > effectiveToFinger ifTrue: - [manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger]! Item was removed: - ----- Method: SpurPlanningCompactor>>noMobileObjectsAfter: (in category 'private') ----- - noMobileObjectsAfter: mobileObj - self assert: ((manager isMarked: mobileObj) and: [(manager isPinned: mobileObj) not]). - manager allOldSpaceEntitiesFrom: mobileObj do: - [:o| - ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue: - [^false]]. - ^true! Item was removed: - ----- Method: SpurPlanningCompactor>>noMobileObjectsFrom: (in category 'private') ----- - noMobileObjectsFrom: mobileObj - <inline: false> - manager allOldSpaceEntitiesFrom: mobileObj do: - [:o| - ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue: - [^false]]. - ^true! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects match. We could implement them as a single enumeration method taking several block arguments, but arguably that would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)." <inline: #never> | toFinger top previousPin | <var: 'o' type: #usqInt> <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> <var: 'previousPin' type: #usqInt> savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self logPhase: 'planning...']. self deny: (manager isMarked: firstFreeObject). toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start. manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin ifNil: [toFinger <= (manager startOfObject: o)] ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]). self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [previousPin ifNil: [previousPin := o]] ifFalse: [| availableSpace bytes | bytes := manager bytesInObject: o. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger up to point at the first unmarked or mobile object after previousPin, or, if previousPin is contiguous with o, to the start of this object. Update previousPin to be the next pinned object above toFInger and below this object, or nil if no such pinned object exists. Any unfillable gaps between adjacent pinned objects will be freed." [toFinger := manager addressAfter: previousPin. previousPin := manager objectStartingAt: toFinger. (manager isMarked: previousPin) and: [(manager isPinned: previousPin) and: [previousPin < o]]] whileTrue. "Now previousPin is either equal to o or mobile. Move it to the next pinned object below o" [previousPin >= o or: [(manager isMarked: previousPin) and: [manager isPinned: previousPin]]] whileFalse: [previousPin := manager oldSpaceObjectAfter: previousPin]. previousPin >= o ifTrue: [previousPin := nil]]. self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top. toFinger := toFinger + bytes. (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. + ^false]]]]. - ^self noMobileObjectsAfter: o]]]]. savedFirstFieldsSpace top: top - manager bytesPerOop. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>unmarkObjectsAfterLastMobileObject (in category 'compaction') ----- unmarkObjectsAfterLastMobileObject + "Sweep the final immobile heap, freeing and coalescing unmarked and free objects, + and unmarking all marked objects up to the end of memory." + | startOfFree freeBytes | + freeBytes := 0. + manager allOldSpaceEntitiesFrom: objectAfterLastMobileObject do: - "Sweep the final immobile heap, unmarking all objects up to the end of memory." - manager allOldSpaceObjectsFrom: objectAfterLastMobileObject do: [:o| self check: o. + (manager isMarked: o) + ifFalse: + [startOfFree ifNil: [startOfFree := manager startOfObject: o]. + freeBytes := freeBytes + manager bytesInObject: o] + ifTrue: + [startOfFree ifNotNil: + [manager addFreeChunkWithBytes: freeBytes at: startOfFree. + startOfFree := nil. + freeBytes := 0]. + (manager isSegmentBridge: o) ifFalse: + [manager setIsMarkedOf: o to: false]]]! - manager setIsMarkedOf: o to: false]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') ----- updatePointersInMobileObjects "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects match. We could implement them as a single enumeration method taking several block arguments, but arguably that would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)." | toFinger top previousPin | <var: 'o' type: #usqInt> <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> <var: 'previousPin' type: #usqInt> self deny: (manager isMarked: firstFreeObject). toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace start. manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin ifNil: [toFinger <= (manager startOfObject: o)] ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [previousPin ifNil: [previousPin := o]. self updatePointersIn: o] ifFalse: [| availableSpace bytes | bytes := manager bytesInObject: o. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger up to point at the first unmarked or mobile object after previousPin, or, if previousPin is contiguous with o, to the start of this object. Update previousPin to be the next pinned object above toFInger and below this object, or nil if no such pinned object exists. Any unfillable gaps between adjacent pinned objects will be freed." [toFinger := manager addressAfter: previousPin. previousPin := manager objectStartingAt: toFinger. (manager isMarked: previousPin) and: [(manager isPinned: previousPin) and: [previousPin < o]]] whileTrue. "Now previousPin is either equal to o or mobile. Move it to the next pinned object below o" [previousPin >= o or: [(manager isMarked: previousPin) and: [manager isPinned: previousPin]]] whileFalse: [previousPin := manager oldSpaceObjectAfter: previousPin]. previousPin >= o ifTrue: [previousPin := nil]]. self updatePointersIn: o savedFirstFieldPointer: top. toFinger := toFinger + bytes. (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). + ^false]]]]. - ^self noMobileObjectsFrom: o]]]]. self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). ^true! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') ----- updatePointersInObjectsOverflowingSavedFirstFieldsSpace "Sweep the final immobile heap, is any (those objects with no room in savedFirstFieldsSpace in the current pass) updating all references to mobile objects to their eventual locations." manager allOldSpaceObjectsFrom: objectAfterLastMobileObject do: [:o| self check: o. + (manager isMarked: o) ifTrue: + [self updatePointersIn: o]]! - self assert: (manager isMarked: o). - self updatePointersIn: o]! Item was changed: ----- Method: SpurPlanningCompactor>>validRelocationPlanInPass: (in category 'private') ----- validRelocationPlanInPass: onePass "Answer 0 if all the mobile objects from firstMobileObject to lastMobileObject have sane forwarding addresses, and that savedFirstFieldsSpace is of matching capacity. Otherwise answer an error code identifying the anomaly." | nMobiles toFinger | <var: 'toFinger' type: #usqInt> <var: 'destination' type: #usqInt> nMobiles := 0. toFinger := mobileStart. anomaly := nil. manager allOldSpaceEntitiesFrom: firstMobileObject do: [:o| | destination | self check: o. (manager isMarked: o) ifTrue: [(manager isPinned: o) ifFalse: [nMobiles := nMobiles + 1. destination := manager fetchPointer: 0 ofObject: o. destination >= toFinger ifFalse: [anomaly := o. ^1]. toFinger := toFinger + (manager bytesInObject: o). (self oop: o isGreaterThan: lastMobileObject) ifTrue: [anomaly := o. ^2]. o = lastMobileObject ifTrue: + [^savedFirstFieldsSpace top + manager bytesPerOop - savedFirstFieldsSpace start / manager bytesPerOop - [^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1 = nMobiles ifTrue: [0] ifFalse: [3]]]]]. + "N.B. written this way so that if there are no mobiles the expression evaluates to 0 in Smalltalk /and/ in C unsigned arithmetic." + ^savedFirstFieldsSpace top + manager bytesPerOop - savedFirstFieldsSpace start / manager bytesPerOop - ^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1 = nMobiles ifTrue: [0] ifFalse: [4]! Item was added: + ----- Method: SpurPlanningCompactorTests>>testCompactedHeap (in category 'tests') ----- + testCompactedHeap + "First test for valid compactibility of an already compacted heap via fullGC" + | freeSpace om | + om := self initializedVM objectMemory. + freeSpace := om bytesLeftInOldSpace. + om fullGC. + self assert: freeSpace equals: om bytesLeftInOldSpace! Item was added: + ----- Method: TInlineNode>>nodesDo:parent: (in category 'enumerating') ----- + nodesDo: aBlock parent: parent + "Apply aBlock to all nodes in the receiver with each node's parent. + N.B. This is assumed to be bottom-up, leaves first." + method parseTree nodesDo: aBlock parent: self. + aBlock value: self value: parent! Item was added: + ----- Method: TMethod>>readsVariable: (in category 'accessing') ----- + readsVariable: variableName + "Answer if the receiver reads the variable (i.e. ignore assignments to the variable)." + parseTree nodesWithParentsDo: + [:node :parent| + (node isVariable + and: [node name = variableName]) ifTrue: + [(parent notNil + and: [parent isAssignment + and: [node == parent variable]]) ifFalse: + [^true]]]. + ^false!

1 0

Re: [Vm-dev] [Pharo-dev] pb with primitive #primitiveScreenDepth on Linux ?
by Igor Stasenko 02 Feb '17

02 Feb '17

On 31 January 2017 at 11:12, Christophe Demarey <christophe.demarey(a)inria.fr > wrote: > Hello, > > With Pavel, we discovered a strange behavior of the primitive > #primitiveScreenDepth on Linux. It returns a value of 24 bits per pixel > (True colors) that looks valid but not supported (at least by Pharo). > > DisplayScreen actualScreenDepth "(calling the primitive screenDepth)" > => 32 on OS X [OK] > => 24 on Linux [KO] > > Also, it is not consistent with the primitive 91 > > DisplayScreen new supportsDisplayDepth: DisplayScreen actualScreenDepth > => true on OS X > => false on Linux > > There are some safeguard image-side but it would be great if someone could > check that vm side. > > Christophe. > IIRC in Pharo, we purposedly decided to support only single screen depth internally for Display. It is then the headache of VM driver to convert 32bpp to anything that suitable to deliver it on screen. The problem with this prim, is that it doesn't really tells you anything, especially since Pharo started using SDL. Also IIRC Squeak/Pharo doesn't forcing you to use native bitmaps (or only those that supported on platform it runs). -- Best regards, Igor Stasenko.

2 1

[OpenSmalltalk/opensmalltalk-vm] 7a081f: Create bert
by GitHub 02 Feb '17

02 Feb '17

Branch: refs/heads/krono/highdpi-v2 Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 7a081f804ed7bae9277daf170022e4e89a88ef49 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/7a081f804ed7bae927… Author: Bert Freudenberg <bert(a)freudenbergs.de> Date: 2017-02-02 (Thu, 02 Feb 2017) Changed paths: A bert Log Message: ----------- Create bert

1 0

Deprecated includesSubString / Repository access request
by Ben Coman 01 Feb '17

01 Feb '17

./buildspurtrunkvmmakerimage.sh loading of VMMaker got stuck on deprecated #includeSubString. If I could be granted access to upload to the repository I'll upload the mcz fix. Otherwise, please see attached changeset. There was another deprecation warning... Preferences class>>#setWindowColorFor:to: has been deprecated. Configure UI themes directly. but I didn't immediately know how to address that in Squeak. cheers -ben

1 1

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev February 2017