Vm-dev October 2013

vm-dev@lists.squeakfoundation.org

30 participants
145 discussions

VM Maker: VMMaker.oscog-eem.475.mcz
by commits＠source.squeak.org 25 Oct '13

25 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.475.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.475 Author: eem Time: 24 October 2013, 4:05:28.947 pm UUID: 2dfcdc5a-bfbf-4797-8dae-eebe54a1ebbe Ancestors: VMMaker.oscog-eem.474 Revise and complete compaction (to the extent that the generated C compiles and links). Make highestObjects a SpurCircularBuffer, which itself is added. Change some arg vars to avoid shadowing warnings. Change some return types to #void to avoid self appearing. Add some <inline: false> to avoid inlining in whiles etc. Fix Slang for transformation of ifNotNil: (ifNil:ifNotNil: was handled). Fix Slang for inlining non-struct accessor methods of struct types. Fix Slang for invoking non-struct accessor methods of struct types with struct receivers (as opposed to pointer-to-struct receivers). Fix shouldExcludeReceiverAsFirstArgument: to filter-out struct fields that are implicit variables (i.e. aSpurCircularBuffer manager). Rename some isFoo: aCodeGen selectors to isFooIn: aCodeGen for consistency. typos. Spur Stack VM now links. =============== Diff against VMMaker.oscog-eem.474 =============== Item was removed: - ----- Method: CogMethodZone>>mem:mo:ve: (in category 'compaction') ----- - mem: destAddress mo: sourceAddress ve: bytes - <doNotGenerate> - | dst src | - dst := destAddress asInteger. - src := sourceAddress asInteger. - "Emulate the c library memmove function" - self assert: bytes \\ 4 = 0. - 0 to: bytes - 4 by: 4 do: - [:i| - objectMemory longAt: dst + i put: (objectMemory longAt: src + i)]! Item was changed: ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used." | rcvrOrNil sel args ifNotNilBlock | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. ((sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." or: [sel == #cCode:]) and: [arguments first isBlockNode]) ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. + args := arguments + select: [:arg| arg notNil] + thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod]. - args := (1 to: sel numArgs) collect: - [:i | (arguments at: i) asTranslatorNodeIn: aTMethod]. (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: ["Restore limit expr that got moved by transformToDo:" args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. args second. args third. "add the limit var as a hidden extra argument; we may need it later" TVariableNode new setName: arguments first key}]. (sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue: [sel := #ifFalse:. args := {args last}]. (sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. (sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args last}]. (sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. ((sel == #ifFalse: or: [sel == #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. "For the benefit of later passes, e.g. value: inlining, transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...], which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]." + ((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]]) - ((sel == #ifTrue: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]) and: [receiver notNil and: [receiver isAssignmentEqualsEqualsNil and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue: [ifNotNilBlock setArguments: #(). ^TStmtListNode new setArguments: #() statements: { receiver receiver asTranslatorNodeIn: aTMethod. TSendNode new setSelector: sel receiver: (TSendNode new setSelector: #== receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod) arguments: {receiver arguments first asTranslatorNodeIn: aTMethod}) arguments: args }]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was changed: ----- Method: Spur32BitCoMemoryManager>>edenBytes: (in category 'snapshot') ----- + edenBytes: bytes + newSpaceLimit := bytes + coInterpreter cogCodeSize! - edenBytes: edenBytes - newSpaceLimit := edenBytes + coInterpreter cogCodeSize! Item was added: + SpurNewSpaceSpace subclass: #SpurCircularBuffer + instanceVariableNames: 'manager first last' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-SpurMemoryManager'! + + !SpurCircularBuffer commentStamp: 'eem 10/23/2013 10:01' prior: 0! + A SpurCircularBuffer is a region of memory being used as a circular buffer. The buffer is empty when last < start. The buffer is full when first = (last + wordSize > limit ifTrue: [start] ifFalse: [last + wordSize]). + + Instance Variables + first: <Integer address> + last: <Integer address> + + first + - pointer to the first element in the buffer + + last + - pointer to the last element in the buffer + ! Item was added: + ----- Method: SpurCircularBuffer>>addLast: (in category 'accessing') ----- + addLast: element + | newLast | + newLast := last + manager wordSize. + newLast > limit ifTrue: + [newLast := start]. + (newLast = first and: [last >= start]) ifTrue: "wrapped; bump first" + [(first := newLast + manager wordSize) >= limit ifTrue: + [first := start]]. + last := newLast. + manager longAt: newLast put: element! Item was added: + ----- Method: SpurCircularBuffer>>first (in category 'accessing') ----- + first + "Answer the value of first" + + ^ first! Item was added: + ----- Method: SpurCircularBuffer>>first: (in category 'accessing') ----- + first: anObject + "Set the value of first" + + ^first := anObject! Item was added: + ----- Method: SpurCircularBuffer>>from:reverseDo: (in category 'enumerating') ----- + from: initialPtr reverseDo: aBlock + <inline: true> + | ptr | + last >= start ifTrue: + [ptr := initialPtr. + [aBlock value: (manager longAt: ptr). + ptr = first ifTrue: [^nil]. + (ptr := ptr - manager wordSize) < start ifTrue: + [ptr := limit]] repeat]. + ^nil! Item was added: + ----- Method: SpurCircularBuffer>>initializeStart:limit: (in category 'initialization') ----- + initializeStart: aStart limit: aLimit + self start: aStart; + limit: aLimit; + first: aStart; + last: aStart - manager wordSize! Item was added: + ----- Method: SpurCircularBuffer>>isEmpty (in category 'testing') ----- + isEmpty + ^last < start! Item was added: + ----- Method: SpurCircularBuffer>>last (in category 'accessing') ----- + last + "Answer the value of last" + + ^ last! Item was added: + ----- Method: SpurCircularBuffer>>last: (in category 'accessing') ----- + last: anObject + "Set the value of last" + + ^last := anObject! Item was added: + ----- Method: SpurCircularBuffer>>manager (in category 'accessing') ----- + manager + "Answer the value of manager" + + ^ manager! Item was added: + ----- Method: SpurCircularBuffer>>manager: (in category 'accessing') ----- + manager: anObject + "Set the value of manager" + <doNotGenerate> + ^manager := anObject! Item was added: + ----- Method: SpurCircularBuffer>>resetAsEmpty (in category 'accessing') ----- + resetAsEmpty + last := start - manager wordSize! Item was added: + ----- Method: SpurCircularBuffer>>reverseDo: (in category 'enumerating') ----- + reverseDo: aBlock + | ptr | + last >= start ifTrue: + [ptr := last. + [aBlock value: (manager longAt: ptr). + ptr = first ifTrue: [^nil]. + (ptr := ptr - manager wordSize) < start ifTrue: + [ptr := limit]] repeat]. + ^nil! Item was changed: ----- Method: SpurGenerationScavenger>>fireEphemeronsOnEphemeronList (in category 'weakness and ephemerality') ----- fireEphemeronsOnEphemeronList "There are ephemerons to be fired in the remembered set. Fire them and scavenge their keys. Be careful since copyAndForward: can remember ephemerons (ephemerons pointing to ephemerons)." + <returnTypeC: #void> | ephemeron ephemeronCorpse | ephemeronList ifNil: [^self]. ephemeronCorpse := self firstCorpse: ephemeronList. "Reset the list head so that new ephemerons will get added to a new list, not concatenated on the one we are scanning." ephemeronList := nil. [ephemeronCorpse notNil] whileTrue: [self assert: (manager isForwarded: ephemeronCorpse). ephemeron := manager followForwarded: ephemeronCorpse. self assert: (self isScavengeSurvivor: (manager keyOfEphemeron: ephemeron)) not. coInterpreter fireEphemeron: ephemeron. self copyAndForward: (manager keyOfEphemeron: ephemeron). self cCoerceSimple: (self scavengeReferentsOf: ephemeron) to: #void. ephemeronCorpse := self nextCorpseOrNil: ephemeronCorpse]! Item was changed: ----- Method: SpurGenerationScavenger>>newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') ----- newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes + | actualEdenBytes survivorBytes | - | edenBytes survivorBytes | + actualEdenBytes := requestedEdenBytes. + survivorBytes := totalBytes - actualEdenBytes // 2 truncateTo: manager allocationUnit. + actualEdenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit. + self assert: totalBytes - actualEdenBytes - survivorBytes - survivorBytes < manager allocationUnit. - edenBytes := requestedEdenBytes. - survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit. - edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit. - self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit. "for tenuring we require older objects below younger objects. since allocation grows up this means that the survivor spaces must preceed eden." pastSpace start: startAddress; limit: startAddress + survivorBytes. futureSpace start: pastSpace limit; limit: pastSpace limit + survivorBytes. + eden start: futureSpace limit; limit: futureSpace limit + actualEdenBytes. - eden start: futureSpace limit; limit: futureSpace limit + edenBytes. self assert: futureSpace limit <= (startAddress + totalBytes). self assert: eden start \\ manager allocationUnit + (eden limit \\ manager allocationUnit) = 0. self assert: pastSpace start \\ manager allocationUnit + (pastSpace limit \\ manager allocationUnit) = 0. self assert: futureSpace start \\ manager allocationUnit + (futureSpace limit \\ manager allocationUnit) = 0. self initFutureSpaceStart. manager initSpaceForAllocationCheck: (self addressOf: eden)! Item was changed: ----- Method: SpurGenerationScavenger>>remember: (in category 'store check') ----- remember: objOop + <inline: false> self assert: ((manager isNonImmediate: objOop) and: [(manager isYoung: objOop) not]). rememberedSetSize < RememberedSetLimit ifTrue: [rememberedSet at: rememberedSetSize put: objOop. (rememberedSetSize := rememberedSetSize + 1) >= RememberedSetRedZone ifTrue: [manager scheduleScavenge]] ifFalse: [self error: 'remembered set overflow' "for now"]! Item was changed: ----- Method: SpurMemoryManager class>>ancilliaryClasses: (in category 'translation') ----- ancilliaryClasses: options + ^{ SpurGenerationScavenger. SpurSegmentManager. SpurSegmentInfo }, + SpurNewSpaceSpace withAllSubclasses! - ^{ SpurGenerationScavenger. SpurNewSpaceSpace. - SpurSegmentManager. SpurSegmentInfo. - SpurContiguousObjStack }! Item was changed: ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks) in: aCCodeGenerator. self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']) in: aCCodeGenerator. aCCodeGenerator var: #freeLists type: #'sqInt *'; var: #classTableBitmap type: #'unsigned char *'; + var: #highestObjects type: #SpurCircularBuffer; - var: #highestObjects type: #SpurContiguousObjStack; var: #unscannedEphemerons type: #SpurContiguousObjStack. aCCodeGenerator var: #remapBuffer declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'. aCCodeGenerator var: #extraRoots declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.! Item was added: + ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') ----- + allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock + "Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock, + if available, otherwise answer nil. Break up a larger chunk if one of the exact + size cannot be found. N.B. the chunk is simply a pointer, it has no valid header. + The caller *must* fill in the header correctly." + | initialIndex node next prev index child acceptedChunk acceptedNode | + <inline: true> "must inline for acceptanceBlock" + "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" + initialIndex := chunkBytes / self allocationUnit. + (initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: + [(freeListsMask anyMask: 1 << initialIndex) ifTrue: + [(node := freeLists at: initialIndex) = 0 + ifTrue: [freeListsMask := freeListsMask - (1 << index)] + ifFalse: + [prev := 0. + [node ~= 0] whileTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + (acceptanceBlock value: node) ifTrue: + [prev = 0 + ifTrue: [freeLists at: index put: next] + ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. + ^node]. + node := next]]]. + "first search for free chunks of a multiple of chunkBytes in size" + index := initialIndex. + [(index := index + initialIndex) < self numFreeLists + and: [1 << index <= freeListsMask]] whileTrue: + [(freeListsMask anyMask: 1 << index) ifTrue: + [(node := freeLists at: index) = 0 + ifTrue: [freeListsMask := freeListsMask - (1 << index)] + ifFalse: + [prev := 0. + [node ~= 0] whileTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + (acceptanceBlock value: node) ifTrue: + [prev = 0 + ifTrue: [freeLists at: index put: next] + ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfObject: node) + chunkBytes. + ^node]. + node := next]. + self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + self unlinkFreeChunk: node atIndex: index. + self assert: (self bytesInObject: node) = (index * self allocationUnit). + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfObject: node) + chunkBytes. + ^node]]]. + "now get desperate and use the first that'll fit. + Note that because the minimum free size is 16 bytes (2 * allocationUnit), to + leave room for the forwarding pointer/next free link, we can only break chunks + that are at least 16 bytes larger, hence start at initialIndex + 2." + index := initialIndex + 1. + [(index := index + 1) < self numFreeLists + and: [1 << index <= freeListsMask]] whileTrue: + [(freeListsMask anyMask: 1 << index) ifTrue: + [(node := freeLists at: index) = 0 + ifTrue: [freeListsMask := freeListsMask - (1 << index)] + ifFalse: + [prev := 0. + [node ~= 0] whileTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + (acceptanceBlock value: node) ifTrue: + [prev = 0 + ifTrue: [freeLists at: index put: next] + ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfObject: node) + chunkBytes. + ^node]. + node := next]. + self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + self unlinkFreeChunk: node atIndex: index. + self assert: (self bytesInObject: node) = (index * self allocationUnit). + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfObject: node) + chunkBytes. + ^node]]]]. + + "Large chunk, or no space on small free lists. Search the large chunk list. + Large chunk list organized as a tree, each node of which is a list of chunks + of the same size. Beneath the node are smaller and larger blocks. + When the search ends parent should hold the smallest chunk at least as + large as chunkBytes, or 0 if none. acceptedChunk and acceptedNode save + us from having to back-up when the acceptanceBlock filters-out all nodes + of the right size, but there are nodes of the wrong size it does accept." + child := freeLists at: 0. + [child ~= 0] whileTrue: + [| childBytes | + 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: + [(acceptanceBlock value: node) ifTrue: + [self assert: (self isValidFreeObject: node). + self storePointer: self freeChunkNextIndex + ofFreeChunk: prev + withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node). + ^self startOfObject: node]]. + (acceptanceBlock value: node) ifTrue: + [node := child. + child := 0]]. "break out of loop to remove interior node" + child ~= 0 ifTrue: + ["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to + leave room for the forwarding pointer/next free link, we can only break chunks + that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger." + childBytes <= (chunkBytes + self allocationUnit) + ifTrue: "node too small; walk down the larger size of the tree" + [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] + ifFalse: + [acceptedNode = 0 ifTrue: + [acceptedChunk := child. + "first search the list." + [acceptedChunk := self fetchPointer: self freeChunkNextIndex + ofFreeChunk: acceptedChunk. + acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue: + [(acceptanceBlock value: acceptedChunk) ifTrue: + [acceptedNode := child]. + "nothing on the list; will the node do? This prefers + acceptable nodes higher up the tree over acceptable + list elements further down, but we haven't got all day..." + (acceptedNode = 0 + and: [acceptanceBlock value: child]) ifTrue: + [acceptedNode := child]]. + child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]]. + acceptedNode ~= 0 ifTrue: + [acceptedChunk ~= 0 ifTrue: + [self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit). + [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode. + next ~= acceptedChunk] whileTrue: + [acceptedNode := next]. + self storePointer: self freeChunkNextIndex + ofFreeChunk: acceptedNode + withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk). + self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes + at: (self startOfObject: acceptedChunk) + chunkBytes. + ^self startOfObject: acceptedChunk]. + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode. + next = 0 + ifTrue: "no list; remove the interior node" + [self unlinkSolitaryFreeTreeNode: acceptedNode] + ifFalse: "list; replace node with it" + [self inFreeTreeReplace: acceptedNode with: next]. + self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit). + self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes + at: (self startOfObject: acceptedNode) + chunkBytes. + ^self startOfObject: acceptedNode]. + totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" + ^nil! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') ----- allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock + "Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock, + if one of this size is available, otherwise answer nil. N.B. the chunk is simply a + pointer, it has no valid header. The caller *must* fill in the header correctly." + | index node next prev child childBytes | - "Answer a chunk of oldSpace from the free lists, if one of this size - is available, otherwise answer nil. N.B. the chunk is simply a pointer, - it has no valid header. The caller *must* fill in the header correctly." - | initialIndex node nodeBytes child | <inline: true> "must inline for acceptanceBlock" "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" + index := chunkBytes / self allocationUnit. + index < self numFreeLists ifTrue: + [1 << index <= freeListsMask ifTrue: + [(node := freeLists at: index) = 0 + ifTrue: [freeListsMask := freeListsMask - (1 << index)] + ifFalse: + [prev := 0. + [node ~= 0] whileTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + (acceptanceBlock value: node) ifTrue: + [prev = 0 + ifTrue: [freeLists at: index put: next] + ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^node]. + node := next]]]. - initialIndex := chunkBytes / self allocationUnit. - initialIndex < self numFreeLists ifTrue: - [(1 << initialIndex <= freeListsMask - and: [(node := freeLists at: initialIndex) ~= 0 - and: [acceptanceBlock value: node]]) ifTrue: - [self assert: node = (self startOfObject: node). - self assert: (self isValidFreeObject: node). - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self unlinkFreeChunk: node atIndex: initialIndex]. ^nil]. "Large chunk. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the first chunk of the same size as chunkBytes, or 0 if none." node := 0. child := freeLists at: 0. [child ~= 0] whileTrue: + [self assert: (self isValidFreeObject: child). - [| childBytes | - self assert: (self isValidFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes + ifTrue: "size match; try to remove from list at node first." + [node := child. + [prev := node. + node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + node ~= 0] whileTrue: + [(acceptanceBlock value: node) ifTrue: + [self assert: (self isValidFreeObject: node). + self storePointer: self freeChunkNextIndex + ofFreeChunk: prev + withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node). + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^self startOfObject: node]]. - ifTrue: "size match; try to remove from list at node." - [node := self fetchPointer: self freeChunkNextIndex - ofFreeChunk: child. - (node ~= 0 and: [acceptanceBlock value: node]) ifTrue: - [self assert: (self isValidFreeObject: node). - self storePointer: self freeChunkNextIndex - ofFreeChunk: child - withValue: (self fetchPointer: self freeChunkNextIndex - ofFreeChunk: node). - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self startOfObject: node]. node := child. - nodeBytes := childBytes. child := 0] "break out of loop to remove interior node" + ifFalse: "no size match; walk down the tree" + [child := self fetchPointer: (childBytes < chunkBytes + ifTrue: [self freeChunkLargerIndex] + ifFalse: [self freeChunkSmallerIndex]) + ofFreeChunk: child]]. - ifFalse: - [childBytes < chunkBytes - ifTrue: "walk down the tree" - [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] - ifFalse: - [nodeBytes := childBytes. - child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]. "if no chunk, there was no exact fit" (node ~= 0 and: [acceptanceBlock value: node]) ifFalse: [^nil]. "self printFreeChunk: parent" - self assert: nodeBytes = chunkBytes. self assert: (self bytesInObject: node) = chunkBytes. + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + next = 0 + ifTrue: "no list; remove the interior node" + [self unlinkSolitaryFreeTreeNode: node] + ifFalse: "list; replace node with it" + [self inFreeTreeReplace: node with: next]. - "can't be a list; would have removed and returned it above." - self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0. - - "no list; remove the interior node" - "N.B. This will fail when we try to remove the head node and there are still next links, - which is possible given acceptanceBlock but does not occur in current use." - self unlinkSolitaryFreeTreeNode: node. totalFreeOldSpace := totalFreeOldSpace - chunkBytes. ^self startOfObject: node! Item was changed: ----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') ----- bestFitCompact "Compact all of memory using best-fit, assuming free space is sorted and that the highest objects are recorded in highestObjects." + <returnTypeC: #void> + <inline: false> + | freePriorToExactFit | - | freePriorToExactFit firstFailedFit | freePriorToExactFit := totalFreeOldSpace. + self exactFitCompact. + highestObjects isEmpty ifTrue: + [^self]. "either no high objects, or no misfits." + highestObjects reverseDo: + [:o| | b | + self assert: ((self isForwarded: o) or: [self isPinned: o]) not. + b := self bytesInObject: o. + (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil: + [:f| + self mem: f + cp: o + y: ((self hasOverflowHeader: o) + ifTrue: [b - self baseHeaderSize] + ifFalse: [b]). + (self isRemembered: o) ifTrue: + [scavenger remember: f]. + self forward: o to: f]]. + self allOldSpaceObjectsFrom: firstFreeChunk - firstFailedFit := self exactFitCompact. - firstFailedFit = 0 ifTrue: - [^self]. "either no free space, no high objects, or no misfits." - self allOldSpaceObjectsFrom: firstFailedFit do: [:o| | b | ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil: [:f| self mem: f cp: o y: ((self hasOverflowHeader: o) ifTrue: [b - self baseHeaderSize] ifFalse: [b]). (self isRemembered: o) ifTrue: [scavenger remember: f]. + self forward: o to: f]]]. + self checkFreeSpace + self touch: freePriorToExactFit! - self forward: o to: f]. - self checkFreeSpace]]. - self checkFreeSpace! Item was added: + ----- Method: SpurMemoryManager>>capacityOfObjStack: (in category 'obj stacks') ----- + capacityOfObjStack: objStack + | total freeObj | + objStack = nilObj ifTrue: [^0]. + total := ObjStackLimit negated. + freeObj := objStack. + [freeObj ~= 0] whileTrue: + [total := total + ObjStackLimit. + freeObj := self fetchPointer: ObjStackFreex ofObject: freeObj]. + freeObj := objStack. + [freeObj ~= 0] whileTrue: + [total := total + ObjStackLimit. + freeObj := self fetchPointer: ObjStackNextx ofObject: freeObj]. + ^total! Item was changed: ----- Method: SpurMemoryManager>>edenBytes: (in category 'snapshot') ----- + edenBytes: bytes + newSpaceLimit := bytes! - edenBytes: edenBytes - newSpaceLimit := edenBytes! Item was added: + ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category 'gc - global') ----- + eliminateAndFreeForwarders + "As the final phase of global garbage collect, sweep + the heap to follow forwarders, then free forwarders" + | lowestForwarded firstForwarded lastForwarded | + lowestForwarded := 0. + self allOldSpaceObjectsDo: + [:o| + (self isForwarded: o) + ifTrue: + [lowestForwarded = 0 ifTrue: + [lowestForwarded := o]] + ifFalse: + [0 to: (self numPointerSlotsOf: o) - 1 do: + [:i| | f | + f := self fetchPointer: i ofObject: o. + (self isOopForwarded: f) ifTrue: + [f := self followForwarded: f. + self assert: ((self isImmediate: f) or: [self isYoung: f]) not. + self storePointerUnchecked: i ofObject: o withValue: f]]]]. + firstForwarded := lastForwarded := 0. + self allOldSpaceObjectsFrom: lowestForwarded do: + [:o| + (self isForwarded: o) + ifTrue: + [firstForwarded = 0 ifTrue: + [firstForwarded := o]. + lastForwarded := o] + ifFalse: + [firstForwarded ~= 0 ifTrue: + [| start bytes | + start := self startOfObject: firstForwarded. + bytes := (self addressAfter: lastForwarded) - start. + self addFreeChunkWithBytes: bytes at: start]. + firstForwarded := 0]]! Item was changed: ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') ----- exactFitCompact + "Compact all of memory above firstFreeChunk using exact-fit, assuming free + space is sorted and that the highest objects are recorded in highestObjects. + Note that we don't actually move; we merely copy and forward. Eliminating + forwarders will be done in a final pass. + Leave the objects that don't fit exactly, and hence aren't moved, in highestObjects." - "Compact all of memory using exact-fit, assuming free space is sorted - and that the highest objects are recorded in highestObjects." + <returnTypeC: #void> + <inline: false> + | failures first | + <var: #failures type: #usqInt> - | firstFailedFit top o | - <var: #top type: #unsigned> - firstFailedFit := 0. totalFreeOldSpace = 0 ifTrue: [^0]. + failures := highestObjects last + self wordSize. + [highestObjects from: failures - self wordSize reverseDo: + [:o| | b | + o < firstFreeChunk ifTrue: + [failures = (highestObjects last + self wordSize) + ifTrue: [highestObjects resetAsEmpty] + ifFalse: [highestObjects first: failures]. + ^self]. + ((self isForwarded: o) or: [self isPinned: o]) ifFalse: - top := highestObjects top. - [[top := top - self wordSize. - top < highestObjects start ifTrue: - [top := highestObjects limit]. - top ~= highestObjects top and: [(o := self longAt: top) > firstFreeChunk]] whileTrue: - [| b | - ((self isForwarded: o) - or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. + (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) + ifNil: + [failures := failures - self wordSize. + failures < highestObjects start ifTrue: + [failures := highestObjects limit]. + self longAt: failures put: o] - (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) - ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]] ifNotNil: [:f| self mem: f cp: o y: ((self hasOverflowHeader: o) ifTrue: [b - self baseHeaderSize] ifFalse: [b]). "wait until the next scavenge to unremember o" (self isRemembered: o) ifTrue: [scavenger remember: f]. self forward: o to: f]]]. + "now highestObjects contains only failures, if any, from failures to last. + set first to first failure and refill buffer. next cycle will add more failures. + give up on exact-fit when half of the highest objects fail to fit." + first := self longAt: highestObjects first. + first > firstFreeChunk ifTrue: + [| highestObjBytes failureBytes savedLimit | + highestObjBytes := highestObjects limit - highestObjects start. + failureBytes := highestObjects last >= failures + ifTrue: [highestObjects last - failures] + ifFalse: [highestObjBytes - (failures - highestObjects last)]. + failureBytes >= (highestObjBytes // 2) ifTrue: + [highestObjects first: failures. + ^self]. + savedLimit := self moveFailuresToTopOfHighestObjects: failures. + self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. + failures := self moveFailuresInHighestObjectsBack: savedLimit]] repeat! - top = highestObjects top and: [o > firstFreeChunk]] whileTrue: - [self fillHighestObjectsFrom: firstFreeChunk upTo: o]. - self checkFreeSpace. - ^firstFailedFit! Item was added: + ----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFrom:upTo: (in category 'compaction') ----- + fillHighestObjectsWithMovableObjectsFrom: startObj upTo: limitObj + "Refill highestObjects with movable objects up to, but not including limitObj. + c.f. the loop in freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace." + | lastHighest highestObjectsWraps | + lastHighest := highestObjects last. + highestObjectsWraps := 0. + self allOldSpaceObjectsFrom: startObj do: + [:o| + o >= limitObj ifTrue: + [highestObjects last: lastHighest. + ^nil]. + ((self isForwarded: o) or: [self isPinned: o]) ifFalse: + [false "conceptually...: " + ifTrue: [highestObjects addLast: o] + ifFalse: "but we inline so we can use the local lastHighest" + [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue: + [highestObjectsWraps := highestObjectsWraps + 1]. + self longAt: lastHighest put: o]]]. + highestObjects last: lastHighest! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings, + coalescing free chunks, and sorting free space. + + Small free chunks are sorted in address order on each small list head. Large free chunks + are sorted on the sortedFreeChunks list. Record as many of the highest objects as there + is room for in highestObjects, a circular buffer, for the use of exactFitCompact. Use + unused eden space for highestObjects. If highestObjects does not wrap, store 0 at + highestObjects last. Record the lowest free object in firstFreeChunk. Let the + segmentManager mark which segments contain pinned objects via notePinned:." + + | lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks | + <var: #lastHighest type: #usqInt> - coalescing free chunks, and sorting free space. Small free chunks are sorted in address - order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. - Record the highest N objects in highestObjects, for the first cycle of exactFitCompact. - Let the segmentManager mark which segments contain pinned objects via notePinned:" - | lastLargeFree highestObjectsWraps sortedFreeChunks | self checkFreeSpace. scavenger forgetUnmarkedRememberedObjects. segmentManager prepareForGlobalSweep."for notePinned:" "for sorting free space throw away the list heads, rebuilding them for small free chunks below." self resetFreeListHeads. + highestObjects initializeStart: freeStart limit: scavenger eden limit. + lastHighest := highestObjects last "a.k.a. freeStart - wordSize". - highestObjects - top: freeStart; - start: freeStart; - limit: scavenger eden limit. highestObjectsWraps := 0. self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. firstFreeChunk := sortedFreeChunks := lastLargeFree := 0. + "Note that if we were truly striving for performance we could split the scan into + two phases, one up to the first free object and one after, which would remove + the need to test firstFreeChunk when filling highestObjects." self allOldSpaceEntitiesForCoalescingDo: [:o| (self isMarked: o) + ifTrue: "forwarders should have been followed in markAndTrace:" + [self assert: (self isForwarded: o) not. + self setIsMarkedOf: o to: false. - ifTrue: - [self setIsMarkedOf: o to: false. ((self isWeakNonImm: o) + and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: - and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: [coInterpreter signalFinalization: o]. (self isPinned: o) ifTrue: [segmentManager notePinned: o]. + firstFreeChunk ~= 0 ifTrue: + [false "conceptually...: " + ifTrue: [highestObjects addLast: o] + ifFalse: "but we inline so we can use the local lastHighest" + [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue: + [highestObjectsWraps := highestObjectsWraps + 1]. + self longAt: lastHighest put: o]]] - lastLargeFree ~= 0 ifTrue: - [self longAt: highestObjects top put: o. - (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue: - [highestObjects top: highestObjects start. - highestObjectsWraps := highestObjectsWraps + 1]]] ifFalse: "unmarked; two cases, an unreachable object or a free chunk." [| here next | self assert: (self isRemembered: o) not. "scavenger should have cleared this above" here := o. next := self objectAfter: here limit: endOfMemory. (self isMarked: next) ifFalse: "coalescing; rare case" [self assert: (self isRemembered: o) not. [statCoalesces := statCoalesces + 1. here := self coalesce: here and: next. next := self objectAfter: here limit: endOfMemory. next = endOfMemory or: [self isMarked: next]] whileFalse]. firstFreeChunk = 0 ifTrue: [firstFreeChunk := here]. (self isLargeFreeObject: here) ifTrue: [lastLargeFree = 0 ifTrue: [sortedFreeChunks := here] ifFalse: [self setFree: here. self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. lastLargeFree := here] ifFalse: [self freeSmallObject: here]]]. + highestObjects last: lastHighest. + highestObjectsWraps ~= 0 ifTrue: + [highestObjects first: (lastHighest + self wordSize >= highestObjects limit + ifTrue: [highestObjects start] + ifFalse: [lastHighest + self wordSize])]. lastLargeFree ~= 0 ifTrue: [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. totalFreeOldSpace := self reverseSmallListHeads. totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks). self checkFreeSpace. self touch: highestObjectsWraps! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect self runLeakCheckerForFullGC: true. self markObjects. - self runLeakCheckerForFullGC: true. self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace. - self runLeakCheckerForFullGC: true. self bestFitCompact. + self eliminateAndFreeForwarders. self runLeakCheckerForFullGC: true! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. remapBufferCount := extraRootCount := 0. "see below" freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := marking := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0. statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0. statCoalesces := 0. "We can initialize things that are allocated but are lazily initialized." unscannedEphemerons := SpurContiguousObjStack new. + highestObjects := SpurCircularBuffer new manager: self; yourself. - highestObjects := SpurContiguousObjStack new. "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. "N.B. We *don't* initialize extraRoots because we don't simulate it."! Item was added: + ----- Method: SpurMemoryManager>>moveFailuresInHighestObjectsBack: (in category 'compaction') ----- + moveFailuresInHighestObjectsBack: savedLimit + "After refilling highestObjects move any failures back to being + adjacent with the new objects, reset the space's limit and + answer the pointer to the lowest failure to resume the scan." + + | newFailuresPosition | + savedLimit = highestObjects limit ifTrue: + [^highestObjects last]. + "simple; we didnt fill all the way; just move failures down." + (highestObjects first = highestObjects start + and: [highestObjects last < highestObjects limit]) ifTrue: + [newFailuresPosition := highestObjects limit. + self mem: newFailuresPosition + mo: highestObjects last + self wordSize + ve: savedLimit - newFailuresPosition. + highestObjects limit: savedLimit. + ^newFailuresPosition]. + "tricky to do unless we have last - start's worth of free space. + we *don't* want to rotate lots and lots of objects. We could push + failures onto the mark stack, if it is big enough. + limit: | failures hi <-> lo | lowest candidates | highest candidates | : start + ^ last" + self shouldBeImplemented. + ^newFailuresPosition! Item was added: + ----- Method: SpurMemoryManager>>moveFailuresToTopOfHighestObjects: (in category 'compaction') ----- + moveFailuresToTopOfHighestObjects: failures + "After a cycle of exact-fit compaction highestObjects may contain some + number of mobile objects that fail to fit, and more objects may exist to + move. Move existing failures to top of highestObjects and temporarily + shrink highestObjects to refill it without overwriting failues. Answer the + old limit. moveFailuresInHighestObjectsBack: will undo the change." + + | oldLimit bytesToMove | + oldLimit := highestObjects limit. + failures = (highestObjects last + self wordSize) ifTrue: + [highestObjects resetAsEmpty. + ^oldLimit]. + failures <= highestObjects last ifTrue: + [bytesToMove := highestObjects last + self wordSize - failures. + self mem: highestObjects limit - bytesToMove + mo: failures + ve: bytesToMove. + highestObjects limit: failures - self wordSize. + ^oldLimit]. + "failures wrapped; move in two stages to preserve ordering" + bytesToMove := highestObjects last - highestObjects start. + self mem: failures - bytesToMove + mo: failures + ve: oldLimit - failures. + highestObjects limit: failures - bytesToMove. + self mem: oldLimit - bytesToMove + mo: highestObjects start + ve: bytesToMove. + ^oldLimit! Item was changed: ----- Method: SpurNewSpaceSpace class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock self allInstVarNames do: + [:ivn| + (SpurMemoryManager isNonArgumentImplicitReceiverVariableName: ivn) ifFalse: + [aBinaryBlock value: ivn value: #usqInt]]! - [:ivn| aBinaryBlock value: ivn value: #usqInt]! Item was changed: ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') ----- addSegmentOfSize: ammount <returnTypeC: #'SpurSegmentInfo *'> + <inline: false> | allocatedSize | <var: #newSeg type: #'SpurSegmentInfo *'> (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" sqAllocateMemorySegmentOfSize: ammount Above: (segments at: 0) segStart + (segments at: 0) segSize AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: [:segAddress| | newSegIndex newSeg | newSegIndex := self insertSegmentFor: segAddress. newSeg := self addressOf: (segments at: newSegIndex). newSeg segStart: segAddress; segSize: allocatedSize. self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg. self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse: [self addressOf: (segments at: newSegIndex + 1)]). "and add the new free chunk to the free list; done here instead of in assimilateNewSegment: for the assert" manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart. self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart)) = (newSeg segStart + newSeg segSize - manager bridgeSize). ^newSeg]. ^nil! Item was changed: ----- Method: StackInterpreter>>doubleExtendedDoAnythingBytecode (in category 'send bytecodes') ----- doubleExtendedDoAnythingBytecode "Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count. Here we use 3 bits for the operation sub-type (opType), and the remaining 5 bits for argument count where needed. The last byte give access to 256 instVars or literals. See also secondExtendedSendBytecode" + | byte2 byte3 opType top lit | - | byte2 byte3 opType top | byte2 := self fetchByte. byte3 := self fetchByte. opType := byte2 >> 5. opType = 0 ifTrue: [messageSelector := self literal: byte3. argumentCount := byte2 bitAnd: 31. ^self normalSend]. opType = 1 ifTrue: [messageSelector := self literal: byte3. argumentCount := byte2 bitAnd: 31. ^self superclassSend]. self fetchNextBytecode. opType = 2 ifTrue: [^self pushMaybeContextReceiverVariable: byte3]. opType = 3 ifTrue: [^self pushLiteralConstant: byte3]. opType = 4 ifTrue: [^self pushLiteralVariable: byte3]. top := self internalStackTop. opType = 7 ifTrue: + [lit := self literal: byte3. + ^objectMemory storePointer: ValueIndex ofObject: lit withValue: top]. - [^objectMemory storePointer: ValueIndex ofObject: (self literal: byte3) withValue: top]. "opType = 5 is store; opType = 6 = storePop" opType = 6 ifTrue: [self internalPop: 1]. ^self storeMaybeContextReceiverVariable: byte3 withValue: top! Item was changed: ----- Method: StackInterpreter>>sendBreakpoint:receiver: (in category 'debug support') ----- + sendBreakpoint: selector receiver: rcvr - sendBreakpoint: selector receiver: receiver <inline: true> self sendBreak: (objectMemory firstFixedFieldOfMaybeImmediate: selector) point: (objectMemory lengthOfMaybeImmediate: selector) + receiver: rcvr! - receiver: receiver! Item was removed: - ----- Method: TAssignmentNode>>structTargetKind: (in category 'testing') ----- - structTargetKind: aCodeGen - "Answer if the recever evaluates to a struct or struct pointer - and hence can be dereferenced using . or ->. Answer any of - #struct #pointer or nil" - ^variable structTargetKind: aCodeGen! Item was added: + ----- Method: TAssignmentNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^variable structTargetKindIn: aCodeGen! Item was added: + ----- Method: TMethod>>argAssignmentsFor:send:in: (in category 'inlining') ----- + argAssignmentsFor: meth send: aSendNode in: aCodeGen + "Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method." + "Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals." + + | stmtList substitutionDict argList | + stmtList := OrderedCollection new: 100. + substitutionDict := Dictionary new: 100. + argList := aSendNode args. + + meth args size > aSendNode args size ifTrue: + [self assert: (meth args first beginsWith: 'self_in_'). + argList := {aSendNode receiver}, aSendNode args]. + meth args with: argList do: + [ :argName :exprNode | + (self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen) + ifTrue: + [substitutionDict at: argName put: exprNode. + locals remove: argName] + ifFalse: + [stmtList add: (TAssignmentNode new + setVariable: (TVariableNode new setName: argName) + expression: exprNode copy)]]. + meth parseTree: (meth parseTree bindVariablesIn: substitutionDict). + ^stmtList! Item was changed: ----- Method: TMethod>>computePossibleSideEffectsInto:visited:in: (in category 'inlining support') ----- computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen "Add all variables written to by this method and its callees to writtenToVars. Avoid circularity via visitedSelectors" (visitedSelectors includes: selector) ifTrue: [^self]. visitedSelectors add: selector. writtenToGlobalVarsCache ifNotNil: [writtenToVars addAll: writtenToGlobalVarsCache. ^self]. parseTree nodesDo: [ :node | (node isAssignment and: [(locals includes: node variable name) not]) ifTrue: [writtenToVars add: node variable name]. (node isSend and: [node isBuiltinOperator not + and: [(node isStructSendIn: aCodeGen) not]]) ifTrue: - and: [(node isStructSend: aCodeGen) not]]) ifTrue: [(aCodeGen methodNamed: node selector) ifNotNil: [:method| method computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen]]]. writtenToGlobalVarsCache := writtenToVars copy! Item was changed: ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') ----- inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen "Answer a collection of statements to replace the given send. directReturn indicates that the send is the expression in a return statement, so returns can be left in the body of the inlined method. If exitVar is nil, the value returned by the send is not used; thus, returns need not assign to the output variable. Types are propagated to as-yet-untyped variables when inlining a send that is assigned, otherwise the assignee variable type must match the return type of the inlinee. Return types are not propagated." + | sel meth methArgs exitLabel inlineStmts label exitType | - | sel meth exitLabel inlineStmts label exitType | sel := aSendNode selector. meth := aCodeGen methodNamed: sel. + methArgs := meth args. "convenient for debugging..." self maybeBreakFor: aSendNode in: aCodeGen. + (methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue: + [methArgs := methArgs allButFirst]. + methArgs size = aSendNode args size ifFalse: - meth args size = aSendNode args size ifFalse: [^nil]. + methArgs with: aSendNode args do: - meth args with: aSendNode args do: [:formal :actual| (actual isVariable and: [(aCodeGen variableOfType: (self typeFor: formal using: aCodeGen) acceptsValueOfType: (self typeFor: actual name in: aCodeGen)) not]) ifTrue: [aCodeGen logger nextPutAll: 'type mismatch for formal ', formal, ' and actual ', actual name, ' when inlining ', sel, ' in ', selector, '. Use a cast.'; cr; flush]]. meth := meth copy. "Propagate the return type of an inlined method" (directReturn or:[exitVar notNil]) ifTrue:[ exitType := directReturn ifTrue:[returnType] ifFalse:[(self typeFor: exitVar in: aCodeGen) ifNil:[#sqInt]]. (exitType = #void or:[exitType = meth returnType]) ifFalse:[meth propagateReturnIn: aCodeGen]]. meth renameVarsForInliningInto: self except: #() in: aCodeGen. meth renameLabelsForInliningInto: self. self addVarsDeclarationsAndLabelsOf: meth except: #(). meth hasReturn ifTrue:[ directReturn ifFalse:[ exitLabel := self unusedLabelForInliningInto: self. (meth exitVar: exitVar label: exitLabel) "is label used?" ifTrue: [ labels add: exitLabel ] ifFalse: [ exitLabel := nil ]]]. (inlineStmts := OrderedCollection new: 100) add: (label := TLabeledCommentNode new setComment: 'begin ', sel); + addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen); - addAll: (self argAssignmentsFor: meth args: aSendNode args in: aCodeGen); addAll: meth statements. "method body" "Vile hacks to prevent too many labels. If the C compiler inlines functions it can duplicate labels and cause compilation to fail. The second statement prevents us creating labels in anything other than the interpreter. If we add labels to small functions that may be inlined by the C compiler then the label can be duplicated by the C compiler and cause the assembler to fail. eem 9/20/2008 12:29" (aCodeGen wantsLabels and: [meth asmLabel and: [meth mustAsmLabel or: [meth hasMoreSendsThan: 20]]]) ifTrue: [label asmLabel: sel]. (directReturn and: [meth endsWithReturn not]) ifTrue: [inlineStmts add: (TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]. exitLabel ~= nil ifTrue: [inlineStmts add: (TLabeledCommentNode new setLabel: exitLabel comment: 'end ', meth selector)]. ^inlineStmts! Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. As a hack also update the types of variables introduced to implement cascades correctly. This has to be done at the same time as this is done, so why not piggy back here?" extraVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. aCodeGen pushScope: declarations while:"N.B. nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved." [parseTree nodesWithParentsDo: [:node :parent| node isSend ifTrue: [(aCodeGen isBuiltinSelector: node selector) ifTrue: [node isBuiltinOperator: true. "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" (node selector = #to:by:do: and: [node args size = 4]) ifTrue: [| limitExpr | limitExpr := node args first. (limitExpr anySatisfy: [:subNode| subNode isSend and: [(aCodeGen isBuiltinSelector: subNode selector) not + and: [(subNode isStructSendIn: aCodeGen) not]]]) - and: [(subNode isStructSend: aCodeGen) not]]]) ifTrue: [locals add: node args last name] ifFalse: [node arguments: node args allButLast]]] ifFalse: [(CaseStatements includes: node selector) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node})]. (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]]]]]! Item was changed: ----- Method: TMethod>>transformToStructClassMethodFor: (in category 'transformations') ----- transformToStructClassMethodFor: aCCodeGenerator "Transform this method so that it can be used on an instance of a struct class (VMStructType subclass). Convert inst var refs into field dereferences of self. Add selfSelector as the first argument with the right struct type. As a complete hack to avoid breaking the inlinert don't use 'self' as the name for self + as this causes serious type redefinitions ``somewhere'' in the inliner." - as this causes surious type redefinitions ``somewhere'' in the inliner." | replacements selfNode typeForSelf | self isStructAccessor ifTrue: [^returnType := definingClass returnTypeForAccessor: selector]. replacements := IdentityDictionary new. selfNode := TVariableNode new setName: 'self_in_', (aCCodeGenerator cFunctionNameFor: selector). args do: [:var| (definingClass isAccessor: var) ifTrue: [self error: 'In ', definingClass name, '>>', selector, ' ', var, ' arg shadows struct field and will break during translation!!']]. parseTree nodesDo: [:node| node isVariable ifTrue: [node name = 'self' ifTrue: [replacements at: node put: selfNode copy]. (definingClass isAccessor: node name) ifTrue: [replacements at: node put: (TSendNode new setSelector: node name asSymbol receiver: selfNode arguments: #())]]]. replacements notEmpty ifTrue: [parseTree := parseTree replaceNodesIn: replacements]. typeForSelf := self typeForSelf. self assert: (typeForSelf notNil and: [typeForSelf ~~ #implicit]). self declarationAt: (args addFirst: selfNode name) put: (declarations removeKey: 'self'), '_in_', (aCCodeGenerator cFunctionNameFor: selector)! Item was removed: - ----- Method: TParseNode>>structTargetKind: (in category 'testing') ----- - structTargetKind: aCodeGen - "Answer if the recever evaluates to a struct or struct pointer - and hence can be dereferenced using . or ->. Answer any of - #struct #pointer or nil" - ^nil! Item was added: + ----- Method: TParseNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^nil! Item was changed: ----- Method: TSendNode>>emitCCodeAsFieldReferenceOn:level:generator: (in category 'C code generation') ----- emitCCodeAsFieldReferenceOn: aStream level: level generator: aCodeGen "If appropriate, translate this message send as a pointer dereference" | parenCount | + (self isStructSendIn: aCodeGen) ifFalse: - (self isStructSend: aCodeGen) ifFalse: [^false]. parenCount := receiver isSend ifTrue: [2] ifFalse: [1]. aStream next: parenCount put: $(. receiver emitCCodeAsExpressionOn: aStream level: 0 generator: aCodeGen. parenCount > 1 ifTrue: [aStream nextPut: $)]. + (receiver structTargetKindIn: aCodeGen) caseOf: { - (receiver structTargetKind: aCodeGen) caseOf: { [#pointer] -> [aStream nextPut: $-; nextPut: $>]. [#struct] -> [aStream nextPut: $.] }. aStream nextPutAll: (aCodeGen cFunctionNameFor: selector). arguments isEmpty ifFalse: [self assert: arguments size = 1. aStream nextPutAll: ' = '. arguments first emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen]. aStream nextPut: $). ^true! Item was changed: ----- Method: TSendNode>>emitCCodeAsFunctionCallOn:level:generator: (in category 'C code generation') ----- emitCCodeAsFunctionCallOn: aStream level: level generator: aCodeGen "Translate this message send into a C function call" "Special case for pluggable modules. Replace messages to interpreterProxy by interpreterProxy->message(..) if the message is not builtin" (aCodeGen messageReceiverIsInterpreterProxy: self) ifTrue: [(aCodeGen noteUsedPluginFunction: selector) ifTrue: [aStream nextPutAll: 'interpreterProxy->']]. + "Translate this message send into a C function call." aStream nextPutAll: (aCodeGen cFunctionNameFor: selector); nextPut: $(. "Only include the receiver as the first argument in certain cases. The receiver is always included if it is an expression. If it is a variable: If the vmClass says it is an implicit variable, don't include it. If the variable is 'self' and the method being called is not in the method set (i.e. it is some external code), don't include it." (self shouldExcludeReceiverAsFirstArgument: aCodeGen) ifFalse: + [(receiver structTargetKindIn: aCodeGen) == #struct ifTrue: + [aStream nextPut: $&]. + receiver emitCCodeOn: aStream level: level generator: aCodeGen. - [receiver emitCCodeOn: aStream level: level generator: aCodeGen. arguments isEmpty ifFalse: [aStream nextPutAll: ', ']]. arguments do: [ :arg| arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen] separatedBy: [aStream nextPut: $,; space]. aStream nextPut: $)! Item was removed: - ----- Method: TSendNode>>isSelfReference: (in category 'C code generation') ----- - isSelfReference: varNode - ^(varNode name beginsWith: 'self') - and: [varNode name = 'self' or: [varNode name beginsWith: 'self_in_']]! Item was added: + ----- Method: TSendNode>>isSelfReference:in: (in category 'C code generation') ----- + isSelfReference: varNode in: aCodeGen + ^(varNode name beginsWith: 'self') + and: [varNode name = 'self' or: [varNode name beginsWith: 'self_in_']]! Item was added: + ----- Method: TSendNode>>isStructReference:in: (in category 'C code generation') ----- + isStructReference: varNode in: aCodeGen + ^(varNode structTargetKindIn: aCodeGen) notNil! Item was removed: - ----- Method: TSendNode>>isStructSend: (in category 'testing') ----- - isStructSend: aCodeGen - "Answer if the recever is a send of a structure accessor. - This is tricky. We want - foo bar => foo->bar - foo bar => foo.bar - foo bar: expr => foo->bar = expr - foo bar: expr => foo.bar = expr - depending on whether foo is a struct or a pointer to a struct, - but only if both foo is a struct type and bar is a field accessor. - The tricky cases are self-sends within struct class methods. Here we need to - distinguish between self-sends of ordinary methods from self sends of accessors." - ^arguments size <= 1 - and: [(receiver structTargetKind: aCodeGen) notNil - and: [(aCodeGen methodNamed: selector) - ifNil: [false] - ifNotNil: [:method| method isStructAccessor]]]! Item was added: + ----- Method: TSendNode>>isStructSendIn: (in category 'testing') ----- + isStructSendIn: aCodeGen + "Answer if the recever is a send of a structure accessor. + This is tricky. We want + foo bar => foo->bar + foo bar => foo.bar + foo bar: expr => foo->bar = expr + foo bar: expr => foo.bar = expr + depending on whether foo is a struct or a pointer to a struct, + but only if both foo is a struct type and bar is a field accessor. + The tricky cases are self-sends within struct class methods. Here we need to + distinguish between self-sends of ordinary methods from self sends of accessors." + ^arguments size <= 1 + and: [(receiver structTargetKindIn: aCodeGen) notNil + and: [(aCodeGen methodNamed: selector) + ifNil: [false] + ifNotNil: [:method| method isStructAccessor]]]! Item was changed: ----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') ----- shouldExcludeReceiverAsFirstArgument: aCodeGen "Only include the receiver as the first argument in certain cases. The receiver is always included if it is an expression. If it is a variable: If the vmClass says it is an implicit variable, don't include it. If the method's definingClass says it is an implicit variable, don't include it. If the variable is 'self' and the method being called is not in the method set (i.e. it is some external code), don't include it. If it is a struct send of something the vm says is an implicit variable, don't include it." | m | (receiver isSend and: [receiver receiver isVariable + and: [(self isSelfReference: receiver receiver in: aCodeGen) + or: [self isStructReference: receiver receiver in: aCodeGen]]]) ifTrue: - and: [self isSelfReference: receiver receiver]]) ifTrue: [^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector]. ^receiver isVariable and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name) + or: [(self isSelfReference: receiver in: aCodeGen) - or: [(self isSelfReference: receiver) and: [(m := aCodeGen methodNamed: selector) isNil or: [m typeForSelf == #implicit]]]]! Item was removed: - ----- Method: TSendNode>>structTargetKind: (in category 'testing') ----- - structTargetKind: aCodeGen - "Answer if the recever evaluates to a struct or struct pointer - and hence can be dereferenced using . or ->. Answer any of - #struct #pointer or nil. Right now we don't need or support - structure return so this method answers either #pointer or nil." - selector == #cCoerceSimple:to: ifTrue: - [^(VMStructType isTypePointerToStruct: arguments last value) ifTrue: - [#pointer]]. - - selector == #addressOf: ifTrue: - [^#pointer]. - - selector == #at: ifTrue: - [receiver isVariable ifTrue: - [(aCodeGen typeOfVariable: receiver name) ifNotNil: - [:type| | derefType | - type last = $* ifFalse: - [^receiver structTargetKind: aCodeGen]. - (VMStructType isTypeStruct: (aCodeGen - extractTypeFor: receiver name - fromDeclaration: type allButLast)) ifTrue: - [^#struct]]]. - (receiver structTargetKind: aCodeGen) ifNotNil: - [:kind| ^kind]]. - - (aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: - [^#pointer]. - - (aCodeGen selectorReturnsStruct: selector) ifTrue: - [^#struct]. - - ^nil! Item was added: + ----- Method: TSendNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil. Right now we don't need or support + structure return so this method answers either #pointer or nil." + selector == #cCoerceSimple:to: ifTrue: + [^(VMStructType isTypePointerToStruct: arguments last value) ifTrue: + [#pointer]]. + + selector == #addressOf: ifTrue: + [^#pointer]. + + selector == #at: ifTrue: + [receiver isVariable ifTrue: + [(aCodeGen typeOfVariable: receiver name) ifNotNil: + [:type| | derefType | + type last = $* ifFalse: + [^receiver structTargetKindIn: aCodeGen]. + (VMStructType isTypeStruct: (aCodeGen + extractTypeFor: receiver name + fromDeclaration: type allButLast)) ifTrue: + [^#struct]]]. + (receiver structTargetKindIn: aCodeGen) ifNotNil: + [:kind| ^kind]]. + + (aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: + [^#pointer]. + + (aCodeGen selectorReturnsStruct: selector) ifTrue: + [^#struct]. + + ^nil! Item was removed: - ----- Method: TVariableNode>>structTargetKind: (in category 'testing') ----- - structTargetKind: aCodeGen - "Answer if the recever evaluates to a struct or struct pointer - and hence can be dereferenced using . or ->. Answer any of - #struct #pointer or nil" - ^aCodeGen structTargetKindForVariableName: name! Item was added: + ----- Method: TVariableNode>>structTargetKindIn: (in category 'testing') ----- + structTargetKindIn: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^aCodeGen structTargetKindForVariableName: name!

1 0

Re: [Pharo-dev] Pharo on Mac OS X 10.9 Mavericks
by Eliot Miranda 23 Oct '13

23 Oct '13

Hi Sven, On Wed, Oct 23, 2013 at 5:52 AM, Sven Van Caekenberghe <sven(a)stfx.eu> wrote: > > On 23 Oct 2013, at 14:22, Igor Stasenko <siguctua(a)gmail.com> wrote: > > > Yeah, i was also exploring, why even if i do not touch image i got like > 3-5% CPU load. > > What i found that it is in VM. Because i basicaly removed everything in > image, > > and just left idle process, and still had such loads. > > Igor, some time ago you told me which thread inside the VM was doing this, > but maybe you forgot ;-) > two different things. One is the idle process, in the image. This is heavy-weight. It calls relinquishProcessorForMicroseconds: which does all sorts of things, including system calls to poll for i/o. The other is the poll thread in the Cog and Stack VMs. This simply sleeps for a millisecond, wakes up and sets a variable, and then goes back to sleep. It is relatively lightweight. I suspect the 3-5% is due to the former, not the latter. One way to test would be to compare the interpreter VM against the Stack and Cog VMs and see how much time the interpreter VM takes. If the interpreter VM also takes a lot of time at idle, then the poll thread is not the culprit. > > On 23 October 2013 13:52, Sven Van Caekenberghe <sven(a)stfx.eu> wrote: > > Hi, > > > > This morning I upgraded my MacBook Air to Mac OS X 10.9 Mavericks. The > good new is that my trusty VM [1] is still working OK ! > > > > However, something seems to have changed regarding full screen mode: it > more or less works but there are two black bands and the window title > remains visible, it is as if it did not expand enough: > > > > <Screen Shot 2013-10-23 at 13.40.56.png> > > > > Which is a pity: I rely on this a lot to get more screen space on my 13 > inch screen and to work distraction free. > > > > I guess we’ll have to wait for our hero Esteban to have a look. > > > > Also new is the focus on energy management and efficiency. Sadly Pharo > is flagged as using to much (look at the menu under the battery icon top > right and the energy tab in the activity monitor): > > > > <Screen Shot 2013-10-23 at 13.49.53.png> > > > > This is probably related to the busy thread running/polling every ms or > so inside the VM. > > > > I could turn these into issues. > > > > Sven > > > > [1] > > > > Virtual Machine > > --------------- > > /Users/sven/Develop/Smalltalk/Pharo.app/Contents/MacOS/Pharo > > NBCoInterpreter NativeBoost-CogPlugin-EstebanLorenzano.18 uuid: > a53445f9-c0c0-4015-97a3-be7db8d9ed6b Mar 13 2013 > > NBCogit NativeBoost-CogPlugin-EstebanLorenzano.18 uuid: > a53445f9-c0c0-4015-97a3-be7db8d9ed6b Mar 13 2013 > > git://gitorious.org/cogvm/blessed.git Commit: > 412abef33cbed05cf1d75329e451d71c0c6aa5a7 Date: 2013-03-13 17:48:50 +0100 > By: Esteban Lorenzano <estebanlm(a)gmail.com> Jenkins build #14535 > > > > Mac Cocoa Cog 5.8b12 21-Sep-10 >1B0534FA-246C-47C5-AB29-7A76C81CCDCB< > > VMMaker versionString git://gitorious.org/cogvm/blessed.git Commit: > 412abef33cbed05cf1d75329e451d71c0c6aa5a7 Date: 2013-03-13 17:48:50 +0100 > By: Esteban Lorenzano <estebanlm(a)gmail.com> Jenkins build #14535 > > NBCoInterpreter NativeBoost-CogPlugin-EstebanLorenzano.18 uuid: > a53445f9-c0c0-4015-97a3-be7db8d9ed6b Mar 13 2013 > > NBCogit NativeBoost-CogPlugin-EstebanLorenzano.18 uuid: > a53445f9-c0c0-4015-97a3-be7db8d9ed6b Mar 13 2013 > > > > > > > > > > > > -- > > Best regards, > > Igor Stasenko. > > > -- best, Eliot

1 0

Memory leak in the SqueakSSL plugin on unix
by Levente Uzonyi 23 Oct '13

23 Oct '13

Hello, we've been experiencing memory leakage in long running Squeak images using SqueakSSL. After a bit of monitoring I found that 132 bytes get leaked for each https request done from the image. After a bit of code review, I've probably found the culprit, and another potential source of memory leak. For the reference, the source file this mail is about is http://squeakvm.org/cgi-bin/viewvc.cgi/squeak/branches/Cog/platforms/unix/p…

2 8

VM Maker: VMMaker.oscog-eem.474.mcz
by commits＠source.squeak.org 23 Oct '13

23 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.474.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.474 Author: eem Time: 22 October 2013, 4:11:59.709 pm UUID: 64efc673-34ea-49e3-b97a-9bab48706160 Ancestors: VMMaker.oscog-eem.473 Transform e ifNotNil: [:v|...] into v := e. v ifNotNil: [...] in TMethod creation so as to enable the allocateOldSpaceChunkOfExactlyBytes:suchThat: send in exactFitCompact to be inlined. Add an <inline: true> pragma to said method to force it to be inlined. Add generateValueAsArgument:on:indent: to allow the acceptanceBlock to be correctly expanded in the ifs in said method. Fix swizzleObjStackAt: to answer the obj stack swizzled. Fix TStmtList printing with arguments are nil. =============== Diff against VMMaker.oscog-eem.473 =============== Item was changed: ----- Method: BlockNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" | statementList | statementList := OrderedCollection new. + statements do: + [:s | | newS | + newS := s asTranslatorNodeIn: aTMethod. + "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed" + newS isStmtList + ifTrue: [statementList addAll: newS statements] + ifFalse: [statementList add: newS]]. + ^TStmtListNode new + setArguments: (arguments asArray collect: [:arg | arg key]) - statements - do: [:s | | newS | - newS := s asTranslatorNodeIn: aTMethod. - newS isStmtList - ifTrue: ["inline the statement list returned when a CascadeNode is - translated " - statementList addAll: newS statements] - ifFalse: [statementList add: newS]]. - ^ TStmtListNode new - setArguments: (arguments asArray - collect: [:arg | arg key]) statements: statementList; + comment: comment! - comment: comment! Item was added: + ----- Method: CCodeGenerator>>generateValueAsArgument:on:indent: (in category 'C translation') ----- + generateValueAsArgument: aTSendNode on: aStream indent: level + "Reduce [:formal ... :formalN| body ] value: actual ... value: actualN + to body with formals substituted for by actuals." + | substitution substitutionDict newLabels | + self assert: aTSendNode receiver isStmtList. + self assert: aTSendNode receiver args size = aTSendNode args size. + substitution := aTSendNode receiver copy. + substitution renameLabelsForInliningInto: currentMethod. + substitutionDict := Dictionary new: aTSendNode args size * 2. + aTSendNode receiver args with: aTSendNode args do: + [ :argName :exprNode | + substitutionDict at: argName put: exprNode]. + substitution + bindVariablesIn: substitutionDict; + emitCCodeAsArgumentOn: aStream level: level generator: self. + newLabels := Set withAll: currentMethod labels. + substitution nodesDo: + [:node| node isLabel ifTrue: [node label ifNotNil: [:label| newLabels add: label]]]. + "now add the new labels so that a subsequent inline of + the same block will be renamed with different labels." + currentMethod labels: newLabels! Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation." | pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent: #+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent: #bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert32 #generateBitInvert32:on:indent: #bitClear: #generateBitClear:on:indent: #truncateTo: #generateTruncateTo:on:indent: #rounded #generateRounded:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent: #whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent: #ifNotNil: #generateIfNotNil:on:indent: #ifNil: #generateIfNil:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent: #at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent: #integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: #asLong #generateAsLong:on:indent: #asUnsignedLong #generateAsUnsignedLong:on:indent: #asSymbol #generateAsSymbol:on:indent: #flag: #generateFlag:on:indent: #anyMask: #generateBitAnd:on:indent: #noMask: #generateNoMask:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #wordSize #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent: #value #generateValue:on:indent: #value: #generateValue:on:indent: #value:value: #generateValue:on:indent: #shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: #subclassResponsibility #generateSmalltalkMetaError:on:indent: ). 1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)]. pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #ifNotNil: #generateIfNotNilAsArgument:on:indent: #ifNil: #generateIfNilAsArgument:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent: #cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent: + + #value #generateValueAsArgument:on:indent: + #value: #generateValueAsArgument:on:indent: + #value:value: #generateValueAsArgument:on:indent: ). asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. ! Item was changed: ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used." + | rcvrOrNil sel args ifNotNilBlock | - | rcvrOrNil sel args | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. + ((sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." + or: [sel == #cCode:]) - ((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." - or: [sel = #cCode:]) and: [arguments first isBlockNode]) ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. args := (1 to: sel numArgs) collect: + [:i | (arguments at: i) asTranslatorNodeIn: aTMethod]. - [:i | (arguments at: i) asTranslatorNodeIn: aTMethod]. (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: ["Restore limit expr that got moved by transformToDo:" args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. args second. args third. "add the limit var as a hidden extra argument; we may need it later" TVariableNode new setName: arguments first key}]. (sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue: [sel := #ifFalse:. args := {args last}]. (sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. (sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args last}]. (sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. + ((sel == #ifFalse: or: [sel == #or:]) - ((sel = #ifFalse: or: [sel = #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. + "For the benefit of later passes, e.g. value: inlining, + transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...], + which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]." + ((sel == #ifTrue: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]) + and: [receiver notNil + and: [receiver isAssignmentEqualsEqualsNil + and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue: + [ifNotNilBlock setArguments: #(). + ^TStmtListNode new + setArguments: #() + statements: + { receiver receiver asTranslatorNodeIn: aTMethod. + TSendNode new + setSelector: sel + receiver: (TSendNode new + setSelector: #== + receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod) + arguments: {receiver arguments first asTranslatorNodeIn: aTMethod}) + arguments: args }]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was added: + ----- Method: MessageNode>>isAssignmentEqualsEqualsNil (in category '*VMMaker-C translation') ----- + isAssignmentEqualsEqualsNil + "Answer if the receiver if of the form (v := e) == nil, which underlies e ifNotNil: [:v|...]" + ^#== == (selector isSymbol ifTrue: [selector] ifFalse: [selector key]) + and: [receiver notNil + and: [receiver isAssignmentNode + and: [(arguments first isJust: NodeNil) + or: [arguments first isVariableNode + and: [arguments first key = 'nil']]]]]! Item was added: + ----- Method: ParseNode>>isAssignmentEqualsEqualsNil (in category '*VMMaker-C translation') ----- + isAssignmentEqualsEqualsNil + ^false! Item was changed: ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks) in: aCCodeGenerator. self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']) in: aCCodeGenerator. aCCodeGenerator var: #freeLists type: #'sqInt *'; var: #classTableBitmap type: #'unsigned char *'; + var: #highestObjects type: #SpurContiguousObjStack; var: #unscannedEphemerons type: #SpurContiguousObjStack. aCCodeGenerator var: #remapBuffer declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'. aCCodeGenerator var: #extraRoots declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') ----- allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock "Answer a chunk of oldSpace from the free lists, if one of this size is available, otherwise answer nil. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | initialIndex node nodeBytes child | + <inline: true> "must inline for acceptanceBlock" "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" initialIndex := chunkBytes / self allocationUnit. initialIndex < self numFreeLists ifTrue: [(1 << initialIndex <= freeListsMask and: [(node := freeLists at: initialIndex) ~= 0 and: [acceptanceBlock value: node]]) ifTrue: [self assert: node = (self startOfObject: node). self assert: (self isValidFreeObject: node). totalFreeOldSpace := totalFreeOldSpace - chunkBytes. ^self unlinkFreeChunk: node atIndex: initialIndex]. ^nil]. "Large chunk. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the first chunk of the same size as chunkBytes, or 0 if none." node := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [| childBytes | self assert: (self isValidFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. (node ~= 0 and: [acceptanceBlock value: node]) ifTrue: [self assert: (self isValidFreeObject: node). self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node). totalFreeOldSpace := totalFreeOldSpace - chunkBytes. ^self startOfObject: node]. node := child. nodeBytes := childBytes. child := 0] "break out of loop to remove interior node" ifFalse: [childBytes < chunkBytes ifTrue: "walk down the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [nodeBytes := childBytes. child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]. "if no chunk, there was no exact fit" (node ~= 0 and: [acceptanceBlock value: node]) ifFalse: [^nil]. "self printFreeChunk: parent" self assert: nodeBytes = chunkBytes. self assert: (self bytesInObject: node) = chunkBytes. "can't be a list; would have removed and returned it above." self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0. "no list; remove the interior node" "N.B. This will fail when we try to remove the head node and there are still next links, which is possible given acceptanceBlock but does not occur in current use." self unlinkSolitaryFreeTreeNode: node. totalFreeOldSpace := totalFreeOldSpace - chunkBytes. ^self startOfObject: node! Item was changed: ----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') ----- swizzleObjStackAt: objStackRootIndex - <returnTypeC: #void> "On load, swizzle the pointers in an obj stack. Answer the obj stack's oop." | firstPage stackOrNil index field | firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj. stackOrNil = nilObj ifTrue: [^stackOrNil]. [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots. self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex. "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4. Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx" index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx. "swizzle fields including ObjStackNextx and leave field containing the next link." [field := self fetchPointer: index ofObject: stackOrNil. (self isImmediate: field) ifFalse: [field := segmentManager swizzleObj: field. self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field]. (index := index - 1) > ObjStackTopx] whileTrue. (stackOrNil := field) ~= 0] whileTrue. [stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage. stackOrNil ~= 0] whileTrue: [field := segmentManager swizzleObj: stackOrNil. self storePointer: ObjStackFreex ofObjStack: firstPage withValue: field. firstPage := stackOrNil]. + self assert: (self isValidObjStackAt: objStackRootIndex). + ^self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj! - self assert: (self isValidObjStackAt: objStackRootIndex) - ! Item was changed: ----- Method: SpurNewSpaceSpace class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock + self allInstVarNames do: - self instVarNames do: [:ivn| aBinaryBlock value: ivn value: #usqInt]! Item was changed: ----- Method: TStmtListNode>>printOn:level: (in category 'printing') ----- printOn: aStream level: level aStream nextPut: $[. + (arguments notNil and: [arguments notEmpty]) ifTrue: + [arguments do: [ :arg | aStream nextPutAll: ' :'; nextPutAll: arg]. + aStream nextPutAll: ' | ']. - arguments size > 0 ifTrue: [ - arguments do: [ :arg | aStream nextPutAll: ' :', arg ]. - aStream nextPutAll: ' | '. - ]. self printStatementsOn: aStream level: level. + aStream nextPut: $]! - aStream nextPut: $].!

1 0

VM Maker: VMMaker.oscog-eem.473.mcz
by commits＠source.squeak.org 22 Oct '13

22 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.473.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.473 Author: eem Time: 22 October 2013, 10:59:55.285 am UUID: 309f7322-d09f-4c20-b826-b5b4c4a48529 Ancestors: VMMaker.oscog-eem.472 Make sortedFreeChunks a temp of fUONUWSASACFS. Hence rebuildFreeTreeFromSortedFreeChunks => rebuildFreeTreeFrom:. Fix basic operations and asserts and for obj stacks (tested by making obj stacks small). Fix addFreeSubTree: to update parent link. Provide allocateOldSpaceChunkOfExactlyBytes:suchThat: for exactFitCompact. Implement exactFitCOmpact in terms of highestObjects. Fix checkHeapIntegrity to cope with obj stacks. Shrink inFreeTreeReplace:with: to do more in its loop. Remove some obsolete compaction code. PRovide VMClass>>str:cat: =============== Diff against VMMaker.oscog-eem.472 =============== Item was changed: ----- Method: Spur32BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') ----- setIsMarkedOf: objOop to: aBoolean + self assert: (self isFreeObject: objOop) not. self flag: #endianness. self longAt: objOop + 4 put: (aBoolean ifTrue: [(self longAt: objOop + 4) bitOr: 1 << self markedBitHalfShift] ifFalse: [(self longAt: objOop + 4) bitAnd: (1 << self markedBitHalfShift) bitInvert32])! Item was changed: ----- Method: Spur64BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') ----- setIsMarkedOf: objOop to: aBoolean + self assert: (self isFreeObject: objOop) not. self longAt: objOop put: (aBoolean ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitFullShift] ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitFullShift) bitInvert64])! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') ----- addFreeSubTree: freeTree "Add a freeChunk sub tree back into the large free chunk tree. This is for allocateOldSpaceChunkOf[Exactly]Bytes:." <returnTypeC: #void> | slotsInArg treeNode slotsInNode subNode | slotsInArg := self numSlotsOfAny: freeTree. self assert: slotsInArg / (self allocationUnit / self wordSize) >= self numFreeLists. treeNode := freeLists at: 0. self assert: treeNode ~= 0. [slotsInNode := self numSlotsOfAny: treeNode. self assert: slotsInArg ~= slotsInNode. slotsInNode > slotsInArg ifTrue: [subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode. subNode = 0 ifTrue: [self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree. + self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode. ^self]] ifFalse: [subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode. subNode = 0 ifTrue: [self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree. + self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode. ^self]]. treeNode := subNode] repeat! Item was added: + ----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:do: (in category 'object enumeration') ----- + allOldSpaceEntitiesFrom: initialObject do: aBlock + <inline: true> + | prevObj prevPrevObj objOop | + prevPrevObj := prevObj := nil. + objOop := initialObject. + [self assert: objOop \\ self allocationUnit = 0. + objOop < freeOldSpaceStart] whileTrue: + [aBlock value: objOop. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop limit: freeOldSpaceStart]. + self touch: prevPrevObj. + self touch: prevObj! Item was added: + ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') ----- + allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock + "Answer a chunk of oldSpace from the free lists, if one of this size + is available, otherwise answer nil. N.B. the chunk is simply a pointer, + it has no valid header. The caller *must* fill in the header correctly." + | initialIndex node nodeBytes child | + "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" + + initialIndex := chunkBytes / self allocationUnit. + initialIndex < self numFreeLists ifTrue: + [(1 << initialIndex <= freeListsMask + and: [(node := freeLists at: initialIndex) ~= 0 + and: [acceptanceBlock value: node]]) ifTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^self unlinkFreeChunk: node atIndex: initialIndex]. + ^nil]. + + "Large chunk. Search the large chunk list. + Large chunk list organized as a tree, each node of which is a list of + chunks of the same size. Beneath the node are smaller and larger + blocks. When the search ends parent should hold the first chunk of + the same size as chunkBytes, or 0 if none." + node := 0. + child := freeLists at: 0. + [child ~= 0] whileTrue: + [| childBytes | + self assert: (self isValidFreeObject: child). + childBytes := self bytesInObject: child. + childBytes = chunkBytes + ifTrue: "size match; try to remove from list at node." + [node := self fetchPointer: self freeChunkNextIndex + ofFreeChunk: child. + (node ~= 0 and: [acceptanceBlock value: node]) ifTrue: + [self assert: (self isValidFreeObject: node). + self storePointer: self freeChunkNextIndex + ofFreeChunk: child + withValue: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: node). + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^self startOfObject: node]. + node := child. + nodeBytes := childBytes. + child := 0] "break out of loop to remove interior node" + ifFalse: + [childBytes < chunkBytes + ifTrue: "walk down the tree" + [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] + ifFalse: + [nodeBytes := childBytes. + child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]. + "if no chunk, there was no exact fit" + (node ~= 0 and: [acceptanceBlock value: node]) ifFalse: + [^nil]. + + "self printFreeChunk: parent" + self assert: nodeBytes = chunkBytes. + self assert: (self bytesInObject: node) = chunkBytes. + + "can't be a list; would have removed and returned it above." + self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0. + + "no list; remove the interior node" + "N.B. This will fail when we try to remove the head node and there are still next links, + which is possible given acceptanceBlock but does not occur in current use." + self unlinkSolitaryFreeTreeNode: node. + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^self startOfObject: node! Item was changed: ----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') ----- bestFitCompact "Compact all of memory using best-fit, assuming free space is sorted and that the highest objects are recorded in highestObjects." + | freePriorToExactFit firstFailedFit | + freePriorToExactFit := totalFreeOldSpace. - | firstFailedFit | firstFailedFit := self exactFitCompact. firstFailedFit = 0 ifTrue: [^self]. "either no free space, no high objects, or no misfits." self allOldSpaceObjectsFrom: firstFailedFit do: [:o| | b | ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil: [:f| self mem: f cp: o y: ((self hasOverflowHeader: o) ifTrue: [b - self baseHeaderSize] ifFalse: [b]). (self isRemembered: o) ifTrue: [scavenger remember: f]. self forward: o to: f]. self checkFreeSpace]]. self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') ----- checkHeapIntegrity "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects has set a bit at each object's header. Scan all objects in the heap checking that every pointer points to a header. Scan the rootTable, remapBuffer and extraRootTable checking that every entry is a pointer to a header. Check that the number of roots is correct and that all rootTable entries have their rootBit set. Answer if all checks pass." | prevObj prevPrevObj ok numRememberedRootsInHeap | <inline: false> ok := true. numRememberedRootsInHeap := 0. self allHeapEntitiesDo: [:obj| | containsYoung fieldOop classIndex classOop | (self isFreeObject: obj) ifFalse: [containsYoung := false. (self isRemembered: obj) ifTrue: [numRememberedRootsInHeap := numRememberedRootsInHeap + 1. (scavenger isInRememberedSet: obj) ifFalse: [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr. self eek. ok := false]]. (self isForwarded: obj) ifTrue: [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. self eek. ok := false]. (self isYoung: fieldOop) ifTrue: [containsYoung := true]] ifFalse: [classOop := self classAtIndex: (classIndex := self classIndexOf: obj). ((classOop isNil or: [classOop = nilObj]) + and: [(self isHiddenObj: obj) not]) ifTrue: - and: [obj ~= self freeListsObject]) ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr. self eek. ok := false]. self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do: [:ptr| fieldOop := self longAt: obj + ptr. (self isNonImmediate: fieldOop) ifTrue: [| fi | fi := ptr - self baseHeaderSize / self wordSize. (fieldOop bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false]. "don't be misled by CogMethods; they appear to be young, but they're not" ((self isYoung: fieldOop) and: [fieldOop >= startOfMemory]) ifTrue: [containsYoung := true]]]]]. (containsYoung and: [(self isYoung: obj) not]) ifTrue: [(self isRemembered: obj) ifFalse: [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr. self eek. ok := false]]]. prevPrevObj := prevObj. prevObj := obj]. numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue: [coInterpreter print: 'root count mismatch. #heap roots '; printNum: numRememberedRootsInHeap; print: '; #roots '; printNum: scavenger rememberedSetSize; cr. self eek. "But the system copes with overflow..." self flag: 'no support for remembered set overflow yet'. "ok := rootTableOverflowed and: [needGCFlag]"]. scavenger rememberedSetWithIndexDo: [:obj :i| (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(self isYoung: obj) ifTrue: [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false]]]]. 1 to: remapBufferCount do: [:ri| | obj | obj := remapBuffer at: ri. (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr. self eek. ok := false]]]. 1 to: extraRootCount do: [:ri| | obj | obj := (extraRoots at: ri) at: 0. (obj bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue: [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr. self eek. ok := false]]]. ^ok! Item was changed: ----- Method: SpurMemoryManager>>ensureRoomOnObjStackAt: (in category 'obj stacks') ----- ensureRoomOnObjStackAt: objStackRootIndex "An obj stack is a stack of objects stored in a hidden root slot, such as the markStack or the ephemeronQueue. It is a linked list of segments, with the hot end at the head of the list. It is a word object. The stack pointer is in ObjStackTopx and 0 means empty. The list goes through ObjStackNextx. We don't want to shrink objStacks, since they're used in GC and its good to keep their memory around. So unused pages created by popping emptying pages are kept on the ObjStackFreex list." | stackOrNil freeOrNewPage | stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj. (stackOrNil = nilObj or: [(self fetchPointer: ObjStackTopx ofObject: stackOrNil) >= ObjStackLimit]) ifTrue: [freeOrNewPage := stackOrNil = nilObj ifTrue: [0] ifFalse: [self fetchPointer: ObjStackFreex ofObject: stackOrNil]. freeOrNewPage ~= 0 ifTrue: "the free page list is always on the new page." [self storePointer: ObjStackFreex ofObjStack: stackOrNil withValue: 0] ifFalse: [freeOrNewPage := self allocateSlotsInOldSpace: ObjStackPageSlots format: self wordIndexableFormat classIndex: self wordSizeClassIndexPun. freeOrNewPage ifNil: [self error: 'no memory to allocate or extend obj stack']. self storePointer: ObjStackFreex ofObjStack: freeOrNewPage withValue: 0]. marking ifTrue: [self setIsMarkedOf: freeOrNewPage to: true]. self storePointer: ObjStackMyx ofObjStack: freeOrNewPage withValue: objStackRootIndex; storePointer: ObjStackNextx ofObjStack: freeOrNewPage withValue: (stackOrNil = nilObj ifTrue: [0] ifFalse: [stackOrNil]); storePointer: ObjStackTopx ofObjStack: freeOrNewPage withValue: 0; storePointer: objStackRootIndex ofObject: hiddenRootsObj withValue: freeOrNewPage. self assert: (self isValidObjStackAt: objStackRootIndex). "Added a new page; now update and answer the relevant cached first page." + ^self updateRootOfObjStack: objStackRootIndex with: freeOrNewPage]. - ^self updateRootOfObjStack: objStackRootIndex with:freeOrNewPage]. self assert: (self isValidObjStackAt: objStackRootIndex). ^stackOrNil! Item was changed: ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') ----- exactFitCompact "Compact all of memory using exact-fit, assuming free space is sorted and that the highest objects are recorded in highestObjects." + | firstFailedFit top o | + <var: #top type: #unsigned> - | firstFailedFit | firstFailedFit := 0. totalFreeOldSpace = 0 ifTrue: [^0]. + top := highestObjects top. + [[top := top - self wordSize. + top < highestObjects start ifTrue: + [top := highestObjects limit]. + top ~= highestObjects top and: [(o := self longAt: top) > firstFreeChunk]] whileTrue: + [| b | + ((self isForwarded: o) + or: [self isPinned: o]) ifFalse: + [b := self bytesInObject: o. + (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) + ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]] + ifNotNil: + [:f| + self mem: f + cp: o + y: ((self hasOverflowHeader: o) + ifTrue: [b - self baseHeaderSize] + ifFalse: [b]). + "wait until the next scavenge to unremember o" + (self isRemembered: o) ifTrue: + [scavenger remember: f]. + self forward: o to: f]]]. + top = highestObjects top and: [o > firstFreeChunk]] whileTrue: + [self fillHighestObjectsFrom: firstFreeChunk upTo: o]. - self allOldSpaceObjectsFrom: self lowestFreeChunkAssumingSortedFreeSpace - do: [:o| | b | - ((self isForwarded: o) - or: [self isPinned: o]) ifFalse: - [b := self bytesInObject: o. - (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) - ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]] - ifNotNil: - [:f| - self mem: f - cp: o - y: ((self hasOverflowHeader: o) - ifTrue: [b - self baseHeaderSize] - ifFalse: [b]). - (self isRemembered: o) ifTrue: - [scavenger remember: f]. - self forward: o to: f]]]. self checkFreeSpace. ^firstFailedFit! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings, coalescing free chunks, and sorting free space. Small free chunks are sorted in address order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. Record the highest N objects in highestObjects, for the first cycle of exactFitCompact. Let the segmentManager mark which segments contain pinned objects via notePinned:" + | lastLargeFree highestObjectsWraps sortedFreeChunks | - | lastLargeFree highestObjectsWraps | self checkFreeSpace. scavenger forgetUnmarkedRememberedObjects. segmentManager prepareForGlobalSweep."for notePinned:" "for sorting free space throw away the list heads, rebuilding them for small free chunks below." self resetFreeListHeads. highestObjects top: freeStart; start: freeStart; limit: scavenger eden limit. highestObjectsWraps := 0. self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. + firstFreeChunk := sortedFreeChunks := lastLargeFree := 0. - sortedFreeChunks := lastLargeFree := 0. self allOldSpaceEntitiesForCoalescingDo: [:o| (self isMarked: o) ifTrue: [self setIsMarkedOf: o to: false. ((self isWeakNonImm: o) and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: [coInterpreter signalFinalization: o]. (self isPinned: o) ifTrue: [segmentManager notePinned: o]. lastLargeFree ~= 0 ifTrue: [self longAt: highestObjects top put: o. (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue: [highestObjects top: highestObjects start. highestObjectsWraps := highestObjectsWraps + 1]]] ifFalse: "unmarked; two cases, an unreachable object or a free chunk." [| here next | self assert: (self isRemembered: o) not. "scavenger should have cleared this above" here := o. next := self objectAfter: here limit: endOfMemory. (self isMarked: next) ifFalse: "coalescing; rare case" [self assert: (self isRemembered: o) not. [statCoalesces := statCoalesces + 1. here := self coalesce: here and: next. next := self objectAfter: here limit: endOfMemory. next = endOfMemory or: [self isMarked: next]] whileFalse]. + firstFreeChunk = 0 ifTrue: + [firstFreeChunk := here]. (self isLargeFreeObject: here) ifTrue: [lastLargeFree = 0 ifTrue: [sortedFreeChunks := here] ifFalse: [self setFree: here. self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. lastLargeFree := here] ifFalse: [self freeSmallObject: here]]]. lastLargeFree ~= 0 ifTrue: [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. totalFreeOldSpace := self reverseSmallListHeads. + totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks). - totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks. self checkFreeSpace. self touch: highestObjectsWraps! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect + self runLeakCheckerForFullGC: true. self markObjects. + self runLeakCheckerForFullGC: true. self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace. + self runLeakCheckerForFullGC: true. + self bestFitCompact. + self runLeakCheckerForFullGC: true! - self bestFitCompact! Item was changed: ----- Method: SpurMemoryManager>>inFreeTreeReplace:with: (in category 'free space') ----- inFreeTreeReplace: treeNode with: newNode + "Part of reorderReversedTreeList:. Switch treeNode with newNode in + the tree, but do nothing to the list linked through freeChunkNextIndex." | relative | "copy parent, smaller, larger" self freeChunkParentIndex to: self freeChunkLargerIndex do: [:i| - self storePointer: i ofFreeChunk: newNode withValue: (self fetchPointer: i ofObject: treeNode)]. - "replace link from parent to treeNode with link to newNode." - relative := self fetchPointer: self freeChunkParentIndex ofObject: treeNode. - relative = 0 - ifTrue: - [freeLists at: 0 put: newNode] - ifFalse: - [self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: relative) - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofFreeChunk: relative - withValue: newNode]. - "replace parent links in children" - self freeChunkSmallerIndex to: self freeChunkLargerIndex do: - [:i| relative := self fetchPointer: i ofObject: treeNode. + i = self freeChunkParentIndex + ifTrue: + [relative = 0 + ifTrue: "update root to point to newNode" + [self assert: (freeLists at: 0) = treeNode. + freeLists at: 0 put: newNode] + ifFalse: "replace link from parent to treeNode with link to newNode." + [self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: relative) + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: relative + withValue: newNode]] + ifFalse: + [relative ~= 0 ifTrue: + [self assert: (self fetchPointer: self freeChunkParentIndex ofObject: relative) = treeNode. + self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]]. + self storePointer: i ofFreeChunk: newNode withValue: relative. + self storePointer: i ofFreeChunk: treeNode withValue: 0]! - relative ~= 0 ifTrue: - [self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]]! Item was added: + ----- Method: SpurMemoryManager>>isHiddenObj: (in category 'debug support') ----- + isHiddenObj: objOop + ^objOop = self freeListsObject + or: [(self numSlotsOfAny: objOop) = ObjStackPageSlots + and: [self isValidObjStackPage: objOop myIndex: (self fetchPointer: ObjStackMyx ofObject: objOop)]]! Item was added: + ----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex: (in category 'obj stacks') ----- + isValidObjStackPage: objStackPage myIndex: myx + "Just check the page itself." + <inline: false> + (self classIndexOf: objStackPage) = self wordSizeClassIndexPun ifFalse: + [objStackInvalidBecause := 'wong class index'. + ^false]. + (self formatOf: objStackPage) = self wordIndexableFormat ifFalse: + [objStackInvalidBecause := 'wong format'. + ^false]. + (self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse: + [objStackInvalidBecause := 'wong num slots'. + ^false]. + myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse: + [objStackInvalidBecause := 'wong myx'. + ^false]. + ^true! Item was changed: ----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex:firstPage: (in category 'obj stacks') ----- isValidObjStackPage: objStackPage myIndex: myx firstPage: isFirstPage "Answer if the obj stack at stackRootIndex is valid." | freeOrNextPage index | <inline: false> + (self isValidObjStackPage: objStackPage myIndex: myx) ifFalse: + [^false]. + freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage. + [freeOrNextPage ~= 0] whileTrue: + [isFirstPage ifFalse: + [objStackInvalidBecause := 'free page on other than first page'. + ^false]. + (self isValidObjStackPage: freeOrNextPage myIndex: myx) ifFalse: + [objStackInvalidBecause := self str: objStackInvalidBecause cat: ', on next page'. + ^false]. + freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage]. - (self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse: - [objStackInvalidBecause := 'wong num slots'. - ^false]. isFirstPage ifTrue: [(myx between: self classTableRootSlots and: self classTableRootSlots + self hiddenRootSlots - 1) ifFalse: [objStackInvalidBecause := 'myx out of range'. ^false]. (self fetchPointer: myx ofObject: hiddenRootsObj) = objStackPage ifFalse: [objStackInvalidBecause := 'firstPage is not root'. ^false]]. - myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse: - [objStackInvalidBecause := 'wong myx'. - ^false]. - freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage. - freeOrNextPage ~= 0 ifTrue: - [isFirstPage ifFalse: - [objStackInvalidBecause := 'free page on other than first page'. - ^false]. - (self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false) ifFalse: - [objStackInvalidBecause := self str: objStackInvalidBecause cat: ' on next page'. - ^false]]. index := self fetchPointer: ObjStackTopx ofObject: objStackPage. (index between: 0 and: ObjStackLimit) ifFalse: [objStackInvalidBecause := 'bad topx'. ^false]. freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage. ^freeOrNextPage = 0 or: [self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false]! Item was removed: - ----- Method: SpurMemoryManager>>lowestFreeChunkAssumingSortedFreeSpace (in category 'free space') ----- - lowestFreeChunkAssumingSortedFreeSpace - | lowest | - lowest := sortedFreeChunks = 0 - ifTrue: [endOfMemory] - ifFalse: [sortedFreeChunks]. - 1 to: self numFreeLists - 1 do: - [:i| | chunk | - chunk := freeLists at: i. - (chunk ~= 0 and: [chunk < lowest]) ifTrue: - [lowest := chunk]]. - ^lowest! Item was changed: ----- Method: SpurMemoryManager>>markAndTraceObjStack:andContents: (in category 'obj stacks') ----- markAndTraceObjStack: stackOrNil andContents: markAndTraceContents "An obj stack is a stack of objects stored in a hidden root slot, such as the markStack or the ephemeronQueue. It is a linked list of segments, with the hot end at the head of the list. It is a word object. The stack pointer is in ObjStackTopx and 0 means empty." <returnTypeC: #void> + <inline: false> | index field | stackOrNil = nilObj ifTrue: [^self]. self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots. field := self fetchPointer: ObjStackNextx ofObject: stackOrNil. field ~= 0 ifTrue: [self markAndTraceObjStack: field andContents: markAndTraceContents]. + field := stackOrNil. + [field := self fetchPointer: ObjStackFreex ofObject: stackOrNil. + field ~= 0] whileTrue: + [self setIsMarkedOf: field to: true]. markAndTraceContents ifFalse: [^self]. "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5." index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx. [index >= ObjStackFixedSlots] whileTrue: [field := self fetchPointer: index ofObject: stackOrNil. (self isImmediate: field) ifFalse: [self markAndTrace: field]. index := index - 1]! Item was changed: ----- Method: SpurMemoryManager>>popObjStack: (in category 'obj stacks') ----- popObjStack: objStack | topx top nextPage myx | self assert: (self isValidObjStack: objStack). topx := self fetchPointer: ObjStackTopx ofObject: objStack. topx = 0 ifTrue: [self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0. self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)" inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#EMPTY. nil}]]. ^nil]. topx := topx - 1. top := self fetchPointer: topx + ObjStackFixedSlots ofObject: objStack. self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)" inSmalltalk: [MarkStackRecord ifNotNil: [(MarkStackRecord last first = #push and: [MarkStackRecord last last = top]) ifTrue: [MarkStackRecord removeLast] ifFalse: [MarkStackRecord addLast: {#pop. top}]]]. self storePointer: ObjStackTopx ofObject: objStack withValue: topx. (topx = 0 and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0]) ifTrue: + [self storePointer: ObjStackFreex ofObjStack: nextPage withValue: objStack. + self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0. - [self storePointer: ObjStackFreex ofObject: nextPage withValue: objStack. myx := self fetchPointer: ObjStackMyx ofObject: objStack. self updateRootOfObjStack: myx with: nextPage]. ^top! Item was changed: ----- Method: SpurMemoryManager>>push:onObjStack: (in category 'obj stacks') ----- push: objOop onObjStack: objStack | topx | self assert: (self addressCouldBeOop: objOop). self assert: (self isValidObjStack: objStack). (self isImmediate: objOop) ifTrue: [self assert: objStack = markStack. + self assert: (self addressCouldBeObj: (self topOfObjStack: + (0 = (self fetchPointer: ObjStackTopx ofObject: objStack) + ifTrue: [self fetchPointer: ObjStackNextx ofObject: objStack] + ifFalse: [objStack])))]. - self assert: (self addressCouldBeObj: (self topOfObjStack: objStack))]. self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)" inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#push. objOop}]]. topx := self fetchPointer: ObjStackTopx ofObject: objStack. topx >= ObjStackLimit ifTrue: [self push: objOop onObjStack: (self ensureRoomOnObjStackAt: (self fetchPointer: ObjStackMyx ofObject: objStack))] ifFalse: + [self storePointer: ObjStackFixedSlots + topx ofObjStack: objStack withValue: objOop. + self storePointer: ObjStackTopx ofObjStack: objStack withValue: topx + 1]. - [self storePointer: ObjStackFixedSlots + topx ofObject: objStack withValue: objOop. - self storePointer: ObjStackTopx ofObject: objStack withValue: topx + 1]. ^objOop! Item was added: + ----- Method: SpurMemoryManager>>rebuildFreeTreeFrom: (in category 'free space') ----- + rebuildFreeTreeFrom: sortedFreeChunks + "post sweep and pre compact, rebuild the large free chunk tree from the + sortedFreeChunks list, such that the lists are ordered from low to high address." + | freeChunk bytes totalBytes | + "first add all the chunks to the tree. This will result in almost address-sorted lists. + We will need to reorder the lists." + freeChunk := sortedFreeChunks. + totalBytes := 0. + [freeChunk ~= 0] whileTrue: + [bytes := self bytesInObject: freeChunk. + totalBytes := totalBytes + bytes. + self addToFreeTree: freeChunk bytes: bytes. + freeChunk := self fetchPointer: self freeChunkNextAddressIndex + ofObject: freeChunk]. + "now reorder the lists to ensure they're in address order, apart from the list head, which should be highest." + self freeTreeNodesDo: + [:treeNode| | newTreeNode | + newTreeNode := self reorderReversedTreeList: treeNode. + newTreeNode]. + ^totalBytes! Item was removed: - ----- Method: SpurMemoryManager>>rebuildFreeTreeFromSortedFreeChunks (in category 'free space') ----- - rebuildFreeTreeFromSortedFreeChunks - "post sweep and pre compact, rebuild the large free chunk tree from the - sortedFreeChunks list, such that the lists are ordered from low to high address." - | freeChunk bytes totalBytes | - "first add all the chunks to the tree. This will result in almost address-sorted lists. - We will need to reorder the lists." - freeChunk := sortedFreeChunks. - totalBytes := 0. - [freeChunk ~= 0] whileTrue: - [bytes := self bytesInObject: freeChunk. - totalBytes := totalBytes + bytes. - self addToFreeTree: freeChunk bytes: bytes. - freeChunk := self fetchPointer: self freeChunkNextAddressIndex - ofObject: freeChunk]. - "now reorder the lists to ensure they're in address order, apart from the list head, which should be highest." - self freeTreeNodesDo: - [:treeNode| | newTreeNode | - newTreeNode := self reorderReversedTreeList: treeNode. - newTreeNode]. - ^totalBytes! Item was removed: - ----- Method: SpurMemoryManager>>sortFreeSpace (in category 'free space') ----- - sortFreeSpace - "Sort free space for best-fit compaction. Sort the individual free lists so that - the lowest address is at the head of each list. Sort the large chunks through the - freeChunkNextAddressIndex from low to high, with the head in sortedFreeChunks." - - self checkFreeSpace. - 1 to: self numFreeLists - 1 do: - [:i| self sortFreeListAt: i]. - sortedFreeChunks := 0. - self allObjectsInFreeTreeDo: - [:f| | node prev | - node := sortedFreeChunks. - prev := 0. - [node ~= 0 - and: [node < f]] whileTrue: - [prev := node. - node := self fetchPointer: self freeChunkNextAddressIndex ofObject: node]. - "insert the node into the sorted list" - self assert: (node = 0 or: [node > f]). - prev = 0 - ifTrue: - [sortedFreeChunks := f] - ifFalse: - [self storePointer: self freeChunkNextAddressIndex - ofFreeChunk: prev - withValue: f]. - self storePointer: self freeChunkNextAddressIndex - ofFreeChunk: f - withValue: node]. - self assert: self sortedFreeChunksAreSorted. - self checkFreeSpace! Item was removed: - ----- Method: SpurMemoryManager>>sortedFreeChunksAreSorted (in category 'debug support') ----- - sortedFreeChunksAreSorted - | chunk next | - chunk := sortedFreeChunks. - [chunk ~= 0] whileTrue: - [next := self fetchPointer: self freeChunkNextAddressIndex ofObject: chunk. - (next = 0 or: [next > chunk]) ifFalse: - [^false]. - chunk := next]. - ^true! Item was changed: ----- Method: SpurMemoryManager>>topOfObjStack: (in category 'obj stacks') ----- topOfObjStack: objStack | topx | + "This assert is tricky. push:onObjStack: may call topOfObjStack: just after pushing an + empty page on the stack, and will ask if the second page is valid." + self assert: (self isValidObjStackPage: objStack + myIndex: (self fetchPointer: ObjStackMyx ofObject: objStack) + firstPage: (objStack = (self fetchPointer: (self fetchPointer: ObjStackMyx ofObject: objStack) ofObject: hiddenRootsObj))). - self assert: (self isValidObjStack: objStack). topx := self fetchPointer: ObjStackTopx ofObject: objStack. topx = 0 ifTrue: [self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0. ^nil]. ^self fetchPointer: topx + ObjStackFixedSlots - 1 ofObject: objStack! Item was changed: ----- Method: SpurMemoryManager>>unlinkSolitaryFreeTreeNode: (in category 'free space') ----- unlinkSolitaryFreeTreeNode: freeTreeNode "Unlink a freeTreeNode. Assumes the node has no list (null next link)." | parent smaller larger | + self assert: (self fetchPointer: self freeChunkNextIndex ofObject: freeTreeNode) = 0. "case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S | case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeTreeNode. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeTreeNode. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: freeTreeNode. parent = 0 ifTrue: "no parent; stitch the subnodes back into the root" [smaller = 0 ifTrue: [self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0. freeLists at: 0 put: larger] ifFalse: [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0. freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]] ifFalse: "parent; stitch back into appropriate side of parent." [smaller = 0 ifTrue: [self storePointer: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: larger. self storePointer: self freeChunkParentIndex ofObject: larger withValue: parent] ifFalse: [self storePointer: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: smaller. self storePointer: self freeChunkParentIndex ofObject: smaller withValue: parent. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]]! Item was changed: ----- Method: SpurMemoryManager>>updateRootOfObjStack:with: (in category 'obj stacks') ----- updateRootOfObjStack: objStackRootIndex with: newRootPage + self storePointer: objStackRootIndex + ofObject: hiddenRootsObj + withValue: newRootPage. - self assert: (self isValidObjStack: newRootPage). objStackRootIndex caseOf: { [MarkStackRootIndex] -> [markStack := newRootPage]. [EphemeronQueueRootIndex] -> [ephemeronQueue := newRootPage] }. + self assert: (self isValidObjStack: newRootPage). ^newRootPage! Item was added: + ----- Method: VMClass>>asString: (in category 'C library simulation') ----- + asString: aStringOrStringIndex + "aStringOrStringIndex is either a string or an address in the heap. + Create a String of the requested length form the bytes in the + heap starting at stringIndex." + <doNotGenerate> + | sz | + aStringOrStringIndex isString ifTrue: + [^aStringOrStringIndex]. + sz := self strlen: aStringOrStringIndex. + ^self st: (ByteString new: sz) rn: aStringOrStringIndex cpy: sz! Item was added: + ----- Method: VMClass>>str:cat: (in category 'C library simulation') ----- + str: aString cat: bString + <doNotGenerate> + "implementation of strcat(3)" + ^(self asString: aString), (self asString: bString)!

1 0

first window, yay! Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.399.mcz
by btc＠openinworld.com 22 Oct '13

22 Oct '13

commits(a)source.squeak.org wrote: > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-eem.399.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.399 > Author: eem > Time: 20 September 2013, 6:28:56.308 pm > UUID: 89f8fefe-b59d-42d7-9c11-7f848d0e5131 > Ancestors: VMMaker.oscog-eem.398 > > A few isIntegerObject:'s => isImmediate:'s in primitives. > > More protocol. > > The Spur VM now draws its first window!! > > A cheer goes up in the crowd of interested spectators. Probably lots still to do, but its a nice concrete milestone. Contributing is beyond me at this time, so I especially like to thank you for this important initiative. cheers -ben

8 13

VM Maker: VMMaker.oscog-eem.472.mcz
by commits＠source.squeak.org 21 Oct '13

21 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.472.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.472 Author: eem Time: 21 October 2013, 1:19:49.652 pm UUID: 88a5a8b4-a29f-43fd-9a4e-ff5319cf5c4d Ancestors: VMMaker.oscog-eem.471 Make rebuildFreeTreeFromSortedFreeChunks sort the lists off each tree node in the free tree for compaction, highest address for the node, followed by a list from low to high. Requires freeTreeNodesDo: to update its notion of the node from its block. This in turn requires Slang to handle outputting an assignment whose value is a value expansion correctly, moving the assignment to the last statement of the value expansion. speeling errars, coallesce => coalesce, detatch => detach. Now ready to implement bestBitCompact & exactFitCompact properly. =============== Diff against VMMaker.oscog-eem.471 =============== Item was added: + ----- Method: Spur32BitMemoryManager>>coalesce:and: (in category 'gc - global') ----- + coalesce: obj1 and: obj2 + | header1NumSlots header2NumSlots obj2slots newNumSlots | + header1NumSlots := self rawNumSlotsOf: obj1. + header2NumSlots := self rawNumSlotsOf: obj2. + + "compute total number of slots in obj2, including header" + obj2slots := header2NumSlots = self numSlotsMask + ifTrue: [(self longAt: obj2 - self baseHeaderSize) + (2 * self baseHeaderSize / self wordSize)] + ifFalse: [(header2NumSlots = 0 ifTrue: [1] ifFalse: [header2NumSlots]) + (self baseHeaderSize / self wordSize)]. + obj2slots := obj2slots + (obj2slots bitAnd: 1). + self assert: obj2slots * self wordSize = (self bytesInObject: obj2). + + "if obj1 already has a double header things are simple..." + header1NumSlots = self numSlotsMask ifTrue: + [self longAt: obj1 - self baseHeaderSize put: obj2slots + (self longAt: obj1 - self baseHeaderSize). + ^obj1]. + + "compute total number of slots in obj1, excluding header" + header1NumSlots := header1NumSlots = 0 + ifTrue: [2] + ifFalse: [header1NumSlots + (header1NumSlots bitAnd: 1)]. + self assert: header1NumSlots * self wordSize + self baseHeaderSize = (self bytesInObject: obj1). + newNumSlots := obj2slots + header1NumSlots. + + "if obj1 still only requires a single header things are simple..." + newNumSlots < self numSlotsMask ifTrue: + [self byteAt: obj1 + (self numSlotsFullShift / BitsPerByte) + put: newNumSlots. + ^obj1]. + + "convert from single to double header..." + newNumSlots := newNumSlots - (self baseHeaderSize / self wordSize). + self longAt: obj1 + self baseHeaderSize + put: (self longAt: obj1); + longAt: obj1 + 4 + self baseHeaderSize + put: ((self longAt: obj1 + 4) bitOr: self numSlotsMask << self numSlotsHalfShift). + self longAt: obj1 + put: newNumSlots. + self longAt: obj1 + 4 + put: self numSlotsMask << self numSlotsHalfShift. + ^obj1 + self baseHeaderSize! Item was removed: - ----- Method: Spur32BitMemoryManager>>coallesce:and: (in category 'gc - global') ----- - coallesce: obj1 and: obj2 - | header1NumSlots header2NumSlots obj2slots newNumSlots | - header1NumSlots := self rawNumSlotsOf: obj1. - header2NumSlots := self rawNumSlotsOf: obj2. - - "compute total number of slots in obj2, including header" - obj2slots := header2NumSlots = self numSlotsMask - ifTrue: [(self longAt: obj2 - self baseHeaderSize) + (2 * self baseHeaderSize / self wordSize)] - ifFalse: [(header2NumSlots = 0 ifTrue: [1] ifFalse: [header2NumSlots]) + (self baseHeaderSize / self wordSize)]. - obj2slots := obj2slots + (obj2slots bitAnd: 1). - self assert: obj2slots * self wordSize = (self bytesInObject: obj2). - - "if obj1 already has a double header things are simple..." - header1NumSlots = self numSlotsMask ifTrue: - [self longAt: obj1 - self baseHeaderSize put: obj2slots + (self longAt: obj1 - self baseHeaderSize). - ^obj1]. - - "compute total number of slots in obj1, excluding header" - header1NumSlots := header1NumSlots = 0 - ifTrue: [2] - ifFalse: [header1NumSlots + (header1NumSlots bitAnd: 1)]. - self assert: header1NumSlots * self wordSize + self baseHeaderSize = (self bytesInObject: obj1). - newNumSlots := obj2slots + header1NumSlots. - - "if obj1 still only requires a single header things are simple..." - newNumSlots < self numSlotsMask ifTrue: - [self byteAt: obj1 + (self numSlotsFullShift / BitsPerByte) - put: newNumSlots. - ^obj1]. - - "convert from single to double header..." - newNumSlots := newNumSlots - (self baseHeaderSize / self wordSize). - self longAt: obj1 + self baseHeaderSize - put: (self longAt: obj1); - longAt: obj1 + 4 + self baseHeaderSize - put: ((self longAt: obj1 + 4) bitOr: self numSlotsMask << self numSlotsHalfShift). - self longAt: obj1 - put: newNumSlots. - self longAt: obj1 + 4 - put: self numSlotsMask << self numSlotsHalfShift. - ^obj1 + self baseHeaderSize! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) 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 - or when loading multiple segments that have been coallesced. Also set bits in the classTableBitmap corresponding to used classes." | obj | self countNumClassPagesPreSwizzle: bytesToShift; ensureAdequateClassTableBitmap. (bytesToShift ~= 0 or: [segmentManager numSegments > 1]) ifTrue: [self assert: self newSpaceIsEmpty. obj := self objectStartingAt: newSpaceLimit. [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: [(self isFreeObject: obj) ifTrue: [self swizzleFieldsOfFreeChunk: obj] ifFalse: [self inClassTableBitmapSet: (self classIndexOf: obj). self swizzleFieldsOfObject: obj]. obj := self objectAfter: obj]] ifFalse: [self assert: self newSpaceIsEmpty. obj := self objectStartingAt: newSpaceLimit. [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: [(self isFreeObject: obj) ifFalse: [self inClassTableBitmapSet: (self classIndexOf: obj)]. obj := self objectAfter: obj]]! Item was changed: ----- Method: SpurMemoryManager>>allObjectsInFreeTreeDo: (in category 'free space') ----- allObjectsInFreeTreeDo: aBlock "Enumerate all objects in the free tree (in order, smaller to larger). This is an iterative version so that the block argument can be inlined by Slang. The trick to an iterative binary tree application is to apply the function on the way back up when returning from a particular direction, in this case up from the larger child." <inline: true> self freeTreeNodesDo: [:freeTreeNode| | next | next := freeTreeNode. [aBlock value: next. next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next. + next ~= 0] whileTrue. + freeTreeNode]! - next ~= 0] whileTrue]! Item was added: + ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCoalescingDo: (in category 'object enumeration') ----- + allOldSpaceEntitiesForCoalescingDo: aBlock + <inline: true> + | prevObj prevPrevObj objOop rawNumSlots rawNumSlotsAfter | + prevPrevObj := prevObj := nil. + objOop := self firstObject. + [self assert: objOop \\ self allocationUnit = 0. + objOop < freeOldSpaceStart] whileTrue: + [rawNumSlots := self rawNumSlotsOf: objOop. + aBlock value: objOop. + "If the number of slot changes coalescing changed an object from a single to a double header." + rawNumSlotsAfter := self rawNumSlotsOf: objOop. + (rawNumSlotsAfter ~= rawNumSlots + and: [rawNumSlotsAfter = self numSlotsMask]) ifTrue: + [objOop := objOop + self baseHeaderSize. + self assert: (self objectAfter: prevObj limit: freeOldSpaceStart) = objOop]. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop limit: freeOldSpaceStart]. + self touch: prevPrevObj. + self touch: prevObj! Item was removed: - ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCoallescingDo: (in category 'object enumeration') ----- - allOldSpaceEntitiesForCoallescingDo: aBlock - <inline: true> - | prevObj prevPrevObj objOop rawNumSlots rawNumSlotsAfter | - prevPrevObj := prevObj := nil. - objOop := self firstObject. - [self assert: objOop \\ self allocationUnit = 0. - objOop < freeOldSpaceStart] whileTrue: - [rawNumSlots := self rawNumSlotsOf: objOop. - aBlock value: objOop. - "If the number of slot changes coallescing changed an object from a single to a double header." - rawNumSlotsAfter := self rawNumSlotsOf: objOop. - (rawNumSlotsAfter ~= rawNumSlots - and: [rawNumSlotsAfter = self numSlotsMask]) ifTrue: - [objOop := objOop + self baseHeaderSize. - self assert: (self objectAfter: prevObj limit: freeOldSpaceStart) = objOop]. - prevPrevObj := prevObj. - prevObj := objOop. - objOop := self objectAfter: objOop limit: freeOldSpaceStart]. - self touch: prevPrevObj. - self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') ----- bestFitCompact + "Compact all of memory using best-fit, assuming free space is sorted + and that the highest objects are recorded in highestObjects." - "Compact all of memory using best-fit. - Sort free space, find the first free chunk. Scan objects following - the first free chunk and for each, look for a free chunk of the exact - size, copy the object's contents into the free chunk, and forward - the object to its new, lower location. If any didn't fit exactly do a - second pass using best fit." | firstFailedFit | firstFailedFit := self exactFitCompact. firstFailedFit = 0 ifTrue: [^self]. "either no free space, no high objects, or no misfits." self allOldSpaceObjectsFrom: firstFailedFit do: [:o| | b | ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. + (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil: - (self allocateOldSpaceChunkOfBytes: b) ifNotNil: [:f| self mem: f cp: o y: ((self hasOverflowHeader: o) ifTrue: [b - self baseHeaderSize] ifFalse: [b]). (self isRemembered: o) ifTrue: [scavenger remember: f]. self forward: o to: f]. self checkFreeSpace]]. self checkFreeSpace! Item was removed: - ----- Method: SpurMemoryManager>>buildPrevLinksForLargeFreeChunks (in category 'free space') ----- - buildPrevLinksForLargeFreeChunks - | prevTreeNode | - prevTreeNode := 0. - self freeTreeNodesDo: - [:freeTreeNode| | next prev | - "freeTreeNodesDo: is supposed to be an in-order traversal from smaller to larger..." - self assert: (prevTreeNode = 0 or: [(self numSlotsOfAny: prevTreeNode) < (self numSlotsOfAny: freeTreeNode)]). - self storePointer: self freeChunkPrevIndex ofFreeChunk: freeTreeNode withValue: 0. - prev := freeTreeNode. - [(next := self fetchPointer: self freeChunkNextIndex ofObject: prev) ~= 0] whileTrue: - [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev. - prev := next]]! Item was added: + ----- Method: SpurMemoryManager>>coalesce:and: (in category 'gc - global') ----- + coalesce: obj1 and: obj2 + self subclassResponsibility! Item was removed: - ----- Method: SpurMemoryManager>>coallesce:and: (in category 'gc - global') ----- - coallesce: obj1 and: obj2 - self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>detachLargeFreeObject: (in category 'free space') ----- + detachLargeFreeObject: freeChunk + | prev next | + prev := self fetchPointer: self freeChunkPrevIndex ofObject: freeChunk. + next := self fetchPointer: self freeChunkNextIndex ofObject: freeChunk. + prev = 0 + ifTrue: "freeChunk is a treeNode" + [next = 0 + ifTrue: "remove it from the tree" + [self unlinkSolitaryFreeTreeNode: freeChunk] + ifFalse: "replace freeChunk by its next node." + [self unlinkFreeTreeNode: freeChunk withSiblings: next]] + ifFalse: "freeChunk is a list node; simple" + [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next. + next ~= 0 ifTrue: + [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev]]! Item was removed: - ----- Method: SpurMemoryManager>>detatchLargeFreeObject: (in category 'free space') ----- - detatchLargeFreeObject: freeChunk - | prev next | - prev := self fetchPointer: self freeChunkPrevIndex ofObject: freeChunk. - next := self fetchPointer: self freeChunkNextIndex ofObject: freeChunk. - prev = 0 - ifTrue: "freeChunk is a treeNode" - [next = 0 - ifTrue: "remove it from the tree" - [self unlinkSolitaryFreeTreeNode: freeChunk] - ifFalse: "replace freeChunk by its next node." - [self unlinkFreeTreeNode: freeChunk withSiblings: next]] - ifFalse: "freeChunk is a list node; simple" - [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next. - next ~= 0 ifTrue: - [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev]]! Item was changed: ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') ----- exactFitCompact + "Compact all of memory using exact-fit, assuming free space is sorted + and that the highest objects are recorded in highestObjects." - "Compact all of memory using exact-fit. - Sort free space, find the first free chunk. Scan objects following - the first free chunk and for each, look for a free chunk of the right - size, copy the object's contents into the free chunk, and forward - the object to its new, lower location. Answer the first object that - failed to fit (for bestFitCompacts convenience), if there's free space." | firstFailedFit | - self sortFreeSpace. firstFailedFit := 0. totalFreeOldSpace = 0 ifTrue: [^0]. self allOldSpaceObjectsFrom: self lowestFreeChunkAssumingSortedFreeSpace do: [:o| | b | ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. + (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) - (self allocateOldSpaceChunkOfExactlyBytes: b) ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]] ifNotNil: [:f| self mem: f cp: o y: ((self hasOverflowHeader: o) ifTrue: [b - self baseHeaderSize] ifFalse: [b]). (self isRemembered: o) ifTrue: [scavenger remember: f]. self forward: o to: f]]]. self checkFreeSpace. ^firstFailedFit! Item was changed: ----- Method: SpurMemoryManager>>freeTreeNodesDo: (in category 'free space') ----- freeTreeNodesDo: aBlock "Enumerate all nodes in the free tree (in order, smaller to larger), + but *not* including the next nodes of the same size off each tree node. - bit *not* including the next nodes of the same size off each tree node. This is an iterative version so that the block argument can be inlined by Slang. The trick to an iterative binary tree application is to apply the function on the way back up when returning from a + particular direction, in this case up from the larger child. + + N.B For the convenience of rebuildFreeTreeFromSortedFreeChunks + aBlock *MUST* answer the freeTreeNode it was invoked with, or + its replacement if it was replaced by aBlock." - particular direction, in this case up from the larger child." <inline: true> | treeNode cameFrom | treeNode := freeLists at: 0. treeNode = 0 ifTrue: [^self]. cameFrom := -1. [| smallChild largeChild | smallChild := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode. largeChild := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode. "apply if the node has no children, or it has no large children and we're returning from the small child, or we're returning from the large child." ((smallChild = 0 and: [largeChild = 0]) or: [largeChild = 0 ifTrue: [cameFrom = smallChild] ifFalse: [cameFrom = largeChild]]) ifTrue: + [treeNode := aBlock value: treeNode. - [aBlock value: treeNode. "and since we've applied we must move on up" cameFrom := treeNode. treeNode := self fetchPointer: self freeChunkParentIndex ofFreeChunk: treeNode] ifFalse: [(smallChild ~= 0 and: [cameFrom ~= smallChild]) ifTrue: [treeNode := smallChild] ifFalse: [self assert: largeChild ~= 0. treeNode := largeChild]. cameFrom := -1]. treeNode ~= 0] whileTrue! Item was added: + ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- + freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace + "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings, + coalescing free chunks, and sorting free space. Small free chunks are sorted in address + order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. + Record the highest N objects in highestObjects, for the first cycle of exactFitCompact. + Let the segmentManager mark which segments contain pinned objects via notePinned:" + | lastLargeFree highestObjectsWraps | + self checkFreeSpace. + scavenger forgetUnmarkedRememberedObjects. + segmentManager prepareForGlobalSweep."for notePinned:" + "for sorting free space throw away the list heads, rebuilding them for small free chunks below." + self resetFreeListHeads. + highestObjects + top: freeStart; + start: freeStart; + limit: scavenger eden limit. + highestObjectsWraps := 0. + self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. + sortedFreeChunks := lastLargeFree := 0. + self allOldSpaceEntitiesForCoalescingDo: + [:o| + (self isMarked: o) + ifTrue: + [self setIsMarkedOf: o to: false. + ((self isWeakNonImm: o) + and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: + [coInterpreter signalFinalization: o]. + (self isPinned: o) ifTrue: + [segmentManager notePinned: o]. + lastLargeFree ~= 0 ifTrue: + [self longAt: highestObjects top put: o. + (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue: + [highestObjects top: highestObjects start. + highestObjectsWraps := highestObjectsWraps + 1]]] + ifFalse: "unmarked; two cases, an unreachable object or a free chunk." + [| here next | + self assert: (self isRemembered: o) not. "scavenger should have cleared this above" + here := o. + next := self objectAfter: here limit: endOfMemory. + (self isMarked: next) ifFalse: "coalescing; rare case" + [self assert: (self isRemembered: o) not. + [statCoalesces := statCoalesces + 1. + here := self coalesce: here and: next. + next := self objectAfter: here limit: endOfMemory. + next = endOfMemory or: [self isMarked: next]] whileFalse]. + (self isLargeFreeObject: here) + ifTrue: + [lastLargeFree = 0 + ifTrue: [sortedFreeChunks := here] + ifFalse: + [self setFree: here. + self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. + lastLargeFree := here] + ifFalse: + [self freeSmallObject: here]]]. + lastLargeFree ~= 0 ifTrue: + [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. + totalFreeOldSpace := self reverseSmallListHeads. + totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks. + self checkFreeSpace. + self touch: highestObjectsWraps! Item was removed: - ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (in category 'gc - global') ----- - freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace - "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings, - coallescing free chunks, and sorting free space. Small free chunks are sorted in address - order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. - Record the highest N objects in highestObjects, for the first cycle of exactFitCompact. - Let the segmentManager mark which segments contain pinned objects via notePinned:" - | lastLargeFree highestObjectsWraps | - self checkFreeSpace. - scavenger forgetUnmarkedRememberedObjects. - segmentManager prepareForGlobalSweep."for notePinned:" - "for sorting free space throw away the list heads, rebuilding them for small free chunks below." - self resetFreeListHeads. - highestObjects - top: freeStart; - start: freeStart; - limit: scavenger eden limit. - highestObjectsWraps := 0. - self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. - sortedFreeChunks := lastLargeFree := 0. - self allOldSpaceEntitiesForCoallescingDo: - [:o| - (self isMarked: o) - ifTrue: - [self setIsMarkedOf: o to: false. - ((self isWeakNonImm: o) - and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: - [coInterpreter signalFinalization: o]. - (self isPinned: o) ifTrue: - [segmentManager notePinned: o]. - lastLargeFree ~= 0 ifTrue: - [self longAt: highestObjects top put: o. - (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue: - [highestObjects top: highestObjects start. - highestObjectsWraps := highestObjectsWraps + 1]]] - ifFalse: "unmarked; two cases, an unreachable object or a free chunk." - [| here next | - self assert: (self isRemembered: o) not. "scavenger should have cleared this above" - here := o. - next := self objectAfter: here limit: endOfMemory. - (self isMarked: next) ifFalse: "coallescing; rare case" - [self assert: (self isRemembered: o) not. - [statCoallesces := statCoallesces + 1. - here := self coallesce: here and: next. - next := self objectAfter: here limit: endOfMemory. - next = endOfMemory or: [self isMarked: next]] whileFalse]. - (self isLargeFreeObject: here) - ifTrue: - [lastLargeFree = 0 - ifTrue: [sortedFreeChunks := here] - ifFalse: - [self setFree: here. - self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. - lastLargeFree := here] - ifFalse: - [self freeSmallObject: here]]]. - lastLargeFree ~= 0 ifTrue: - [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. - totalFreeOldSpace := self reverseSmallListHeads. - totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks. - self checkFreeSpace. - self touch: highestObjectsWraps! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect self markObjects. + self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace. + self bestFitCompact! - self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace. - self exactFitCompact! Item was added: + ----- Method: SpurMemoryManager>>inFreeTreeReplace:with: (in category 'free space') ----- + inFreeTreeReplace: treeNode with: newNode + | relative | + "copy parent, smaller, larger" + self freeChunkParentIndex to: self freeChunkLargerIndex do: + [:i| + self storePointer: i ofFreeChunk: newNode withValue: (self fetchPointer: i ofObject: treeNode)]. + "replace link from parent to treeNode with link to newNode." + relative := self fetchPointer: self freeChunkParentIndex ofObject: treeNode. + relative = 0 + ifTrue: + [freeLists at: 0 put: newNode] + ifFalse: + [self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: relative) + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: relative + withValue: newNode]. + "replace parent links in children" + self freeChunkSmallerIndex to: self freeChunkLargerIndex do: + [:i| + relative := self fetchPointer: i ofObject: treeNode. + relative ~= 0 ifTrue: + [self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]]! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. remapBufferCount := extraRootCount := 0. "see below" freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := marking := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0. statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0. + statCoalesces := 0. - statCoallesces := 0. "We can initialize things that are allocated but are lazily initialized." unscannedEphemerons := SpurContiguousObjStack new. highestObjects := SpurContiguousObjStack new. "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. "N.B. We *don't* initialize extraRoots because we don't simulate it."! Item was changed: ----- Method: SpurMemoryManager>>rebuildFreeTreeFromSortedFreeChunks (in category 'free space') ----- rebuildFreeTreeFromSortedFreeChunks + "post sweep and pre compact, rebuild the large free chunk tree from the + sortedFreeChunks list, such that the lists are ordered from low to high address." - "post sweep and pre compact, rebuild the large - free chunk tree from the sortedFreeChunks list." | freeChunk bytes totalBytes | + "first add all the chunks to the tree. This will result in almost address-sorted lists. + We will need to reorder the lists." freeChunk := sortedFreeChunks. totalBytes := 0. [freeChunk ~= 0] whileTrue: [bytes := self bytesInObject: freeChunk. totalBytes := totalBytes + bytes. self addToFreeTree: freeChunk bytes: bytes. freeChunk := self fetchPointer: self freeChunkNextAddressIndex ofObject: freeChunk]. + "now reorder the lists to ensure they're in address order, apart from the list head, which should be highest." + self freeTreeNodesDo: + [:treeNode| | newTreeNode | + newTreeNode := self reorderReversedTreeList: treeNode. + newTreeNode]. ^totalBytes! Item was added: + ----- Method: SpurMemoryManager>>reorderReversedTreeList: (in category 'free space') ----- + reorderReversedTreeList: treeNode + "Once the freeTree has been rebuilt from the sortedFreeChunks list + each list will be in a weird order, the list in reverse order, high to low, + but the tree node, because it is inserted first, will be the lowest address. + Reverse the list so it is sorted low to high, but make the highest address + node the first, as this will be allocated from last." + | first next node prev | + "first becomes the new head, as this is the last one we want to allocate and we allocate from the list first." + first := self fetchPointer: self freeChunkNextIndex ofObject: treeNode. + "no next node, so no change" + first = 0 ifTrue: + [^treeNode]. + node := self fetchPointer: self freeChunkNextIndex ofObject: first. + self storePointer: self freeChunkNextIndex ofFreeChunk: first withValue: treeNode. + self inFreeTreeReplace: treeNode with: first. + prev := 0. + [node ~= 0] whileTrue: + [next := self fetchPointer: self freeChunkNextIndex ofObject: node. + self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev. + prev := node. + node := next]. + self storePointer: self freeChunkNextIndex ofFreeChunk: treeNode withValue: prev. + ^first! Item was changed: ----- Method: SpurMemoryManager>>reverseSmallListHeads (in category 'free space') ----- reverseSmallListHeads + "After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace - "After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace all small free chunks will be on the free lists in reverse address order. Reverse each list, summing the ammount of space. Answer the sum of bytes of free space on these small lists." | total | total := 0. freeListsMask := 0. 1 to: self numFreeLists - 1 do: [:i| | bytes node prev next | bytes := i * self allocationUnit. node := freeLists at: i. node ~= 0 ifTrue: [self assert: (self bytesInObject: node) = bytes. freeListsMask := freeListsMask + (1 << i). prev := 0. [node ~= 0] whileTrue: [next := self fetchPointer: self freeChunkNextIndex ofObject: node. self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev. prev := node. node := next. total := total + bytes]. freeLists at: i put: prev]]. ^total! Item was changed: ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') ----- totalFreeListBytes | totalFreeBytes bytesInChunk listNode | totalFreeBytes := 0. 1 to: self numFreeLists - 1 do: [:i| bytesInChunk := i * self allocationUnit. listNode := freeLists at: i. [listNode ~= 0] whileTrue: [totalFreeBytes := totalFreeBytes + bytesInChunk. self assert: (self isValidFreeObject: listNode). self assert: bytesInChunk = (self bytesInObject: listNode). listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]]. self freeTreeNodesDo: [:treeNode| bytesInChunk := self bytesInObject: treeNode. self assert: bytesInChunk / self allocationUnit >= self numFreeLists. listNode := treeNode. [listNode ~= 0] whileTrue: ["self printFreeChunk: listNode" self assert: (self isValidFreeObject: listNode). totalFreeBytes := totalFreeBytes + bytesInChunk. self assert: bytesInChunk = (self bytesInObject: listNode). + listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]. + treeNode]. - listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]]. ^totalFreeBytes! Item was changed: CogClass subclass: #SpurSegmentManager instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'! + !SpurSegmentManager commentStamp: 'eem 10/21/2013 13:14' prior: 0! - !SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0! Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice. When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory. + On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coalesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment. - On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment. Instance Variables numSegments: <Integer> segments: <Array of SpurSegmentInfo> manager: <SpurMemoryManager> numSegments - the number of segments segments - the start addresses, lengths and offsets to adjust oops on image load, for each segment manager - the SpurMemoryManager whose oldSpace is managed (simulation only).! Item was changed: ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') ----- collapseSegmentsPostSwizzle "The image has been loaded, old segments reconstructed, and the loaded image swizzled into a single contiguous segment. Collapse the segments intio one." | bridge | canSwizzle := false. firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image" [^self]. numSegments := 1. (segments at: 0) segStart: manager newSpaceLimit; segSize: manager endOfMemory - manager newSpaceLimit. + "finally plant a bridge at the end of the coalesced segment and cut back the - "finally plant a bridge at the end of the coallesced segment and cut back the manager's notion of the end of memory to immediately before the bridge." bridge := manager endOfMemory - manager bridgeSize. self assert: bridge = ((segments at: 0) segStart + (segments at: 0) segSize - (manager bridgeSize)). manager initSegmentBridgeWithBytes: manager bridgeSize at: bridge; setEndOfMemory: bridge! Item was changed: ----- Method: TAssignmentNode>>emitCCodeOn:level:generator: (in category 'C code generation') ----- emitCCodeOn: aStream level: level generator: aCodeGen expression isSwitch ifTrue: [^expression emitCCodeOn: aStream addToEndOfCases: self level: level generator: aCodeGen]. expression isLiteralArrayDeclaration ifTrue: [^self emitLiteralArrayDeclarationOn: aStream level: level generator: aCodeGen]. + (expression isSend and: [expression isValueExpansion]) ifTrue: + [^self emitValueExpansionOn: aStream level: level generator: aCodeGen]. variable emitCCodeOn: aStream level: level generator: aCodeGen. self isVariableUpdatingAssignment ifTrue: [aStream space; nextPutAll: expression selector; "+ or -" nextPut: $=; space. expression args first emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen] ifFalse: [aStream space; nextPut: $=; space. expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]! Item was added: + ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') ----- + emitValueExpansionOn: aStream level: level generator: aCodeGen + | stmtList lastStmt copy | + self assert: (expression isSend and: [expression isValueExpansion]). + stmtList := expression receiver. + lastStmt := stmtList statements last. + lastStmt = variable ifTrue: + [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + copy := stmtList copy. + copy statements + at: stmtList statements size + put: (TAssignmentNode new + setVariable: variable + expression: lastStmt). + (TSendNode new + setSelector: expression selector + receiver: copy + arguments: expression args) + emitCCodeOn: aStream level: level generator: aCodeGen.!

1 0

Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.469.mcz
by Frank Shearar 21 Oct '13

21 Oct '13

On 21 Oct 2013, at 8:18, commits(a)source.squeak.org wrote: > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-eem.469.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.469 > Author: eem > Time: 20 October 2013, 5:15:49.893 pm > UUID: 9a1b817f-2cee-487a-8c07-6444e28a16aa > Ancestors: VMMaker.oscog-eem.468 > > Rethink the sorting of free space for exact-fit compact post global > GC. Since the sweep to free unmarked objects is linear through old > space it can also sort free space. So > freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots => > freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (glup ;-) ). > At the risk of being a pain, you need to coalesce the two l's in 'coallesce'. frank > Make sure that bridges are marked so they won't be freed in > fUONUWASACFS. > > Add freeChunkPrevIndex to link next nodes to their precedessors > so that free chunks can be quickly removed during coallescing. > > Implement an iterative freeTreeNodesDo: so that Slang can inline the > block arguments to it. > > Refactor the code that removes a tree node in > allocateOldSpaceChunkOfBytes: et al, out into > unlinkSolitaryFreeTreeNode: > > Still have to reverse small list heads post-sweep and account for free space properly. > > =============== Diff against VMMaker.oscog-eem.468 =============== > > Item was added: > + ----- Method: Spur32BitMemoryManager>>coallesce:and: (in category 'gc - global') ----- > + coallesce: obj1 and: obj2 > + | header1NumSlots header2NumSlots obj2slots newNumSlots | > + header1NumSlots := self rawNumSlotsOf: obj1. > + header2NumSlots := self rawNumSlotsOf: obj2. > + > + "compute total number of slots in obj2, including header" > + obj2slots := header2NumSlots = self numSlotsMask > + ifTrue: [(self longAt: obj2 - self baseHeaderSize) + (2 * self baseHeaderSize / self wordSize)] > + ifFalse: [(header2NumSlots = 0 ifTrue: [1] ifFalse: [header2NumSlots]) + (self baseHeaderSize / self wordSize)]. > + obj2slots := obj2slots + (obj2slots bitAnd: 1). > + self assert: obj2slots * self wordSize = (self bytesInObject: obj2). > + > + "if obj1 already has a double header things are simple..." > + header1NumSlots = self numSlotsMask ifTrue: > + [self longAt: obj1 - self baseHeaderSize put: obj2slots + (self longAt: obj1 - self baseHeaderSize). > + ^obj1]. > + > + "compute total number of slots in obj1, excluding header" > + header1NumSlots := header1NumSlots = 0 > + ifTrue: [2] > + ifFalse: [header1NumSlots + (header1NumSlots bitAnd: 1)]. > + self assert: header1NumSlots * self wordSize + self baseHeaderSize = (self bytesInObject: obj1). > + newNumSlots := obj2slots + header1NumSlots. > + > + "if obj1 still only requires a single header things are simple..." > + newNumSlots < self numSlotsMask ifTrue: > + [self byteAt: obj1 + (self numSlotsFullShift / BitsPerByte) > + put: newNumSlots. > + ^obj1]. > + > + "convert from single to double header..." > + newNumSlots := newNumSlots - (self baseHeaderSize / self wordSize). > + self longAt: obj1 + self baseHeaderSize > + put: (self longAt: obj1); > + longAt: obj1 + 4 + self baseHeaderSize > + put: ((self longAt: obj1 + 4) bitOr: self numSlotsMask << self numSlotsHalfShift). > + self longAt: obj1 > + put: newNumSlots. > + self longAt: obj1 + 4 > + put: self numSlotsMask << self numSlotsHalfShift. > + ^obj1 + self baseHeaderSize! > > Item was changed: > ----- Method: Spur32BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') ----- > initSegmentBridgeWithBytes: numBytes at: address > <var: #numBytes type: #usqLong> > | numSlots | > "must have room for a double header" > self assert: (numBytes \\ self allocationUnit = 0 > and: [numBytes >= (self baseHeaderSize + self baseHeaderSize)]). > self flag: #endianness. > numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. > self longAt: address put: numSlots; > longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; > longAt: address + 8 put: (1 << self pinnedBitShift) > + (self wordIndexableFormat << self formatShift) > + self segmentBridgePun; > + longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift > + + (1 << self markedBitHalfShift)! > - longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift! > > Item was removed: > - ----- Method: Spur32BitMemoryManager>>reInitSegmentBridge: (in category 'segments') ----- > - reInitSegmentBridge: bridgeOop > - "On image write the segment manager replaces the header of the bridge > - with the size of the following segment. This method restores that header." > - <var: #numBytes type: #usqLong> > - self longAt: bridgeOop put: (1 << self pinnedBitShift) > - + (self wordIndexableFormat << self formatShift) > - + self segmentBridgePun; > - longAt: bridgeOop + 4 put: self numSlotsMask << self numSlotsHalfShift! > > Item was added: > + ----- Method: Spur32BitMemoryManager>>sortedFreeObject: (in category 'free space') ----- > + sortedFreeObject: objOop > + "A variant of freeObject: that assumes objOop already has its valid number of slots, etc, > + but makes sure the freeChunkPrevIndex is valid." > + | bytes treeNode nextNode | > + bytes := self bytesInObject: objOop. > + totalFreeOldSpace := totalFreeOldSpace + bytes. > + self longAt: objOop put: 0. > + treeNode := self addToFreeList: objOop bytes: bytes. > + treeNode ~= 0 ifTrue: > + [self storePointer: self freeChunkPrevIndex ofFreeChunk: objOop withValue: treeNode]. > + nextNode := self fetchPointer: self freeChunkNextIndex ofObject: objOop. > + nextNode ~= 0 ifTrue: > + [self storePointer: self freeChunkPrevIndex ofFreeChunk: nextNode withValue: objOop]! > > Item was changed: > ----- Method: Spur64BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') ----- > initSegmentBridgeWithBytes: numBytes at: address > | numSlots | > <var: #numBytes type: #usqLong> > self assert: (numBytes >= (self baseHeaderSize + self baseHeaderSize) > and: [numBytes \\ self allocationUnit = 0]). > numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. > self longAt: address > put: self numSlotsMask << self numSlotsFullShift + numSlots; > longAt: address + self baseHeaderSize > put: (self numSlotsMask << self numSlotsFullShift) > + (1 << self pinnedBitShift) >

3 2

VM Maker: VMMaker.oscog-eem.471.mcz
by commits＠source.squeak.org 21 Oct '13

21 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.471.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.471 Author: eem Time: 21 October 2013, 10:09:42.395 am UUID: 51970cea-207a-46a1-85a3-b1296656e2df Ancestors: VMMaker.oscog-eem.470 Implement rebuilding the free tree after sweep. Refactor addToFreeList:bytes: to extract addToFreeTree:bytes:. Fix reverseSmallListHeads. Use the iterative freeTreeNodesDo: for totalFreeListBytes. Add a containsPinned flag to SpurSegmentInfo and update it in sweep. Also add a preferredPinningSegment to the seg mgr for clustering pinned objects, when we get to it. =============== Diff against VMMaker.oscog-eem.470 =============== Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') ----- addToFreeList: freeChunk bytes: chunkBytes "Add freeChunk to the relevant freeList. For the benefit of sortedFreeObject:, if freeChunk is large, answer the treeNode it is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0." + | index | - | childBytes parent child index | "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk." self assert: (self isFreeObject: freeChunk). self assert: chunkBytes = (self bytesInObject: freeChunk). index := chunkBytes / self allocationUnit. index < self numFreeLists ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index). freeLists at: index put: freeChunk. freeListsMask := freeListsMask bitOr: 1 << index. ^0]. + ^self addToFreeTree: freeChunk bytes: chunkBytes! - self - storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; - storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; - storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; - storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0. - "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. - Beneath the node are smaller and larger blocks." - parent := 0. - child := freeLists at: 0. - [child ~= 0] whileTrue: - [childBytes := self bytesInObject: child. - childBytes = chunkBytes ifTrue: "size match; add to list at node." - [self storePointer: self freeChunkNextIndex - ofFreeChunk: freeChunk - withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); - storePointer: self freeChunkNextIndex - ofFreeChunk: child - withValue: freeChunk. - ^child]. - "walk down the tree" - parent := child. - child := self fetchPointer: (childBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofObject: child]. - parent = 0 ifTrue: - [self assert: (freeLists at: 0) = 0. - freeLists at: 0 put: freeChunk. - freeListsMask := freeListsMask bitOr: 1. - ^0]. - "insert in tree" - self storePointer: self freeChunkParentIndex - ofFreeChunk: freeChunk - withValue: parent. - self storePointer: (childBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofFreeChunk: parent - withValue: freeChunk. - ^0! Item was added: + ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') ----- + addToFreeTree: freeChunk bytes: chunkBytes + "Add freeChunk to the large free chunk tree. + For the benefit of sortedFreeObject:, answer the treeNode it is added + to, if it is added to the next list of a freeTreeNode, otherwise answer 0." + | childBytes parent child | + self assert: chunkBytes = (self bytesInObject: freeChunk). + self assert: chunkBytes / self allocationUnit >= self numFreeLists. + + self + storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0. + "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. + Beneath the node are smaller and larger blocks." + parent := 0. + child := freeLists at: 0. + [child ~= 0] whileTrue: + [childBytes := self bytesInObject: child. + childBytes = chunkBytes ifTrue: "size match; add to list at node." + [self storePointer: self freeChunkNextIndex + ofFreeChunk: freeChunk + withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); + storePointer: self freeChunkNextIndex + ofFreeChunk: child + withValue: freeChunk. + ^child]. + "walk down the tree" + parent := child. + child := self fetchPointer: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofObject: child]. + parent = 0 ifTrue: + [self assert: (freeLists at: 0) = 0. + freeLists at: 0 put: freeChunk. + freeListsMask := freeListsMask bitOr: 1. + ^0]. + "insert in tree" + self storePointer: self freeChunkParentIndex + ofFreeChunk: freeChunk + withValue: parent. + self storePointer: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent + withValue: freeChunk. + ^0! Item was removed: - ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') ----- - bytesInFreeTree: freeNode - | freeBytes bytesInObj listNode | - freeNode = 0 ifTrue: [^0]. - freeBytes := 0. - bytesInObj := self bytesInObject: freeNode. - self assert: bytesInObj / self allocationUnit >= self numFreeLists. - listNode := freeNode. - [listNode ~= 0] whileTrue: - ["self printFreeChunk: listNode" - self assert: (self isValidFreeObject: listNode). - freeBytes := freeBytes + bytesInObj. - self assert: bytesInObj = (self bytesInObject: listNode). - listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]. - ^freeBytes - + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode)) - + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings, coallescing free chunks, and sorting free space. Small free chunks are sorted in address + order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. + Record the highest N objects in highestObjects, for the first cycle of exactFitCompact. + Let the segmentManager mark which segments contain pinned objects via notePinned:" + | lastLargeFree highestObjectsWraps | - order on each small list head. Large free chunks are sorted on the sortedFreeChunks list." - | lastLargeFree | self checkFreeSpace. scavenger forgetUnmarkedRememberedObjects. + segmentManager prepareForGlobalSweep."for notePinned:" - self checkFreeSpace. "for sorting free space throw away the list heads, rebuilding them for small free chunks below." self resetFreeListHeads. + highestObjects + top: freeStart; + start: freeStart; + limit: scavenger eden limit. + highestObjectsWraps := 0. + self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. sortedFreeChunks := lastLargeFree := 0. self allOldSpaceEntitiesForCoallescingDo: [:o| (self isMarked: o) ifTrue: [self setIsMarkedOf: o to: false. ((self isWeakNonImm: o) and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: + [coInterpreter signalFinalization: o]. + (self isPinned: o) ifTrue: + [segmentManager notePinned: o]. + lastLargeFree ~= 0 ifTrue: + [self longAt: highestObjects top put: o. + (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue: + [highestObjects top: highestObjects start. + highestObjectsWraps := highestObjectsWraps + 1]]] - [coInterpreter signalFinalization: o]] ifFalse: "unmarked; two cases, an unreachable object or a free chunk." [| here next | self assert: (self isRemembered: o) not. "scavenger should have cleared this above" here := o. next := self objectAfter: here limit: endOfMemory. (self isMarked: next) ifFalse: "coallescing; rare case" [self assert: (self isRemembered: o) not. [statCoallesces := statCoallesces + 1. here := self coallesce: here and: next. next := self objectAfter: here limit: endOfMemory. next = endOfMemory or: [self isMarked: next]] whileFalse]. (self isLargeFreeObject: here) ifTrue: [lastLargeFree = 0 ifTrue: [sortedFreeChunks := here] ifFalse: [self setFree: here. self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. lastLargeFree := here] ifFalse: [self freeSmallObject: here]]]. lastLargeFree ~= 0 ifTrue: [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. totalFreeOldSpace := self reverseSmallListHeads. totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks. + self checkFreeSpace. + self touch: highestObjectsWraps! - self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. remapBufferCount := extraRootCount := 0. "see below" freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := marking := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0. statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0. statCoallesces := 0. "We can initialize things that are allocated but are lazily initialized." unscannedEphemerons := SpurContiguousObjStack new. + highestObjects := SpurContiguousObjStack new. "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. "N.B. We *don't* initialize extraRoots because we don't simulate it."! Item was added: + ----- Method: SpurMemoryManager>>rebuildFreeTreeFromSortedFreeChunks (in category 'free space') ----- + rebuildFreeTreeFromSortedFreeChunks + "post sweep and pre compact, rebuild the large + free chunk tree from the sortedFreeChunks list." + | freeChunk bytes totalBytes | + freeChunk := sortedFreeChunks. + totalBytes := 0. + [freeChunk ~= 0] whileTrue: + [bytes := self bytesInObject: freeChunk. + totalBytes := totalBytes + bytes. + self addToFreeTree: freeChunk bytes: bytes. + freeChunk := self fetchPointer: self freeChunkNextAddressIndex + ofObject: freeChunk]. + ^totalBytes! Item was removed: - ----- Method: SpurMemoryManager>>resetSmallFreeListHeads (in category 'free space') ----- - resetSmallFreeListHeads - 1 to: self numFreeLists - 1 do: - [:i| freeLists at: i put: 0]! Item was changed: ----- Method: SpurMemoryManager>>reverseSmallListHeads (in category 'free space') ----- reverseSmallListHeads "After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace all small free chunks will be on the free lists in reverse address order. Reverse each list, summing the ammount of space. Answer the sum of bytes of free space on these small lists." | total | total := 0. + freeListsMask := 0. 1 to: self numFreeLists - 1 do: [:i| | bytes node prev next | bytes := i * self allocationUnit. node := freeLists at: i. + node ~= 0 ifTrue: + [self assert: (self bytesInObject: node) = bytes. + freeListsMask := freeListsMask + (1 << i). + prev := 0. + [node ~= 0] whileTrue: + [next := self fetchPointer: self freeChunkNextIndex ofObject: node. + self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev. + prev := node. + node := next. + total := total + bytes]. + freeLists at: i put: prev]]. - prev := 0. - [node ~= 0] whileTrue: - [next := self fetchPointer: self freeChunkNextIndex ofObject: node. - self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev. - prev := node. - node := next. - total := total + bytes]. - freeLists at: i put: node]. ^total! Item was changed: ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') ----- totalFreeListBytes + | totalFreeBytes bytesInChunk listNode | + totalFreeBytes := 0. - | freeBytes bytesInObj obj | - freeBytes := 0. 1 to: self numFreeLists - 1 do: [:i| + bytesInChunk := i * self allocationUnit. + listNode := freeLists at: i. + [listNode ~= 0] whileTrue: + [totalFreeBytes := totalFreeBytes + bytesInChunk. + self assert: (self isValidFreeObject: listNode). + self assert: bytesInChunk = (self bytesInObject: listNode). + listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]]. + + self freeTreeNodesDo: + [:treeNode| + bytesInChunk := self bytesInObject: treeNode. + self assert: bytesInChunk / self allocationUnit >= self numFreeLists. + listNode := treeNode. + [listNode ~= 0] whileTrue: + ["self printFreeChunk: listNode" + self assert: (self isValidFreeObject: listNode). + totalFreeBytes := totalFreeBytes + bytesInChunk. + self assert: bytesInChunk = (self bytesInObject: listNode). + listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]]. + ^totalFreeBytes! - bytesInObj := i * self allocationUnit. - obj := freeLists at: i. - [obj ~= 0] whileTrue: - [freeBytes := freeBytes + bytesInObj. - self assert: (self isValidFreeObject: obj). - self assert: bytesInObj = (self bytesInObject: obj). - obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]]. - ^freeBytes + (self bytesInFreeTree: (freeLists at: 0))! Item was changed: VMStructType subclass: #SpurSegmentInfo + instanceVariableNames: 'segStart segSize swizzle containsPinned' - instanceVariableNames: 'segStart segSize swizzle' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'! Item was added: + ----- Method: SpurSegmentInfo>>containsPinned (in category 'accessing') ----- + containsPinned + "Answer the value of containsPinned" + + ^ containsPinned! Item was added: + ----- Method: SpurSegmentInfo>>containsPinned: (in category 'accessing') ----- + containsPinned: anObject + "Set the value of containsPinned" + + ^containsPinned := anObject! Item was added: + ----- Method: SpurSegmentInfo>>initialize (in category 'initialization') ----- + initialize + segSize := segStart := swizzle := 0. + containsPinned := false! Item was changed: ----- Method: SpurSegmentInfo>>printOn: (in category 'printing') ----- printOn: aStream <doNotGenerate> super printOn: aStream. self class instVarNames do: [:name| | iv | iv := self instVarNamed: name. aStream space; nextPutAll: name; space; print: iv. + (iv isInteger and: [iv ~= 0]) ifTrue: - iv isInteger ifTrue: [aStream nextPut: $/. iv storeOn: aStream base: 16]]! Item was changed: CogClass subclass: #SpurSegmentManager + instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment' - instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'! !SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0! Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice. When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory. On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment. Instance Variables numSegments: <Integer> segments: <Array of SpurSegmentInfo> manager: <SpurMemoryManager> numSegments - the number of segments segments - the start addresses, lengths and offsets to adjust oops on image load, for each segment manager - the SpurMemoryManager whose oldSpace is managed (simulation only).! Item was added: + ----- 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) ifFalse: + [[(segments at: sweepIndex) segStart + (segments at: sweepIndex) segSize < objOop] whileTrue: + [sweepIndex := sweepIndex + 1]. + (segments at: sweepIndex) containsPinned: true]! Item was added: + ----- Method: SpurSegmentManager>>prepareForGlobalSweep (in category 'pinning') ----- + prepareForGlobalSweep + "Let the segmentManager mark which segments contain pinned objects via notePinned:" + sweepIndex := 0. + 0 to: numSegments - 1 do: + [:i| (segments at: i) containsPinned: false]!

1 0

VM Maker: VMMaker.oscog-eem.470.mcz
by commits＠source.squeak.org 21 Oct '13

21 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.470.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.470 Author: eem Time: 20 October 2013, 6:39:45.083 pm UUID: f2c1d9b6-9136-4c2f-872e-7744f8d1b580 Ancestors: VMMaker.oscog-eem.469 Simplify the sorting sweep. Throw away all free lists. Link large chunks through sortedFreeChunks and add small chunks to their free lists, reversing the small lists post sweep. Still have to implement rebuilding the free tree. But free space is sorted. =============== Diff against VMMaker.oscog-eem.469 =============== Item was added: + ----- Method: SpurMemoryManager>>freeSmallObject: (in category 'free space') ----- + freeSmallObject: objOop + | bytes index | + bytes := self bytesInObject: objOop. + index := bytes / self allocationUnit. + self assert: index < self numFreeLists. + self setFree: objOop. + self storePointer: self freeChunkNextIndex ofFreeChunk: objOop withValue: (freeLists at: index). + freeLists at: index put: objOop.! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace + "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings, + coallescing free chunks, and sorting free space. Small free chunks are sorted in address + order on each small list head. Large free chunks are sorted on the sortedFreeChunks list." + | lastLargeFree | self checkFreeSpace. scavenger forgetUnmarkedRememberedObjects. - "for coallescing, specifically detatchLargeFreeObject: below, link large chunks to their tree nodes." - self buildPrevLinksForLargeFreeChunks. self checkFreeSpace. + "for sorting free space throw away the list heads, rebuilding them for small free chunks below." + self resetFreeListHeads. + sortedFreeChunks := lastLargeFree := 0. - "for sorting free space throw away the small list heads, rebuilding them below.". - self resetSmallFreeListHeads. self allOldSpaceEntitiesForCoallescingDo: [:o| (self isMarked: o) ifTrue: [self setIsMarkedOf: o to: false. ((self isWeakNonImm: o) and: [self nilUnmarkedWeaklingSlots: o]) ifTrue: [coInterpreter signalFinalization: o]] ifFalse: "unmarked; two cases, an unreachable object or a free chunk." [| here next | self assert: (self isRemembered: o) not. "scavenger should have cleared this above" here := o. next := self objectAfter: here limit: endOfMemory. + (self isMarked: next) ifFalse: "coallescing; rare case" + [self assert: (self isRemembered: o) not. + [statCoallesces := statCoallesces + 1. + here := self coallesce: here and: next. + next := self objectAfter: here limit: endOfMemory. + next = endOfMemory or: [self isMarked: next]] whileFalse]. + (self isLargeFreeObject: here) + ifTrue: + [lastLargeFree = 0 + ifTrue: [sortedFreeChunks := here] + ifFalse: + [self setFree: here. + self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. + lastLargeFree := here] + ifFalse: + [self freeSmallObject: here]]]. + lastLargeFree ~= 0 ifTrue: + [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. + totalFreeOldSpace := self reverseSmallListHeads. + totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks. - (self isMarked: next) - ifTrue: "common case" - [(self isLargeFreeObject: o) ifFalse: - [self sortedFreeObject: o]] - ifFalse: "coallescing; rare case" - [self assert: (self isRemembered: o) not. - (self isLargeFreeObject: o) ifTrue: - [self detatchLargeFreeObject: o]. - [statCoallesces := statCoallesces + 1. - here := self coallesce: here and: next. - next := self objectAfter: here limit: endOfMemory. - next = endOfMemory or: [self isMarked: next]] whileFalse. - self sortedFreeObject: here]]]. self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>isLargeFreeObject: (in category 'free space') ----- isLargeFreeObject: objOop + ^(self bytesInObject: objOop) / self allocationUnit >= self numFreeLists! - ^(self isFreeObject: objOop) - and: [(self bytesInObject: objOop) / self allocationUnit >= self numFreeLists]! Item was added: + ----- Method: SpurMemoryManager>>resetFreeListHeads (in category 'free space') ----- + resetFreeListHeads + 0 to: self numFreeLists - 1 do: + [:i| freeLists at: i put: 0]! Item was added: + ----- Method: SpurMemoryManager>>reverseSmallListHeads (in category 'free space') ----- + reverseSmallListHeads + "After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace + all small free chunks will be on the free lists in reverse address order. Reverse each list, + summing the ammount of space. Answer the sum of bytes of free space on these small lists." + | total | + total := 0. + 1 to: self numFreeLists - 1 do: + [:i| | bytes node prev next | + bytes := i * self allocationUnit. + node := freeLists at: i. + prev := 0. + [node ~= 0] whileTrue: + [next := self fetchPointer: self freeChunkNextIndex ofObject: node. + self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev. + prev := node. + node := next. + total := total + bytes]. + freeLists at: i put: node]. + ^total! Item was added: + ----- Method: SpurMemoryManager>>setFree: (in category 'free space') ----- + setFree: objOop + "turn the object into a free chunk, zeroing classIndex, format, isGrey,isPinned,isRemembered,isImmutable & ?." + self long32At: objOop put: 0!

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 October 2013