Vm-dev January 2017

vm-dev@lists.squeakfoundation.org

30 participants
136 discussions

VM Maker: VMMaker.oscogSPC-eem.2116.mcz
by commits＠source.squeak.org 28 Jan '17

28 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2116.mcz ==================== Summary ==================== Name: VMMaker.oscogSPC-eem.2116 Author: eem Time: 28 January 2017, 10:33:34.120249 am UUID: 6132d23c-9bc3-4756-8352-16b127d1c7cd Ancestors: VMMaker.oscog-eem.2116, VMMaker.oscogSPC-eem.2114 Temporary branch for SpurPlanningCompactor as default compactor. Merge VMMaker.oscog-eem.2116 & VMMaker.oscogSPC-eem.2114 =============== Diff against VMMaker.oscog-eem.2116 =============== Item was changed: ----- Method: SpurMemoryManager class>>compactorClass (in category 'accessing class hierarchy') ----- compactorClass "Answer the compaction algorithm to use." + ^Smalltalk classNamed: (initializationOptions at: #compactorClass ifAbsent: [#SpurPlanningCompactor])! - ^Smalltalk classNamed: (initializationOptions at: #compactorClass ifAbsent: [#SpurPigCompactor])! Item was added: + ----- Method: SpurMemoryManager>>unlinkFreeChunk: (in category 'free space') ----- + unlinkFreeChunk: freeChunk + "Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing." + | chunkBytes index node next prev child childBytes | + index := (chunkBytes := self bytesInObject: freeChunk) / self allocationUnit. + (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: + [self assert: ((freeListsMask anyMask: 1 << index) and: [(freeLists at: index) ~= 0]). + node := freeLists at: index. + prev := 0. + [node ~= 0] whileTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + node = freeChunk ifTrue: + [prev = 0 + ifTrue: [freeLists at: index put: next] + ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. + ^self]. + prev := node. + node := next]. + self error: 'freeChunk not found in free lists']. + + "Large chunk. Search the large chunk tree." + child := freeLists at: 0. + node := 0. + [child ~= 0] whileTrue: + [self assert: (self isValidFreeObject: child). + childBytes := self bytesInObject: child. + childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." + [node := child. + [prev := node. + node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + node ~= 0] whileTrue: + [node = freeChunk ifTrue: + [self assert: (self isValidFreeObject: node). + self storePointer: self freeChunkNextIndex + ofFreeChunk: prev + withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node). + ^self]]. + child = freeChunk ifTrue: + [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. + next = 0 + ifTrue: "no list; remove the interior node" + [self unlinkSolitaryFreeTreeNode: child] + ifFalse: "list; replace node with it" + [self inFreeTreeReplace: child with: next]. + ^self]]. + child ~= 0 ifTrue: + [childBytes < chunkBytes + ifTrue: "node too small; walk down the larger size of the tree" + [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] + ifFalse: + [node := child. + child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node]]]. + + self error: 'freeChunk not found in free tree' + ! Item was added: + ----- Method: SpurPlanningCompactor>>coalesceFrom: (in category 'private') ----- + coalesceFrom: maybeFirstFree + "manager printOopsFrom: maybeFirstFree to: manager endOfMemory" + <var: 'maybeFirstFree' type: #usqInt> + | obj next | + <var: 'obj' type: #usqInt> + <var: 'next' type: #usqInt> + maybeFirstFree >= manager endOfMemory ifTrue: + [^self]. + obj := maybeFirstFree. + [next := manager oldSpaceObjectAfter: obj. + next < manager endOfMemory] whileTrue: + [((manager isFreeObject: obj) and: [manager isFreeObject: next]) + ifTrue: + [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. manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: [firstPass := false. + self reinitializeScanFrom: objectAfterLastMobileObject; - self reinitializeScan; updateSavedFirstFieldsSpaceIfNecessary]. self endCompaction! 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 do: + [:o :n| | done | - [:o :n| 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: [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]. - [self assert: ((manager isPinned: o) not or: [previousPin isNil]). - self freeFrom: toFinger upTo: manager endOfMemory previousPin: ((manager isPinned: o) ifTrue: [o] ifFalse: [previousPin]). - ^true]. (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). + done := self noMobileObjectsFrom: n. - [| done | - self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). - done := self noMobileObjectsAfter: 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 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." + self reinitializeScanFrom: manager hiddenRootsObject. + firstFreeObject ifNil: + [self error: 'uncompactable heap; no unmarked objects found']. - "Scan for firstFreeObject and firstMobileObject from the start of memory (actually - from lastMobileObject so that reInitializeScan can work on subsequent passes). - Answer if the heap is already fully compacted. Set " - firstFreeObject := lastMobileObject := manager hiddenRootsObject. - self reinitializeScan. ^firstMobileObject >= manager endOfMemory! Item was added: + ----- Method: SpurPlanningCompactor>>noMobileObjectsFrom: (in category 'private') ----- + noMobileObjectsFrom: mobileObj + manager allOldSpaceEntitiesFrom: mobileObj do: + [:o| + ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue: + [^false]]. + ^true! Item was removed: - ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') ----- - reinitializeScan - "Search for firstFreeObject and firstMobileObject from lastMobileObject (which is - set to the hiddenRootsObject on the first pass)." - firstMobileObject := manager endOfMemory. - firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: lastMobileObject. - firstFreeObject ifNil: - [self error: 'uncompactable heap; no unmarked objects found']. - mobileStart := manager startOfObject: firstFreeObject! Item was added: + ----- 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]! Item was added: + ----- Method: SpurPlanningCompactor>>unmarkAndScanForFirstUnpinnedObjectFrom: (in category 'compaction') ----- + unmarkAndScanForFirstUnpinnedObjectFrom: initialObject + "Scan from initialObject, unmarking any marked pinned objects, and answering the first mobile or freeable object found, or nil if none." + manager allOldSpaceEntitiesFrom: initialObject do: + [:o| + ((manager isMarked: o) and: [manager isPinned: o]) ifFalse: + [^o]. + self unmarkPinned: o]. + ^nil! 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). + ^self noMobileObjectsFrom: o]]]]. - ^self noMobileObjectsAfter: o]]]]. self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). ^true!

1 0

Freeze after Morph Activity
by Dan Norton 28 Jan '17

28 Jan '17

On Debian8, CogSpur64 5.0-201612221637, Cuis 5.0 3043... after lots of user interaction, views opening and closing, and animation, the image becomes unresponsive. Cmd+. does nothing and the clock in the Cuis taskbar no longer updates. The length of time to produce this varies from 5 to 20 minutes. There seems to be no dump and no log. 'Smalltalk garbageCollectMost' reports 25550736 to 30517872 over 34 samples. Sorry to be so vague. This has occurred with several images - sometimes scrolling through a senders list, or stepping through a debugger, but repeatably with one of my images. I can supply this image, warmed up so that it might not take so long to reproduce the problem if you would like. Or give me a hint as to how to narrow down the problem - Dan

2 1

Sometimes it's too easy, part II
by Eliot Miranda 28 Jan '17

28 Jan '17

Hi All, I had stalled in recent days on the new compactor. The compactor appears to be working perfectly for me running on Mac OS, but when my colleague Bob Westergaard built a Newspeak VM for linux it crashed immediately (our Newspeak images invoke GC as soon as the low space watcher is spawned, because we're based on an older Squeak release). Linux crashes whereas for me Mac OS doesn't crash for the combination of two reasons. Linux places the heap much higher in the address space, typically creating heaps that extend into the up[per half of the address space. The default type for oops in the VM is saint, which is signed. So unless unsigned comparisons are used, oops in the upper half of the address space, which consequently have their sign bit set, will confuse enumerations, and hence bring the compactor crashing down. The problem is how to find these unsigned comparisons. I had taken the approach of simply finding test cases and running them in the debugger, but alas the compactor works perfectly in the simulator, because there's not enough address space to create a simulated heap > 2Gb, so the simulator works and the generated C doesn't work on Linux. Running the two side by side trying to look for where they diverge was not productive given the difficulty of looking at a 47Mb image containing 875k objects. And then the subconscious kicked in and I realized I could use Slang to analyze the parse tree and look for signed comparisons. The first cut looked like this. Yes, the open coding of building the code enrapture and running the type inference is ugly, but it's not that complicated. The important bit at the bottom is node isSend and: [(#(< > <= >=) includes: node selector) and: [({node receiver. node args first } anySatisfy: [:o| (cg typeFor: o in: m) ifNil: [false] ifNotNil: [:t| (cg isIntegralCType: t) and: [t first ~= $u]]])]] SpurPlanningCompactor class>>#identifySignedComparisons "self identifySignedComparisons" | vmm cg | vmm := (VMMaker forPlatform: 'Cross') interpreterClass: StackInterpreter; options: #(ObjectMemory Spur32BitMemoryManager). cg := [vmm buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: self selectors. cg prepareMethods. cg doInlining: true. self selectors do: [:sel| (cg methodNamed: sel) ifNotNil: [:m| m parseTree nodesDo: [:node| (node isSend and: [(#(< > <= >=) includes: node selector) and: [{node receiver. node args first } anySatisfy: [:o| (cg typeFor: o in: m) ifNil: [false] ifNotNil: [:t| (cg isIntegralCType: t) and: [t first ~= $u]]]]]) ifTrue: [Transcript ensureCr; nextPutAll: sel; space; print: node; flush]]]] Using the above was a doit to collect the results in a set allowed me to filter out the noise, and the final method looks like identifySignedComparisons "self identifySignedComparisons" | vmm cg noise | noise := #('(manager bytesInObject: largestFreeChunk) >= spaceEstimate' '(self classIndexOf: o*) > self isForwardedObjectClassIndexPun' 'GCModeFull > 0' 'ReceiverIndex + (objectMemory integerValueOf: sp*) < (objectMemory lengthOf: o*)' 'fmt* < manager firstCompiledMethodFormat' 'fmt* < self firstCompiledMethodFormat' 'fmt* <= 5' 'gcPhaseInProgress > 0' 'i <= finishIndex' 'i >= 0' 'numPointerSlots > 0' 'scavenger rememberedSetSize > 0'). vmm := (VMMaker forPlatform: 'Cross') interpreterClass: StackInterpreter; options: #(ObjectMemory Spur32BitMemoryManager). cg := [vmm buildCodeGeneratorForInterpreter] on: Notification do: [:ex| ex tag == #getVMMaker ifTrue: [ex resume: vmm] ifFalse: [ex pass]]. cg vmClass preGenerationHook: cg. cg inferTypesForImplicitlyTypedVariablesAndMethods. cg retainMethods: self selectors. cg prepareMethods. cg doInlining: true. self selectors do: [:sel| (cg methodNamed: sel) ifNotNil: [:m| m parseTree nodesDo: [:node| (node isSend and: [(#(< > <= >=) includes: node selector) and: [({node receiver. node args first } anySatisfy: [:o| (cg typeFor: o in: m) ifNil: [false] ifNotNil: [:t| (cg isIntegralCType: t) and: [t first ~= $u]]]) and: [noise noneSatisfy: [:n| n match: node printString]]]]) ifTrue: [Transcript ensureCr; nextPutAll: sel; space; print: node; flush]]]] and my output is savedFirstFieldsSpaceInFreeChunk savedFirstFieldsSpace start >= nilObj unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: (segments at: sweepIndex) segSize + (segments at: sweepIndex) segStart < nextObj unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: nextObj >= manager endOfMemory findNextMarkedPinnedAfter: nextObj >= manager endOfMemory planCompactSavingForwarders toFinger <= (manager startOfObject: o) planCompactSavingForwarders toFinger <= (manager startOfObject: previousPin) updatePointers o2 >= firstFreeObject updatePointers toFinger <= (manager startOfObject: o3) updatePointers toFinger <= (manager startOfObject: previousPin) savedFirstFieldsSpaceWasAllocated savedFirstFieldsSpace start >= nilObj freeFrom:upTo:previousPin: toFinger >= (segments at: i) segStart freeFrom:upTo:previousPin: seg segSize + seg segStart < limit freeFrom:upTo:previousPin: start := (self byteAt: pin + 7) = self numSlotsMask ifTrue: [pin - self baseHeaderSize] ifFalse: [pin] > toFinger freeFrom:upTo:previousPin: (segments at: sweepIndex) segSize + (segments at: sweepIndex) segStart < nextObj1 freeFrom:upTo:previousPin: nextObj1 >= manager endOfMemory freeFrom:upTo:previousPin: nextUnpinned >= limit freeFrom:upTo:previousPin: nextObj >= manager endOfMemory unmarkPinned: (segments at: sweepIndex) segSize + (segments at: sweepIndex) segStart < pinnedObj compact savedFirstFieldsSpace start >= nilObj compact savedFirstFieldsSpace start >= nilObj updateSavedFirstFieldsSpaceIfNecessary savedFirstFieldsSpace start >= nilObj endCompaction savedFirstFieldsSpace start >= nilObj updatePointersInInitialImmobileObjects o >= firstFreeObject copyAndUnmarkMobileObjects toFinger <= (manager startOfObject: o) copyAndUnmarkMobileObjects toFinger <= (manager startOfObject: previousPin) copyAndUnmarkMobileObjects bytes + 2 * 8 > availableSpace copyAndUnmarkMobileObjects availableSpace > 0 releaseSavedFirstFieldsSpace savedFirstFieldsSpace start >= nilObj updatePointersInMobileObjects toFinger <= (manager startOfObject: o) updatePointersInMobileObjects toFinger <= (manager startOfObject: previousPin) Less than half an hour's work. Now I can squash those bugs :-) _,,,^..^,,,_ best, Eliot

10 20

VM Maker: VMMaker.oscog-eem.2116.mcz
by commits＠source.squeak.org 27 Jan '17

27 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2116.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2116 Author: eem Time: 27 January 2017, 10:54:32.147069 am UUID: aacee506-96d1-4cb6-8a9c-d27fb6b54754 Ancestors: VMMaker.oscog-eem.2115 Newspeak: Comment NSSendCache. Make the SpurPlanningCompactor movement tracing stuff optional and in agreement with the scavenger's facilities. =============== Diff against VMMaker.oscog-eem.2115 =============== Item was changed: VMStructType subclass: #NSSendCache instanceVariableNames: 'classTag enclosingObject target selector numArgs depth' classVariableNames: '' poolDictionaries: 'CogMethodConstants VMBasicConstants' category: 'VMMaker-JIT'! + + !NSSendCache commentStamp: 'eem 1/27/2017 10:04' prior: 0! + A NSSendCache is an inline cache for Newspeak absent receiver sends, designed and implemented by Ryan Macnak. These caches are used with four varieties of absent receiver sends: + absent self send + absent implciit receiver send + absent dynamic super send + absent outer send. + + See Cogit>>#linkNSSendCache:classTag:enclosingObject:target:caller: and senders. These caches have + - a guarded class id (not an oop) + - an absent receiver (or 0 if it is the method receiver) (an oop or 0) + - a target method in the code zone (not an oop) + - depth (not an oop) the nesting depth of the receiver fror an outer send, or < 0 if not nested + - numArgs (not an oop) + - the selector (an oop) + + The selector, numArgs and depth are read at link time. The class id is checked at send time and if it matches, the absentReceiver, enclosingObject numArgs and and target method are read, self being substituted for the absentReceiver if absentReceiver is 0. numArgs is read for sends with arity > 3 (it is implicit in the trampoline for arities 0 to 3) and used to adjust the stack and insert the relevant receiver. See genNSSendTrampolineFor:numArgs:enclosingObjectCheck:called:. + + Note that the caches themselves are also pinned objects on the heap (a non-object punned word array whose elements are not traced) rather than in the code zone, so GC also needs to trace and update references from Cogged methods to these cache objects. The absent receiver can be updated or cleared on GC. The selector must be updated on GC. The target method can be updated or cleared on code compaction. The class id, absent receiver, and target method are weak references. cache->selector and method->cache are strong references.. + + Instance Variables + classTag: <Integer> + depth: <Integer> + enclosingObject: <Object or 0> + numArgs: <Integer> + selector: <Object> + target: <CogMethod> + + classTag + - classTag of the method receiver for which this is valid (the classTag of self in the method in which the send occurs, not the class of the message receiver) + + depth + - nesting depth for outer sends + + enclosingObject + - the oop of the enclosingObject or 0 if none + + numArgs + - send numArgs + + selector + - the oop of the message's selector + + target + - the target CogMethod or 0 if none + ! 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 cCode: '' inSmalltalk: [relocationMap ifNotNil: [:rm| rm at: o put: savedFirstFieldPtr]]! - self cCode: '' inSmalltalk: [relocationMap at: o put: savedFirstFieldPtr]! Item was changed: ----- Method: SpurPlanningCompactor>>initializeCompaction (in category 'compaction') ----- initializeCompaction manager checkFreeSpace: GCModeFull. self selectSavedFirstFieldsSpace. self unpinRememberedSet. manager resetFreeListHeads; totalFreeOldSpace: 0; beginSlidingCompaction. + savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop! - savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. - self cCode: '' inSmalltalk: [relocationMap := Dictionary new]! Item was added: + ----- Method: SpurPlanningCompactor>>recordMovements (in category 'compaction') ----- + recordMovements + relocationMap := Dictionary new!

1 0

VM Maker: VMMaker.oscog-eem.2115.mcz
by commits＠source.squeak.org 27 Jan '17

27 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2115.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2115 Author: eem Time: 27 January 2017, 10:49:54.261323 am UUID: ddcc6891-86da-481d-bed3-56e7a842d41f Ancestors: VMMaker.oscog-cb.2113, VMMaker.oscogSPC-eem.2114 Merge =============== Diff against VMMaker.oscog-cb.2113 =============== Item was added: + ----- Method: CogObjectRepresentationForSpur>>checkValidDerivedObjectReference: (in category 'debug support') ----- + checkValidDerivedObjectReference: bodyAddress + ^(objectMemory heapMapAtWord: (self pointerForOop: bodyAddress - objectMemory baseHeaderSize)) ~= 0! Item was added: + ----- Method: CogObjectRepresentationForSpur>>couldBeDerivedObject: (in category 'garbage collection') ----- + couldBeDerivedObject: bodyAddress + ^self oop: bodyAddress - objectMemory baseHeaderSize isGreaterThanOrEqualTo: objectMemory startOfMemory! Item was changed: ----- Method: CogObjectRepresentationForSpur>>markIfIRC: (in category 'newspeak support') ----- markIfIRC: maybeIRCs "If maybeIRCs (from some cogMehtod's nextMethodOrIRCs) is in old space it is a pointer to the first field of a pinned object in old space holding the implicit receiver caches for a method. If so, map it back to an oop and mark it." <var: #maybeIRCs type: #usqInt> <option: #NewspeakVM> + <inline: true> (self oop: maybeIRCs isGreaterThan: objectMemory nilObject) ifTrue: [objectMemory markAndTrace: maybeIRCs - objectMemory baseHeaderSize]! Item was changed: ----- 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 cmType ~= CMFree ifTrue: [(self asserta: (objectRepresentation checkValidOopReference: cogMethod selector)) ifFalse: [ok := false]. (self asserta: (self cogMethodDoesntLookKosher: cogMethod) = 0) ifFalse: [ok := false]]. (cogMethod cmType = CMMethod or: [cogMethod cmType = CMOpenPIC]) ifTrue: [(self asserta: ((self mapFor: cogMethod performUntil: #checkIfValidOopRefAndTarget:pc:cogMethod: arg: cogMethod asInteger) = 0)) ifFalse: [ok := false]]. + (cogMethod cmType = CMMethod + 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: + [(self asserta: (objectRepresentation checkValidDerivedObjectReference: cogMethod nextMethodOrIRCs)) ifFalse: + [ok := false]]]. cogMethod cmType = CMClosedPIC ifTrue: [(self asserta: (self noTargetsFreeInClosedPIC: cogMethod)) ifFalse: [ok := false]]. cogMethod := methodZone methodAfter: cogMethod]. ^ok! Item was changed: ----- Method: Cogit>>cogMethodDoesntLookKosher: (in category 'debugging') ----- cogMethodDoesntLookKosher: cogMethod "Check that the header fields onf a non-free method are consistent with the type. Answer 0 if it is ok, otherwise answer a code for the error." <api> <inline: false> <var: #cogMethod type: #'CogMethod *'> ((cogMethod blockSize bitAnd: objectMemory wordSize - 1) ~= 0 or: [cogMethod blockSize < (self sizeof: CogMethod) or: [cogMethod blockSize >= 32768]]) ifTrue: [^1]. cogMethod cmType = CMFree ifTrue: [^2]. cogMethod cmType = CMMethod ifTrue: [(objectMemory isIntegerObject: cogMethod methodHeader) ifFalse: [^11]. (objectRepresentation couldBeObject: cogMethod methodObject) ifFalse: [^12]. (cogMethod stackCheckOffset > 0 + and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue: - and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue: [^13]. + (SistaVM + and: [objectRepresentation canPinObjects + and: [cogMethod counters ~= 0]]) ifTrue: + [(objectRepresentation couldBeDerivedObject: cogMethod counters) ifFalse: + [^14]]. + (NewspeakVM + and: [objectRepresentation canPinObjects + and: [cogMethod nextMethodOrIRCs ~= 0]]) ifTrue: + [(objectRepresentation couldBeDerivedObject: cogMethod nextMethodOrIRCs) ifFalse: + [^15]]. ^0]. cogMethod cmType = CMOpenPIC ifTrue: [cogMethod blockSize ~= openPICSize ifTrue: [^21]. cogMethod methodHeader ~= 0 ifTrue: [^22]. "Check the nextOpenPIC link unless we're compacting" cogMethod objectHeader >= 0 ifTrue: [(cogMethod methodObject ~= 0 and: [cogMethod methodObject < methodZoneBase or: [cogMethod methodObject > (methodZone freeStart - openPICSize) or: [(cogMethod methodObject bitAnd: objectMemory wordSize - 1) ~= 0 or: [(self cCoerceSimple: cogMethod methodObject to: #'CogMethod *') cmType ~= CMOpenPIC]]]]) ifTrue: [^23]]. cogMethod stackCheckOffset ~= 0 ifTrue: [^24]. ^0]. cogMethod cmType = CMClosedPIC ifTrue: [cogMethod blockSize ~= closedPICSize ifTrue: [^31]. (cogMethod cPICNumCases between: 1 and: MaxCPICCases) ifFalse: [^32]. cogMethod methodHeader ~= 0 ifTrue: [^33]. cogMethod methodObject ~= 0 ifTrue: [^34]. ^0]. ^9! Item was changed: ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') ----- adjustAllOopsBy: bytesToShift "Adjust all oop references by the given number of bytes. This is done just after reading in an image when the new base address of the object heap is different from the base address in the image, or when loading multiple segments that have been coalesced. Also set bits in the classTableBitmap corresponding to used classes." | obj classIndex | self assert: self newSpaceIsEmpty. self countNumClassPagesPreSwizzle: bytesToShift. (bytesToShift ~= 0 or: [segmentManager numSegments > 1]) ifTrue: [obj := self objectStartingAt: oldSpaceStart. [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: [classIndex := self classIndexOf: obj. classIndex >= self isForwardedObjectClassIndexPun ifTrue: [self swizzleFieldsOfObject: obj] ifFalse: [classIndex = self isFreeObjectClassIndexPun ifTrue: [self swizzleFieldsOfFreeChunk: obj]]. + obj := self objectAfter: obj limit: endOfMemory]]! - obj := self objectAfter: obj]]! Item was changed: ----- Method: SpurMemoryManager>>freeListsObj (in category 'free space') ----- freeListsObj + self assert: (self firstIndexableField: (self oldSpaceObjectAfter: trueObj)) = freeLists. + ^self oldSpaceObjectAfter: trueObj! - self assert: (self firstIndexableField: (self objectAfter: trueObj)) = freeLists. - ^self objectAfter: trueObj! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory at al are initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:. endOfMemory is assumed to point to the end of the last object in the image. Assume: image reader also initializes the following variables: specialObjectsOop lastHash" <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: self baseHeaderSize = self baseHeaderSize. self assert: (self maxSlotsForAlloc * self wordSize) asInteger > 0. self bootstrapping ifFalse: [self initSegmentBridgeWithBytes: self bridgeSize at: endOfMemory - self bridgeSize]. segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. specialObjectsOop := segmentManager swizzleObj: specialObjectsOop. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = oldSpaceStart. + self assert: falseObj = (self oldSpaceObjectAfter: nilObj). + self assert: trueObj = (self oldSpaceObjectAfter: falseObj). + freeListObj := self oldSpaceObjectAfter: trueObj. + self setHiddenRootsObj: (self oldSpaceObjectAfter: freeListObj). - self assert: falseObj = (self objectAfter: nilObj). - self assert: trueObj = (self objectAfter: falseObj). - freeListObj := self objectAfter: trueObj. - self setHiddenRootsObj: (self objectAfter: freeListObj). markStack := self swizzleObjStackAt: MarkStackRootIndex. weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex. mournQueue := self swizzleObjStackAt: MournQueueRootIndex. self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). self initializeFreeSpacePostLoad: freeListObj. segmentManager collapseSegmentsPostSwizzle. self computeFreeSpacePostSwizzle. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space" self initializeNewSpaceVariables. scavenger initializeRememberedSet. segmentManager checkSegments. compactor biasForGC. "These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi." growHeadroom := 16*1024*1024. "headroom when growing" shrinkThreshold := 32*1024*1024. "free space before shrinking" self setHeapSizeAtPreviousGC. heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"! Item was changed: ----- Method: SpurMemoryManager>>mem:cp:y: (in category 'simulation') ----- mem: destAddress cp: sourceAddress y: bytes + "For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove." - "For SpurGenerationScavenger>>copyToFutureSpace:bytes:" <doNotGenerate> + self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress]) + or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]]). ^self mem: destAddress mo: sourceAddress ve: bytes! Item was added: + ----- Method: SpurMemoryManager>>oldSpaceObjectAfter: (in category 'object enumeration') ----- + oldSpaceObjectAfter: objOop + <api> + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following + an object doesn't have a saturated size field it must be a single-header object. If the word following + does have a saturated slotSize it must be the overflow size word." + <inline: false> + ^self objectAfter: objOop limit: endOfMemory! Item was added: + ----- Method: SpurMemoryManager>>printOopsSuchThat: (in category 'debug printing') ----- + printOopsSuchThat: function + <api> + <var: #function declareC: 'sqInt (*function)(sqInt)'> + self allHeapEntitiesDo: + [:o| + (self perform: function with: o) ifTrue: + [self printEntity: o]]! Item was changed: ----- Method: SpurMemoryManager>>startOfObject: (in category 'object enumeration') ----- startOfObject: objOop "Answer the start of objOop, which is either the address of the overflow size word, or objOop itself, depending on the size of the object. This may be applied to any kind of object, normal, forwarders or free chunks." + <returnTypeC: #usqInt> ^(self hasOverflowHeader: objOop) ifTrue: [objOop - self baseHeaderSize] ifFalse: [objOop]! Item was changed: ----- Method: SpurMemoryManager>>startOfObject:given: (in category 'object enumeration') ----- startOfObject: objOop given: rawNumSlots "Answer the start of objOop, which is either the address of the overflow size word, or objOop itself, depending on the size of the object. This may be applied to any kind of object, normal, forwarders or free chunks." + <returnTypeC: #usqInt> ^(self objectWithRawSlotsHasOverflowHeader: rawNumSlots) ifTrue: [objOop - self baseHeaderSize] ifFalse: [objOop]! Item was changed: CogClass subclass: #SpurPlanningCompactor + instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject relocationMap' - instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject' 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; + removeVariable: 'interestingObj'; + removeVariable: 'relocationMap'! - removeVariable: 'interestingObj'! Item was added: + ----- Method: SpurPlanningCompactor class>>identifySignedComparisons (in category 'analysis') ----- + identifySignedComparisons + "self identifySignedComparisons" + | vmm cg noise | + noise := #('(manager bytesInObject: largestFreeChunk) >= spaceEstimate' + '(self classIndexOf: o*) > self isForwardedObjectClassIndexPun' + 'GCModeFull > 0' + 'ReceiverIndex + (objectMemory integerValueOf: sp*) < (objectMemory lengthOf: o*)' + 'availableSpace > 0' + 'bytes + 2 * 8 > availableSpace' + 'fmt* < manager firstCompiledMethodFormat' + 'fmt* < self firstCompiledMethodFormat' + 'fmt* <= 5' + 'gcPhaseInProgress > 0' + 'i <= finishIndex' + 'i >= 0' + 'numPointerSlots > 0' + 'scavenger rememberedSetSize > 0'). + vmm := (VMMaker forPlatform: 'Cross') + interpreterClass: StackInterpreter; + options: #(ObjectMemory Spur32BitMemoryManager). + cg := [vmm buildCodeGeneratorForInterpreter] + on: Notification + do: [:ex| + ex tag == #getVMMaker + ifTrue: [ex resume: vmm] + ifFalse: [ex pass]]. + cg vmClass preGenerationHook: cg. + cg inferTypesForImplicitlyTypedVariablesAndMethods. + cg retainMethods: self selectors. + cg prepareMethods. + cg doInlining: true. + self selectors sort do: + [:sel| + (cg methodNamed: sel) ifNotNil: + [:m| + m parseTree nodesDo: + [:node| + (node isSend + and: [(#(< > <= >=) includes: node selector) + and: [({node receiver. node args first } anySatisfy: + [:o| (cg typeFor: o in: m) + ifNil: [true] + ifNotNil: [:t| (cg isIntegralCType: t) and: [t first ~= $u]]]) + and: [noise noneSatisfy: [:n| n match: node printString]]]]) ifTrue: + [Transcript ensureCr; nextPutAll: sel; space; print: node; flush]]]]! 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. - objectAfterLastMobileObject := manager objectAfter: lastMobileObject. self updatePointers. self copyAndUnmark: firstPass. manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: [firstPass := false. self reinitializeScan; updateSavedFirstFieldsSpaceIfNecessary]. self endCompaction! 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 do: [:o :n| 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]). - o > lastMobileObject ifTrue: - [self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. - ^true]. (manager isMarked: o) ifTrue: + [o > lastMobileObject ifTrue: + [self assert: ((manager isPinned: o) not or: [previousPin isNil]). + self freeFrom: toFinger upTo: manager endOfMemory previousPin: ((manager isPinned: o) ifTrue: [o] ifFalse: [previousPin]). + ^true]. + (manager isPinned: o) - [(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 := manager objectAfter: 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: [| done | self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). done := self noMobileObjectsAfter: 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. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:bytes:firstField: (in category 'compaction') ----- copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: firstField "Copy the object to toFinger, clearing its mark bit and restoring its firstField, which was overwritten with a forwarding pointer. Answer the number of bytes in the object, including overflow header." <inline: true> | numSlots destObj start | numSlots := manager rawNumSlotsOf: o. destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots) ifTrue: [toFinger + manager baseHeaderSize] ifFalse: [toFinger]. start := manager startOfObject: o given: numSlots. + "memmove must be used since the ranges may overlap." manager + mem: toFinger asVoidPointer mo: start asVoidPointer ve: bytes; - mem: toFinger asVoidPointer cp: start asVoidPointer y: bytes; setIsMarkedOf: destObj to: false; storePointerUnchecked: 0 ofObject: destObj withValue: firstField! Item was changed: ----- Method: SpurPlanningCompactor>>findNextMarkedPinnedAfter: (in category 'private') ----- findNextMarkedPinnedAfter: unpinnedObj <inline: true> | nextObj | self deny: ((manager isPinned: unpinnedObj) and: [manager isMarked: unpinnedObj]). nextObj := unpinnedObj. + [nextObj := manager oldSpaceObjectAfter: nextObj. + (self oop: nextObj isGreaterThanOrEqualTo: manager endOfMemory) ifTrue: - [nextObj := manager objectAfter: nextObj limit: manager endOfMemory. - nextObj >= manager endOfMemory ifTrue: [^nil]. (manager isPinned: nextObj) and: [manager isMarked: nextObj]] whileFalse. ^nextObj! 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 cCode: '' inSmalltalk: [relocationMap at: o put: savedFirstFieldPtr]! - ^toFinger + (manager bytesInObject: o)! Item was changed: ----- Method: SpurPlanningCompactor>>freeAllUnpinnedObjectsFromObject:toFinger: (in category 'private') ----- freeAllUnpinnedObjectsFromObject: nextObj toFinger: initialToFinger "Free all space from toFinger up, preserving only marked pinned objects, clearning their marked bits." | toFinger nextPinnedObj | <var: 'toFinger' type: #usqInt> <var: 'nextPinnedObj' type: #usqInt> toFinger := initialToFinger. nextPinnedObj := nextObj. [[nextPinnedObj >= manager endOfMemory or: [(manager isMarked: nextPinnedObj) and: [manager isPinned: nextPinnedObj]]] whileFalse: + [nextPinnedObj := manager objectAfter: nextPinnedObj limit: manager endOfMemory]. - [nextPinnedObj := manager objectAfter: nextPinnedObj]. nextPinnedObj < manager endOfMemory] whileTrue: [toFinger < (manager startOfObject: nextPinnedObj) ifTrue: [manager addFreeChunkWithBytes: (manager startOfObject: nextPinnedObj) - toFinger at: toFinger]. self unmarkPinned: nextPinnedObj. toFinger := manager addressAfter: nextPinnedObj. + nextPinnedObj := manager oldSpaceObjectAfter: nextPinnedObj]. - nextPinnedObj := manager objectAfter: nextPinnedObj]. toFinger < manager endOfMemory ifTrue: [manager addFreeChunkWithBytes: manager endOfMemory - toFinger at: toFinger]! Item was changed: ----- 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. seg segLimit < limit ifTrue: [pin := manager segmentManager bridgeFor: seg]]. [pin notNil] 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]. manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger! Item was changed: ----- Method: SpurPlanningCompactor>>initializeCompaction (in category 'compaction') ----- initializeCompaction manager checkFreeSpace: GCModeFull. self selectSavedFirstFieldsSpace. self unpinRememberedSet. manager resetFreeListHeads; totalFreeOldSpace: 0; beginSlidingCompaction. + savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop. + self cCode: '' inSmalltalk: [relocationMap := Dictionary new]! - savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop! 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 := manager objectAfter: 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. ^self noMobileObjectsAfter: o]]]]. savedFirstFieldsSpace top: top - manager bytesPerOop. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>savedFirstFieldsSpaceInFreeChunk (in category 'space management') ----- savedFirstFieldsSpaceInFreeChunk <inline: true> + ^savedFirstFieldsSpaceNotInOldSpace not + and: [self oop: savedFirstFieldsSpace start isGreaterThan: manager nilObject]! - ^savedFirstFieldsSpaceNotInOldSpace not and: [savedFirstFieldsSpace start >= manager nilObject]! Item was changed: ----- Method: SpurPlanningCompactor>>savedFirstFieldsSpaceWasAllocated (in category 'space management') ----- savedFirstFieldsSpaceWasAllocated <inline: true> + ^savedFirstFieldsSpaceNotInOldSpace + and: [self oop: savedFirstFieldsSpace start isGreaterThan: manager nilObject]! - ^savedFirstFieldsSpaceNotInOldSpace and: [savedFirstFieldsSpace start >= manager nilObject]! Item was changed: ----- Method: SpurPlanningCompactor>>unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: (in category 'private') ----- unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pinnedObj <inline: true> | nextObj | self assert: ((manager isPinned: pinnedObj) and: [manager isMarked: pinnedObj]). nextObj := pinnedObj. [self unmarkPinned: nextObj. + nextObj := manager oldSpaceObjectAfter: nextObj. + (self oop: nextObj isGreaterThanOrEqualTo: manager endOfMemory) ifTrue: - nextObj := manager objectAfter: nextObj limit: manager endOfMemory. - nextObj >= manager endOfMemory ifTrue: [^manager endOfMemory]. (manager isPinned: nextObj) and: [manager isMarked: nextObj]] whileTrue. ^nextObj! 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: - o >= firstFreeObject ifTrue: [^self]. 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 | + <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 := manager objectAfter: 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). ^self noMobileObjectsAfter: 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: - manager allOldSpaceObjectsFrom: (manager objectAfter: lastMobileObject) do: [:o| self check: o. self assert: (manager isMarked: o). self updatePointersIn: o]! Item was changed: ----- Method: SpurPlanningCompactor>>useSegmentForSavedFirstFieldsSpace: (in category 'space management') ----- useSegmentForSavedFirstFieldsSpace: spaceEstimate "Attempt to allocate a memory segment large enough to hold the savedFirstFieldsSpace. Invoked when neither eden nor a large free chunk are found to be big enough for the job." | allocatedSize | + <var: #segAddress type: #'void *'> (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" sqAllocateMemorySegmentOfSize: spaceEstimate Above: (self firstGapOfSizeAtLeast: spaceEstimate) AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: [:segAddress| savedFirstFieldsSpace + start: segAddress asUnsignedIntegerPtr; + limit: segAddress asUnsignedIntegerPtr + allocatedSize. - start: segAddress; - limit: segAddress + allocatedSize. savedFirstFieldsSpaceNotInOldSpace := true. self assert: self savedFirstFieldsSpaceWasAllocated. ^true]. ^false! Item was changed: ----- Method: SpurSegmentInfo>>segLimit (in category 'accessing') ----- segLimit + <returnTypeC: #usqInt> ^segSize + segStart! Item was changed: ----- Method: SpurSegmentManager>>notePinned: (in category 'pinning') ----- notePinned: objOop "Let the segmentManager mark which segments contain pinned objects" self assert: (manager isPinned: objOop). (manager isSegmentBridge: objOop) ifTrue: [manager setIsMarkedOf: objOop to: true] ifFalse: + [[self oop: (segments at: sweepIndex) segLimit isLessThan: objOop] whileTrue: - [[(segments at: sweepIndex) segLimit < objOop] whileTrue: [sweepIndex := sweepIndex + 1]. (segments at: sweepIndex) containsPinned: true]! Item was changed: ----- Method: StackInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') ----- commonVariable: rcvr at: index put: value cacheIndex: atIx "This code assumes the receiver has been identified at location atIx in the atCache." + <returnTypeC: #void> | stSize fmt fixedFields valToPut isCharacter | <inline: true> stSize := atCache at: atIx+AtCacheSize. ((self oop: index isGreaterThanOrEqualTo: 1) and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue: [fmt := atCache at: atIx+AtCacheFmt. fmt <= objectMemory weakArrayFormat ifTrue: [self assert: (objectMemory isContextNonImm: rcvr) not. fixedFields := atCache at: atIx+AtCacheFixedFields. ^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value]. fmt < objectMemory firstByteFormat ifTrue: "64, 32, & 16 bits" [objectMemory hasSpurMemoryManagerAPI ifTrue: [fmt >= objectMemory firstShortFormat ifTrue: [valToPut := (objectMemory isIntegerObject: value) ifTrue: [objectMemory integerValueOf: value] ifFalse: [-1]. (valToPut >= 0 and: [valToPut <= 65535]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. ^objectMemory storeShort16: index - 1 ofObject: rcvr withValue: valToPut]. fmt = objectMemory sixtyFourBitIndexableFormat ifTrue: [| val64ToPut | val64ToPut := self positive64BitValueOf: value. self successful ifTrue: [^objectMemory storeLong64: index - 1 ofObject: rcvr withValue: val64ToPut]. ^self primitiveFailFor: PrimErrBadArgument]]. valToPut := self positive32BitValueOf: value. self successful ifTrue: [^objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut]. ^self primitiveFailFor: PrimErrBadArgument]. fmt >= objectMemory firstStringyFakeFormat "Note fmt >= firstStringyFormat is an artificial flag for strings" ifTrue: [isCharacter := objectMemory isCharacterObject: value. isCharacter ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. objectMemory hasSpurMemoryManagerAPI ifTrue: [valToPut := objectMemory characterValueOf: value] ifFalse: [valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value. valToPut := (objectMemory isIntegerObject: valToPut) ifTrue: [objectMemory integerValueOf: valToPut] ifFalse: [-1]]. objectMemory hasSpurMemoryManagerAPI ifTrue: [fmt < (objectMemory firstByteFormat + objectMemory firstStringyFakeFormat) ifTrue: [fmt < (objectMemory firstShortFormat + objectMemory firstStringyFakeFormat) ifTrue: [self assert: fmt ~= (objectMemory sixtyFourBitIndexableFormat + objectMemory firstStringyFakeFormat). ^objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut] ifFalse: [(valToPut >= 0 and: [valToPut <= 65535]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. ^objectMemory storeShort16: index - 1 ofObject: rcvr withValue: valToPut]]]] ifFalse: [(fmt >= objectMemory firstCompiledMethodFormat and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: [^self primitiveFailFor: PrimErrBadIndex]. valToPut := (objectMemory isIntegerObject: value) ifTrue: [objectMemory integerValueOf: value] ifFalse: [-1]]. (valToPut >= 0 and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. ^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut]. ^self primitiveFailFor: ((objectMemory isIndexable: rcvr) ifFalse: [PrimErrBadReceiver] ifTrue: [PrimErrBadIndex])! Item was changed: ----- Method: VMClass>>mem:cp:y: (in category 'C library simulation') ----- + mem: dString cp: sString y: bytes - mem: aString cp: bString y: n <doNotGenerate> + "implementation of memcpy(3). N.B. If ranges overlap, must use memmove." + (dString isString or: [sString isString]) ifFalse: + [| destAddress sourceAddress | + destAddress := dString asInteger. + sourceAddress := sString asInteger. + self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress]) + or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])]. + dString isString - "implementation of memcpy(3)" - aString isString ifTrue: + [1 to: bytes do: - [1 to: n do: [:i| | v | + v := sString isString + ifTrue: [sString at: i] + ifFalse: [Character value: (self byteAt: sString + i - 1)]. + dString at: i put: v]] - v := bString isString - ifTrue: [bString at: i] - ifFalse: [Character value: (self byteAt: bString + i - 1)]. - aString at: i put: v]] ifFalse: + [1 to: bytes do: - [1 to: n do: [:i| | v | + v := sString isString + ifTrue: [(sString at: i) asInteger] + ifFalse: [self byteAt: sString + i - 1]. + self byteAt: dString + i - 1 put: v]]. + ^dString! - v := bString isString - ifTrue: [(bString at: i) asInteger] - ifFalse: [self byteAt: bString + i - 1]. - self byteAt: aString + i - 1 put: v]]. - ^aString!

1 0

VM Maker: VMMaker.oscog-cb.2113.mcz
by commits＠source.squeak.org 27 Jan '17

27 Jan '17

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2113.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2113 Author: cb Time: 27 January 2017, 2:45:56.09265 pm UUID: fc17c325-6a18-402c-8873-7e7facf7104d Ancestors: VMMaker.oscog-cb.2112 Changed the machine compilation of BranchIfInstanceOf if there is one Behavior and the behavior is UndefinedObject, True and False to compile to a direct comparison to the unique instances instead of class index check. I am not sure it makes sense to add these cases when there are multiple behaviors. Added a new trampoline to create new hashes. Unfortunately I did not succeed in using the trampoline in the existing primitives, so I made the trampoline Sista only and it's used in the inlined primitive. =============== Diff against VMMaker.oscog-cb.2112 =============== Item was added: + ----- Method: CoInterpreter>>ceNewHashOf: (in category 'trampolines') ----- + ceNewHashOf: anObject + <api> + <option: #SistaVM> + "We know anObject has not a hash yet (or this trampoline would not be called. + Sets the hash, then answers it as a smallinteger" + ^ objectMemory integerObjectOf: (objectMemory newHashBitsOf: anObject)! Item was changed: CogObjectRepresentation subclass: #CogObjectRepresentationForSpur + instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceSmallActiveContextInFullBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline ceLargeActiveContextInFullBlockTrampoline ceStoreCheckContextReceiverTrampoline ceStoreTrampolines ceNewHashTrampoline' - instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceSmallActiveContextInFullBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline ceLargeActiveContextInFullBlockTrampoline ceStoreCheckContextReceiverTrampoline ceStoreTrampolines' classVariableNames: 'CheckRememberedInTrampoline NumStoreTrampolines' poolDictionaries: 'VMBytecodeConstants VMSqueakClassIndices' category: 'VMMaker-JIT'! Item was changed: ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in category 'accessing') ----- numTrampolines ^super numTrampolines + (SistaV1BytecodeSet ifTrue: [8] "(small,large)x(method,block,fullBlock) context creation, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline" + ifFalse: [6] "(small,large)x(method,block) context creation, - ifFalse: [6] "(small,large)x(method,block) context creation, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline") + ((initializationOptions at: #IMMUTABILITY ifAbsent: [false]) ifTrue: [NumStoreTrampolines] + ifFalse: [0]) + + ((initializationOptions at: #SistaVM ifAbsent: [false]) + ifTrue: [1] "newHash" ifFalse: [0])! Item was changed: ----- Method: CogObjectRepresentationForSpur>>branchIf:instanceOfBehavior:target: (in category 'sista support') ----- branchIf: reg instanceOfBehavior: classObj target: targetFixUp "Generate a branch if reg is an instance of classObj, otherwise fall- through. Cannot change the value of reg (may be used afterwards)." | classIndex jmp | <inline: true> <var: #targetFixUp type: #'AbstractInstruction *'> <var: #jmp type: #'AbstractInstruction *'> classIndex := objectMemory classTagForClass: classObj. + classIndex = (objectMemory fetchClassTagOf: objectMemory falseObject) + ifTrue: [ self branchIf: reg isOop: objectMemory falseObject target: targetFixUp ]. + classIndex = (objectMemory fetchClassTagOf: objectMemory trueObject) + ifTrue: [ self branchIf: reg isOop: objectMemory trueObject target: targetFixUp ]. + classIndex = (objectMemory fetchClassTagOf: objectMemory nilObject) + ifTrue: [ self branchIf: reg isOop: objectMemory nilObject target: targetFixUp ]. (objectMemory isImmediateClass: classObj) ifTrue: [self branchIf: reg hasImmediateTag: classIndex target: targetFixUp ] ifFalse: [jmp := (self genJumpImmediate: reg) . self genGetClassIndexOfNonImm: reg into: TempReg. self genCmpClassIndex: classIndex R: TempReg. cogit JumpZero: targetFixUp. jmp jmpTarget: cogit Label ]. ^0! Item was added: + ----- Method: CogObjectRepresentationForSpur>>branchIf:isNotOop:target: (in category 'sista support') ----- + branchIf: reg isNotOop: oop target: targetFixup + <var: #targetFixUp type: #'AbstractInstruction *'> + <inline: true> + cogit CmpCq: oop R: reg. + cogit JumpNonZero: targetFixup. + ^ 0! Item was added: + ----- Method: CogObjectRepresentationForSpur>>branchIf:isOop:target: (in category 'sista support') ----- + branchIf: reg isOop: oop target: targetFixup + <var: #targetFixUp type: #'AbstractInstruction *'> + <inline: true> + cogit CmpCq: oop R: reg. + cogit JumpZero: targetFixup. + ^ 0! Item was changed: ----- Method: CogObjectRepresentationForSpur>>branchIf:notInstanceOfBehavior:target: (in category 'sista support') ----- branchIf: reg notInstanceOfBehavior: classObj target: targetFixUp "Generate a branch if reg is an instance of classObj, otherwise fall- through. Cannot change the value of reg (may be used afterwards)." | classIndex | <inline: true> <var: #targetFixUp type: #'AbstractInstruction *'> classIndex := objectMemory classTagForClass: classObj. + classIndex = (objectMemory fetchClassTagOf: objectMemory falseObject) + ifTrue: [ self branchIf: reg isNotOop: objectMemory falseObject target: targetFixUp ]. + classIndex = (objectMemory fetchClassTagOf: objectMemory trueObject) + ifTrue: [ self branchIf: reg isNotOop: objectMemory trueObject target: targetFixUp ]. + classIndex = (objectMemory fetchClassTagOf: objectMemory nilObject) + ifTrue: [ self branchIf: reg isNotOop: objectMemory nilObject target: targetFixUp ]. (objectMemory isImmediateClass: classObj) ifTrue: [self branchIf: reg hasNotImmediateTag: classIndex target: targetFixUp ] ifFalse: [(self genJumpImmediate: reg) jmpTarget: targetFixUp. self genGetClassIndexOfNonImm: reg into: TempReg. self genCmpClassIndex: classIndex R: TempReg. cogit JumpNonZero: targetFixUp ]. ^0! Item was added: + ----- Method: CogObjectRepresentationForSpur>>genGetIdentityHash:resultReg: (in category 'sista support') ----- + genGetIdentityHash: rcvrReg resultReg: resultReg + <var: #jumpSet type: #'AbstractInstruction *'> + | jumpSet | + "ReceiverResultReg is required for the trampoline. We force the allocation, + and we have two path to avoid conflicts in ReceiverResultReg." + cogit voidReceiverResultRegContainsSelf. + resultReg = ReceiverResultReg + ifTrue: + [cogit ssTop popToReg: rcvrReg. + self genGetHashFieldNonImmOf: rcvrReg asSmallIntegerInto: resultReg. + cogit CmpCq: ConstZero R: resultReg. + jumpSet := cogit JumpNonZero: 0. + cogit MoveR: rcvrReg R: resultReg. + cogit CallRT: ceNewHashTrampoline. + cogit annotateBytecode: cogit Label] + ifFalse: + [cogit ssTop popToReg: ReceiverResultReg. + self genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: resultReg. + cogit CmpCq: ConstZero R: resultReg. + jumpSet := cogit JumpNonZero: 0. + cogit CallRT: ceNewHashTrampoline. + cogit annotateBytecode: (cogit MoveR: ReceiverResultReg R: resultReg)]. + jumpSet jmpTarget: cogit Label.! Item was added: + ----- Method: CogObjectRepresentationForSpur>>genNewHashTrampoline (in category 'initialization') ----- + genNewHashTrampoline + "In non sista VM this is used only from the identityHash primitive, hence only the result of the trampoline, the hash, should be in ReceiverResultReg, other registers can just be ignored. + In the sista VM, the inlined hash operation requires registers to be saved" + <inline: true> + <option: #SistaVM> + ^ cogit + genTrampolineFor: 1 + called: 'newHashTrampoline' + numArgs: 1 + arg: ReceiverResultReg + arg: nil + arg: nil + arg: nil + regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg)) + pushLinkReg: true + resultReg: ReceiverResultReg + appendOpcodes: true! Item was changed: ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') ----- generateObjectRepresentationTrampolines "Do the store check. Answer the argument for the benefit of the code generator; ReceiverResultReg may be caller-saved and hence smashed by this call. Answering it allows the code generator to reload ReceiverResultReg cheaply. In Spur the only thing we leave to the run-time is adding the receiver to the remembered set and setting its isRemembered bit." self cppIf: IMMUTABILITY ifTrue: [self cCode: [] inSmalltalk: [ceStoreTrampolines := CArrayAccessor on: (Array new: NumStoreTrampolines)]. 0 to: NumStoreTrampolines - 1 do: [:instVarIndex | ceStoreTrampolines at: instVarIndex put: (self genStoreTrampolineCalled: (cogit trampolineName: 'ceStoreTrampoline' numArgs: instVarIndex limit: NumStoreTrampolines - 2) instVarIndex: instVarIndex)]]. + SistaVM ifTrue: [ceNewHashTrampoline := self genNewHashTrampoline]. ceStoreCheckTrampoline := self genStoreCheckTrampoline. ceStoreCheckContextReceiverTrampoline := self genStoreCheckContextReceiverTrampoline. ceScheduleScavengeTrampoline := cogit genTrampolineFor: #ceScheduleScavenge called: 'ceScheduleScavengeTrampoline' regsToSave: CallerSavedRegisterMask. ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: 0 called: 'ceSmallMethodContext'. ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InVanillaBlock called: 'ceSmallBlockContext'. SistaV1BytecodeSet ifTrue: [ceSmallActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InFullBlock called: 'ceSmallFullBlockContext']. ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: 0 called: 'ceLargeMethodContext'. ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InVanillaBlock called: 'ceLargeBlockContext'. SistaV1BytecodeSet ifTrue: [ceLargeActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InFullBlock called: 'ceLargeFullBlockContext']. LowcodeVM ifTrue: [ self generateLowcodeObjectTrampolines ]! Item was changed: ----- Method: SistaCogit>>genUnaryInlinePrimitive: (in category 'inline primitive generators') ----- genUnaryInlinePrimitive: prim "Unary inline primitives." "SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution. See EncoderForSistaV1's class comment and StackInterpreter>>#unaryInlinePrimitive:" | rcvrReg resultReg | rcvrReg := self allocateRegForStackEntryAt: 0. resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg). prim caseOf: { "00 unchecked class" [1] -> "01 unchecked pointer numSlots" [self ssTop popToReg: rcvrReg. self ssPop: 1. objectRepresentation genGetNumSlotsOf: rcvrReg into: resultReg; genConvertIntegerToSmallIntegerInReg: resultReg]. "02 unchecked pointer basicSize" [3] -> "03 unchecked byte numBytes" [self ssTop popToReg: rcvrReg. self ssPop: 1. objectRepresentation genGetNumBytesOf: rcvrReg into: resultReg; genConvertIntegerToSmallIntegerInReg: resultReg]. "04 unchecked short16Type format numShorts" "05 unchecked word32Type format numWords" "06 unchecked doubleWord64Type format numDoubleWords" [11] -> "11 unchecked fixed pointer basicNew" [self ssTop type ~= SSConstant ifTrue: [^EncounteredUnknownBytecode]. (objectRepresentation genGetInstanceOf: self ssTop constant into: resultReg initializingIf: self extBSpecifiesInitializeInstance) ~= 0 ifTrue: [^ShouldNotJIT]. "e.g. bad class" self ssPop: 1] . [20] -> "20 identityHash" + [objectRepresentation genGetIdentityHash: rcvrReg resultReg: resultReg. - [self ssTop popToReg: rcvrReg. - objectRepresentation genGetHashFieldNonImmOf: rcvrReg asSmallIntegerInto: resultReg. self ssPop: 1] . "21 identityHash (SmallInteger)" "22 identityHash (Character)" "23 identityHash (SmallFloat64)" "24 identityHash (Behavior)" "30 immediateAsInteger (Character) 31 immediateAsInteger (SmallFloat64)" [30] -> [self ssTop popToReg: resultReg. objectRepresentation genConvertCharacterToSmallIntegerInReg: resultReg. self ssPop: 1] } otherwise: [^EncounteredUnknownBytecode]. extB := 0. numExtB := 0. self ssPushRegister: resultReg. ^0! Item was changed: ----- Method: Spur32BitMemoryManager>>fetchClassTagOf: (in category 'interpreter access') ----- fetchClassTagOf: oop + <api> | tagBits | ^(tagBits := oop bitAnd: self tagMask) ~= 0 ifTrue: [(tagBits bitAnd: 1) ~= 0 ifTrue: [1] ifFalse: [tagBits]] ifFalse: [self classIndexOf: oop]! Item was changed: ----- Method: SpurMemoryManager>>hashBitsOf: (in category 'header access') ----- hashBitsOf: objOop | hash | hash := self rawHashBitsOf: objOop. hash = 0 ifTrue: ["would like to assert self assert: (coInterpreter addressCouldBeClassObj: objOop) not but instance-specific behaviors that are instances of themselves may fail this test." + hash := self newHashBitsOf: objOop]. - hash := self newObjectHash bitAnd: self identityHashHalfWordMask. - self setHashBitsOf: objOop to: hash]. ^hash! Item was added: + ----- Method: SpurMemoryManager>>newHashBitsOf: (in category 'header access') ----- + newHashBitsOf: objOop + | hash | + hash := self newObjectHash bitAnd: self identityHashHalfWordMask. + self setHashBitsOf: objOop to: hash. + ^hash!

1 0

VM Maker: VMMaker.oscog-cb.2112.mcz
by commits＠source.squeak.org 27 Jan '17

27 Jan '17

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2112.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.2112 Author: cb Time: 27 January 2017, 11:20:49.720702 am UUID: da836ca3-c10f-45c5-afb4-e6f03a69ea3b Ancestors: VMMaker.oscog-eem.2111 Fixed a bug where the CogVMFeatureFlags were converted twice to SmallInteger (in getCogVMFeatureFlags and in primitiveVMParameter), shifting 1 time too many the flags. Hence MULTIPLEBYTECODESETS flag was always true in the image while SUPPORTSWRITEBARRIER was true only if the VM supported multiple bytecode set. =============== Diff against VMMaker.oscog-eem.2111 =============== Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') ----- (excessive size, no diff calculated)

1 0

[OpenSmalltalk/opensmalltalk-vm] 432435: Apply jpeg patch 6b2 from the Independent JPEG Gro...
by GitHub 27 Jan '17

27 Jan '17

Branch: refs/heads/jpeg_security_patch Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 43243560de2033841f2bdf815e81ddee1016e789 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/43243560de2033841f… Author: Nicolas Cellier <nicolas.cellier(a)sirehna.com> Date: 2017-01-25 (Wed, 25 Jan 2017) Changed paths: A platforms/Cross/plugins/JPEGReadWriter2Plugin/README A platforms/Cross/plugins/JPEGReadWriter2Plugin/README.6b2 M platforms/Cross/plugins/JPEGReadWriter2Plugin/jdmarker.c Log Message: ----------- Apply jpeg patch 6b2 from the Independent JPEG Group (IJG) This patch is available thru http://jpegclub.org/support/ Also add the original README from IJG. It's usefull for clearly identifying the origin of this 3rd party code and contains necessary legal notice about distribution.

1 0

[OpenSmalltalk/opensmalltalk-vm] 13aa7f: CogVM source as per VMMaker.oscogSPC-eem.2114
by GitHub 27 Jan '17

27 Jan '17

Branch: refs/heads/SpurPlanningCompactor Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 13aa7f60a2747308ebb4df8495a35765a49d9a38 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/13aa7f60a2747308eb… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2017-01-26 (Thu, 26 Jan 2017) Changed paths: M .gitignore M nsspur64src/vm/cogit.h M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M spur64src/vm/cogit.h M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/gcc3x-cointerp.c M spursista64src/vm/cogit.h M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/gcc3x-cointerp.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M src/vm/cogit.h Log Message: ----------- CogVM source as per VMMaker.oscogSPC-eem.2114 Temporary branch for SpurPlanningCompactor as default compactor. Get the termination condition for copyAndUnmarkMobileObjects right. Only exit prematurely when finding a marked object beyond lastMobileObject. Nuke the nonsense added to freeFrom:upTo:previousPin: in the previous commit. Use objectAfter:limit: in SpurPlannignCompactor and add oldSpaceObjectAfter: and use appropriately to avoid the overhead in objectAfter:. Add printOopsSuchThat: for debugging. Ignore a few more nonsense files in the image directory.

1 0

VM Maker: VMMaker.oscogSPC-eem.2114.mcz
by commits＠source.squeak.org 27 Jan '17

27 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2114.mcz ==================== Summary ==================== Name: VMMaker.oscogSPC-eem.2114 Author: eem Time: 26 January 2017, 3:20:49.726653 pm UUID: 68d01a10-0243-46de-b1cb-65d460eecf2b Ancestors: VMMaker.oscogSPC-eem.2113 Temporary branch for SpurPlanningCompactor as default compactor. Get the termination condition for copyAndUnmarkMobileObjects right. Only exit prematurely when finding a marked object beyond lastMobileObject. Nuke the nonsense added to freeFrom:upTo:previousPin: in the previous commit. Use objectAfter:limit: in SpurPlannignCompactor and add oldSpaceObjectAfter: and use appropriately to avoid the overhead in objectAfter:. Add printOopsSuchThat: for debugging. =============== Diff against VMMaker.oscogSPC-eem.2113 =============== Item was changed: ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') ----- adjustAllOopsBy: bytesToShift "Adjust all oop references by the given number of bytes. This is done just after reading in an image when the new base address of the object heap is different from the base address in the image, or when loading multiple segments that have been coalesced. Also set bits in the classTableBitmap corresponding to used classes." | obj classIndex | self assert: self newSpaceIsEmpty. self countNumClassPagesPreSwizzle: bytesToShift. (bytesToShift ~= 0 or: [segmentManager numSegments > 1]) ifTrue: [obj := self objectStartingAt: oldSpaceStart. [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: [classIndex := self classIndexOf: obj. classIndex >= self isForwardedObjectClassIndexPun ifTrue: [self swizzleFieldsOfObject: obj] ifFalse: [classIndex = self isFreeObjectClassIndexPun ifTrue: [self swizzleFieldsOfFreeChunk: obj]]. + obj := self objectAfter: obj limit: endOfMemory]]! - obj := self objectAfter: obj]]! Item was changed: ----- Method: SpurMemoryManager>>freeListsObj (in category 'free space') ----- freeListsObj + self assert: (self firstIndexableField: (self oldSpaceObjectAfter: trueObj)) = freeLists. + ^self oldSpaceObjectAfter: trueObj! - self assert: (self firstIndexableField: (self objectAfter: trueObj)) = freeLists. - ^self objectAfter: trueObj! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory at al are initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:. endOfMemory is assumed to point to the end of the last object in the image. Assume: image reader also initializes the following variables: specialObjectsOop lastHash" <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: self baseHeaderSize = self baseHeaderSize. self assert: (self maxSlotsForAlloc * self wordSize) asInteger > 0. self bootstrapping ifFalse: [self initSegmentBridgeWithBytes: self bridgeSize at: endOfMemory - self bridgeSize]. segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. specialObjectsOop := segmentManager swizzleObj: specialObjectsOop. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = oldSpaceStart. + self assert: falseObj = (self oldSpaceObjectAfter: nilObj). + self assert: trueObj = (self oldSpaceObjectAfter: falseObj). + freeListObj := self oldSpaceObjectAfter: trueObj. + self setHiddenRootsObj: (self oldSpaceObjectAfter: freeListObj). - self assert: falseObj = (self objectAfter: nilObj). - self assert: trueObj = (self objectAfter: falseObj). - freeListObj := self objectAfter: trueObj. - self setHiddenRootsObj: (self objectAfter: freeListObj). markStack := self swizzleObjStackAt: MarkStackRootIndex. weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex. mournQueue := self swizzleObjStackAt: MournQueueRootIndex. self assert: self validObjStacks. self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). self initializeFreeSpacePostLoad: freeListObj. segmentManager collapseSegmentsPostSwizzle. self computeFreeSpacePostSwizzle. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space" self initializeNewSpaceVariables. scavenger initializeRememberedSet. segmentManager checkSegments. compactor biasForGC. "These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi." growHeadroom := 16*1024*1024. "headroom when growing" shrinkThreshold := 32*1024*1024. "free space before shrinking" self setHeapSizeAtPreviousGC. heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"! Item was added: + ----- Method: SpurMemoryManager>>oldSpaceObjectAfter: (in category 'object enumeration') ----- + oldSpaceObjectAfter: objOop + <api> + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following + an object doesn't have a saturated size field it must be a single-header object. If the word following + does have a saturated slotSize it must be the overflow size word." + <inline: false> + ^self objectAfter: objOop limit: endOfMemory! Item was added: + ----- Method: SpurMemoryManager>>printOopsSuchThat: (in category 'debug printing') ----- + printOopsSuchThat: function + <api> + <var: #function declareC: 'sqInt (*function)(sqInt)'> + self allHeapEntitiesDo: + [:o| + (self perform: function with: o) ifTrue: + [self printEntity: o]]! 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. - objectAfterLastMobileObject := manager objectAfter: lastMobileObject. self updatePointers. self copyAndUnmark: firstPass. manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: [firstPass := false. self reinitializeScan; updateSavedFirstFieldsSpaceIfNecessary]. self endCompaction! 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 do: [:o :n| 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]). - o > lastMobileObject ifTrue: - [self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. - ^true]. (manager isMarked: o) ifTrue: + [o > lastMobileObject ifTrue: + [self assert: ((manager isPinned: o) not or: [previousPin isNil]). + self freeFrom: toFinger upTo: manager endOfMemory previousPin: ((manager isPinned: o) ifTrue: [o] ifFalse: [previousPin]). + ^true]. + (manager isPinned: o) - [(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 := manager objectAfter: 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: [| done | self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop). done := self noMobileObjectsAfter: 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. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>findNextMarkedPinnedAfter: (in category 'private') ----- findNextMarkedPinnedAfter: unpinnedObj <inline: true> | nextObj | self deny: ((manager isPinned: unpinnedObj) and: [manager isMarked: unpinnedObj]). nextObj := unpinnedObj. + [nextObj := manager oldSpaceObjectAfter: nextObj. - [nextObj := manager objectAfter: nextObj limit: manager endOfMemory. (self oop: nextObj isGreaterThanOrEqualTo: manager endOfMemory) ifTrue: [^nil]. (manager isPinned: nextObj) and: [manager isMarked: nextObj]] whileFalse. ^nextObj! Item was changed: ----- Method: SpurPlanningCompactor>>freeAllUnpinnedObjectsFromObject:toFinger: (in category 'private') ----- freeAllUnpinnedObjectsFromObject: nextObj toFinger: initialToFinger "Free all space from toFinger up, preserving only marked pinned objects, clearning their marked bits." | toFinger nextPinnedObj | <var: 'toFinger' type: #usqInt> <var: 'nextPinnedObj' type: #usqInt> toFinger := initialToFinger. nextPinnedObj := nextObj. [[nextPinnedObj >= manager endOfMemory or: [(manager isMarked: nextPinnedObj) and: [manager isPinned: nextPinnedObj]]] whileFalse: + [nextPinnedObj := manager objectAfter: nextPinnedObj limit: manager endOfMemory]. - [nextPinnedObj := manager objectAfter: nextPinnedObj]. nextPinnedObj < manager endOfMemory] whileTrue: [toFinger < (manager startOfObject: nextPinnedObj) ifTrue: [manager addFreeChunkWithBytes: (manager startOfObject: nextPinnedObj) - toFinger at: toFinger]. self unmarkPinned: nextPinnedObj. toFinger := manager addressAfter: nextPinnedObj. + nextPinnedObj := manager oldSpaceObjectAfter: nextPinnedObj]. - nextPinnedObj := manager objectAfter: nextPinnedObj]. toFinger < manager endOfMemory ifTrue: [manager addFreeChunkWithBytes: manager endOfMemory - toFinger at: toFinger]! Item was changed: ----- 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 toFinger is past lastMobileObject then it was impossible to move an object past a pin - and toFinger is pointing at an object. The object may be a pin which must be preserved." - effectiveToFinger > lastMobileObject ifTrue: - [effectiveToFinger >= limit ifTrue: - [^self]. - nextUnpinned := manager objectStartingAt: effectiveToFinger. - [(manager isPinned: nextUnpinned) and: [manager isMarked: nextUnpinned]] whileTrue: - [nextUnpinned := manager objectAfter: nextUnpinned. - nextUnpinned >= limit ifTrue: - [^self]]. - effectiveToFinger := manager startOfObject: nextUnpinned. - (previousPinOrNil notNil and: [effectiveToFinger > previousPinOrNil]) ifTrue: - [pin := nil]]. "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. seg segLimit < limit ifTrue: [pin := manager segmentManager bridgeFor: seg]]. [pin notNil] 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]. manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger! Item was changed: ----- Method: SpurPlanningCompactor>>logPhase: (in category 'private') ----- logPhase: phaseName <inline: true> + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: phaseName; flush].! - self break. - self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: phaseName; flush]. ! 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 := manager objectAfter: 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. ^self noMobileObjectsAfter: o]]]]. savedFirstFieldsSpace top: top - manager bytesPerOop. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: (in category 'private') ----- unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pinnedObj <inline: true> | nextObj | self assert: ((manager isPinned: pinnedObj) and: [manager isMarked: pinnedObj]). nextObj := pinnedObj. [self unmarkPinned: nextObj. + nextObj := manager oldSpaceObjectAfter: nextObj. - nextObj := manager objectAfter: nextObj limit: manager endOfMemory. (self oop: nextObj isGreaterThanOrEqualTo: manager endOfMemory) ifTrue: [^manager endOfMemory]. (manager isPinned: nextObj) and: [manager isMarked: nextObj]] whileTrue. ^nextObj! 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 := manager objectAfter: 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). ^self noMobileObjectsAfter: 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: - manager allOldSpaceObjectsFrom: (manager objectAfter: lastMobileObject) do: [:o| self check: o. self assert: (manager isMarked: o). self updatePointersIn: o]!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev January 2017