Vm-dev November 2013

vm-dev@lists.squeakfoundation.org

30 participants
103 discussions

VM Maker: VMMaker.oscog-eem.503.mcz
by commits＠source.squeak.org 08 Nov '13

08 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.503.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.503 Author: eem Time: 8 November 2013, 1:33:17.353 pm UUID: 42e2a34e-13cc-4324-8eaa-7a6df5a1fd01 Ancestors: VMMaker.oscog-eem.502 Fix bug in initFreeChunkWithBytes:at: which caused object enumeration to break or objects with 254 slots. Fix bug in freeUnmarkedObjectsAndSortAndCoalesceFreeSpace that forgot to set a freed unmarked object free. Rename bestFitCompact to firstFitCompact (that's what it's doing) and use the same refill-objects approach as exactFitCompact. Relocate firstFreeChunk after each compaction pass. Don't bother breaking out of the loop to return the result in allocateOldSpaceChunkOfBytes:suchThat: et al, & remember to return the found chun in allocateOldSpaceChunkOfBytes:suchThat:. Abandon exactFitCompact as compaction policy for global GC; it doesn't work well in image use (worked well in image bootstrap). Revise marking to correctly initialize stack page tracing and mark the hiidenRootsObj and freeListObj correctly. Remember to mark metaclasses in markAndTraceClassOf:. Add symbolic constants for stack page tracing. Implment comparison for CArray (for testing freeLists). =============== Diff against VMMaker.oscog-eem.502 =============== Item was added: + ----- Method: CArray>>= (in category 'comparing') ----- + = anObject + ^self species = anObject species + and: [(1 to: self class instSize) allSatisfy: + [:i| (self instVarAt: i) = (anObject instVarAt: i)]]! Item was added: + ----- Method: CArray>>hash (in category 'comparing') ----- + hash + ^interpreter hash bitXor: arrayBaseAddress + ptrOffset + unitSize! Item was changed: ----- Method: CoInterpreter>>markAndTraceStackPage: (in category 'object memory support') ----- markAndTraceStackPage: thePage | theSP theFP frameRcvrOffset callerFP oop | <var: #thePage type: #'StackPage *'> <var: #theSP type: #'char *'> <var: #theFP type: #'char *'> <var: #frameRcvrOffset type: #'char *'> <var: #callerFP type: #'char *'> <inline: false> + self assert: (stackPages isFree: thePage) not. + self assert: thePage trace ~= StackPageTraced. + thePage trace: StackPageTraced. + theSP := thePage headSP. theFP := thePage headFP. "Skip the instruction pointer on top of stack of inactive pages." thePage = stackPage ifFalse: [theSP := theSP + BytesPerWord]. [frameRcvrOffset := self frameReceiverOffset: theFP. [theSP <= frameRcvrOffset] whileTrue: [oop := stackPages longAt: theSP. (objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]. theSP := theSP + BytesPerWord]. (self frameHasContext: theFP) ifTrue: [self assert: (objectMemory isContext: (self frameContext: theFP)). objectMemory markAndTrace: (self frameContext: theFP)]. (self isMachineCodeFrame: theFP) ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)] ifFalse: [objectMemory markAndTrace: (self iframeMethod: theFP)]. (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: [theSP := theFP + FoxCallerSavedIP + BytesPerWord. theFP := callerFP]. theSP := theFP + FoxCallerSavedIP + BytesPerWord. "caller ip is ceBaseReturnPC" [theSP <= thePage baseAddress] whileTrue: [oop := stackPages longAt: theSP. (objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]. theSP := theSP + BytesPerWord]! Item was changed: ----- Method: CoInterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') ----- initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage "Initialize the stack pages. In the C VM theStackPages will be alloca'ed memory to hold the stack pages on the C stack. In the simulator they are housed in the memory between the cogMethodZone and the heap." <var: #theStackPages type: #'char *'> <returnTypeC: #void> | numPages page structStackPageSize pageStructBase count | <var: #page type: #'StackPage *'> <var: #pageStructBase type: #'char *'> self cCode: [] inSmalltalk: [self assert: objectMemory startOfMemory - coInterpreter cogCodeSize - coInterpreter methodCacheSize - coInterpreter primTraceLogSize - coInterpreter rumpCStackSize = (stackSlots * BytesPerWord roundUpTo: objectMemory allocationUnit)]. structStackPageSize := coInterpreter sizeof: InterpreterStackPage. bytesPerPage := slotsPerPage * BytesPerWord. numPages := coInterpreter numStkPages. "Because stack pages grow down baseAddress is at the top of a stack page and so to avoid subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply push the stackPage array up one word to avoid the overlap. This word is extraStackBytes." pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord. pages := self cCode: [self cCoerceSimple: pageStructBase to: #'StackPage *'] inSmalltalk: [pageMap := Dictionary new. ((0 to: numPages - 1) collect: [:i| InterpreterStackPage surrogateClass new address: pageStructBase + (i * structStackPageSize) simulator: coInterpreter zoneBase: coInterpreter stackZoneBase zoneLimit: objectMemory startOfMemory]) do: [:pageSurrogate| pageMap at: pageSurrogate address put: pageSurrogate]; yourself]. "make sure there's enough headroom" self assert: coInterpreter stackPageByteSize - coInterpreter stackLimitBytes - coInterpreter stackLimitOffset >= coInterpreter stackPageHeadroom. 0 to: numPages - 1 do: [:index| page := self stackPageAt: index. page lastAddress: theStackPages + (index * bytesPerPage); baseAddress: page lastAddress + bytesPerPage; stackLimit: page baseAddress - coInterpreter stackLimitBytes; realStackLimit: page stackLimit; baseFP: 0; nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1])); prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))]. "Now compute stackBasePlus1 so that the pageIndexFor: call maps all addresses from aPage baseAddress to aBase limitAddress + 1 to the same index (stacks grow down)" stackBasePlus1 := (self cCoerceSimple: theStackPages to: #'char *') + 1. self cCode: [] inSmalltalk: [minStackAddress := theStackPages. maxStackAddress := theStackPages + (numPages * bytesPerPage) + BytesPerWord - 1]. "The overflow limit is the amount of stack to retain when moving frames from an overflowing stack to reduce thrashing. See stackOverflowOrEvent:mayContextSwitch:" page := self stackPageAt: 0. overflowLimit := page baseAddress - page realStackLimit * 3 // 5. 0 to: numPages - 1 do: [:index| page := self stackPageAt: index. self assert: (self pageIndexFor: page baseAddress) == index. self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index. self assert: (self stackPageFor: page baseAddress) == page. self assert: (self stackPageFor: page stackLimit) == page. self cCode: [] inSmalltalk: [| memIndex | memIndex := index * slotsPerPage + 1. "this is memIndex in the block above" self assert: (self memIndexFor: (self oopForPointer: page baseAddress)) == (memIndex + slotsPerPage - 1). index < (numPages - 1) ifTrue: [self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]]. + coInterpreter initializePageTraceToInvalid: page]. - self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"]. mostRecentlyUsedPage := self stackPageAt: 0. page := mostRecentlyUsedPage. count := 0. [| theIndex | count := count + 1. theIndex := self pageIndexFor: page baseAddress. self assert: (self stackPageAt: theIndex) == page. self assert: (self pageIndexFor: page baseAddress) == theIndex. self assert: (self pageIndexFor: page stackLimit) == theIndex. self assert: (self pageIndexFor: page lastAddress + 1) == theIndex. (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue. self assert: count == numPages. self assert: self pageListIsWellFormed! Item was changed: ----- Method: InterpreterStackPage>>printOn: (in category 'printing') ----- printOn: aStream <doNotGenerate> super printOn: aStream. aStream nextPut: $@; print: baseAddress; space. self isFree ifTrue: [aStream nextPutAll: 'free'] + ifFalse: [aStream print: baseFP; nextPutAll: '<->'; print: headFP; space; nextPutAll: 'trace '; print: trace]! - ifFalse: [aStream print: baseFP; nextPutAll: '<->'; print: headFP]! Item was changed: ----- Method: InterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') ----- initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage "Initialize the stack pages. For testing I want stack addresses to be disjoint from normal memory addresses so stack addresses are negative. The first address is -pageSize bytes. So for example if there are 1024 bytes per page and 3 pages then the pages are organized as byte address: -1024 <-> -2047 | -2048 <-> -3071 | -3072 <-> -4096 | page 3 page 2 page 1 mem index: 769 <-> 513 | 512 <-> 257 | 256 <-> 1 | The byte address is the external address corresponding to a real address in the VM. mem index is the index in the memory Array holding the stack, an index internal to the stack pages. The first stack page allocated will be the last page in the array of pages at the highest effective address. Its base address be -1024 and grow down towards -2047." "The lFoo's are to get around the foo->variable scheme in the C call to allocStackPages below." <var: #theStackPages type: #'char *'> | page structStackPageSize pageStructBase count | <var: #page type: #'StackPage *'> <var: #pageStructBase type: #'char *'> self cCode: '' inSmalltalk: [self assert: stackMemory size = stackSlots. self assert: stackMemory == theStackPages]. stackMemory := theStackPages. "For initialization in the C code." self cCode: '' inSmalltalk: [pageSizeInSlots := slotsPerPage]. structStackPageSize := interpreter sizeof: InterpreterStackPage. bytesPerPage := slotsPerPage * BytesPerWord. numPages := stackSlots // (slotsPerPage + (structStackPageSize / BytesPerWord)). "Because stack pages grow down baseAddress is at the top of a stack page and so to avoid subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply push the stackPage array up one word to avoid the overlap. This word is extraStackBytes." pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord. pages := self cCode: '(StackPage *)pageStructBase' inSmalltalk: [pageStructBase class. (1 to: numPages) collect: [:i| InterpreterStackPage new]]. "Simulation only. Since addresses are negative the offset is positive. To make all stack addresses negative we make the offset a page more than it needs to be so the address of the last slot in memory (the highest address in the stack, or its start) is - pageByteSize and the address of the first slot (the lowest address, or its end) is - pageByteSize * (numPages + 1)" self cCode: '' inSmalltalk: [indexOffset := (numPages + 1) * slotsPerPage]. "make sure there's enough headroom" self assert: interpreter stackPageByteSize - interpreter stackLimitBytes - interpreter stackLimitOffset >= interpreter stackPageHeadroom. 0 to: numPages - 1 do: [:index| page := self stackPageAt: index. page lastAddress: (self cCode: '(char *)theStackPages + (index * GIV(bytesPerPage))' inSmalltalk: [(index * slotsPerPage - indexOffset) * BytesPerWord]); baseAddress: (page lastAddress + bytesPerPage); stackLimit: page baseAddress - interpreter stackLimitBytes; realStackLimit: page stackLimit; baseFP: 0; nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1])); prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))]. self cCode: '' inSmalltalk: [| lowestAddress highestAddress | lowestAddress := (pages at: 1) lastAddress + BytesPerWord. highestAddress := (pages at: numPages) baseAddress. "see InterpreterStackPages>>longAt:" self assert: lowestAddress // BytesPerWord + indexOffset = 1. self assert: highestAddress // BytesPerWord + indexOffset = (numPages * slotsPerPage)]. "The overflow limit is the amount of stack to retain when moving frames from an overflowing stack to reduce thrashing. See stackOverflowOrEvent:mayContextSwitch:" page := self stackPageAt: 0. overflowLimit := page baseAddress - page realStackLimit * 3 // 5. 0 to: numPages - 1 do: [:index| page := self stackPageAt: index. self assert: (self pageIndexFor: page baseAddress) == index. self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index. self assert: (self stackPageFor: page baseAddress) == page. self assert: (self stackPageFor: page stackLimit) == page. self cCode: '' inSmalltalk: [| memIndex | memIndex := index * slotsPerPage + 1. "this is memIndex in the block above" self assert: (self memIndexFor: (self oopForPointer: page baseAddress)) == (memIndex + slotsPerPage - 1). index < (numPages - 1) ifTrue: [self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]]. + interpreter initializePageTraceToInvalid: page]. - self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"]. mostRecentlyUsedPage := self stackPageAt: 0. page := mostRecentlyUsedPage. count := 0. [| theIndex | count := count + 1. theIndex := self pageIndexFor: page baseAddress. self assert: (self stackPageAt: theIndex) == page. self assert: (self pageIndexFor: page baseAddress) == theIndex. self assert: (self pageIndexFor: page stackLimit) == theIndex. self assert: (self pageIndexFor: page lastAddress + BytesPerWord) == theIndex. (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue. self assert: count == numPages. self assert: self pageListIsWellFormed! Item was removed: - ----- Method: Spur32BitMMLESimulator>>bestFitCompact (in category 'compaction') ----- - bestFitCompact - coInterpreter transcript nextPutAll: 'compacting...'; flush. - ^super bestFitCompact! Item was added: + ----- Method: Spur32BitMMLESimulator>>exactFitCompact (in category 'compaction') ----- + exactFitCompact + coInterpreter transcript nextPutAll: 'ef compacting...'; flush. + ^super exactFitCompact! Item was added: + ----- Method: Spur32BitMMLESimulator>>firstFitCompact (in category 'compaction') ----- + firstFitCompact + coInterpreter transcript nextPutAll: 'ff compacting...'; flush. + ^super firstFitCompact! Item was changed: ----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') ----- longAt: byteAddress put: a32BitValue "Note: Adjusted for Smalltalk's 1-based array indexing." "(byteAddress = 16r1614CB8 and: [a32BitValue = 16rA000035]) ifTrue: [self halt]." + "(byteAddress between: 16r33FBB8 and: 16r33FBCF) ifTrue: + [self halt]." byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was changed: ----- Method: Spur32BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') ----- initFreeChunkWithBytes: numBytes at: address <var: #numBytes type: #usqLong> | numSlots | "must have room for a header (single or double) plus the next free pointer" self assert: (numBytes \\ self allocationUnit = 0 and: [numBytes >= (self baseHeaderSize + self wordSize)]). self flag: #endianness. "double header" + numBytes >= ((self numSlotsMask << self shiftForWord) + self baseHeaderSize + self baseHeaderSize) ifTrue: - numBytes >= (self numSlotsMask << self shiftForWord) ifTrue: [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. + self assert: numSlots >= self numSlotsMask. self longAt: address put: numSlots; longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. ^address + 8]. "single header" numSlots := numBytes - self baseHeaderSize >> self shiftForWord. + self assert: numSlots < self numSlotsMask. self longAt: address put: 0; "0's classIndex; 0 = classIndex of free chunks" longAt: address + 4 put: numSlots << self numSlotsHalfShift. ^address! Item was changed: ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') ----- initFreeChunkWithBytes: numBytes at: address <var: #numBytes type: #usqLong> | numSlots | "must have room for a header (single or double) plus the next free pointer" self assert: (numBytes \\ self allocationUnit = 0 and: [numBytes >= (self baseHeaderSize + self wordSize)]). "double header" + numBytes >= ((self numSlotsMask << self shiftForWord) + self baseHeaderSize + self baseHeaderSize) ifTrue: - numBytes >= (self numSlotsMask << self shiftForWord) ifTrue: [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. + self assert: numSlots >= self numSlotsMask. self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" ^address + 8]. "single header" numSlots := numBytes - self baseHeaderSize >> self shiftForWord. + self assert: numSlots < self numSlotsMask. self longAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" ^address! Item was added: + ----- Method: SpurCircularBuffer>>usedSize (in category 'accessing') ----- + usedSize + ^last < start + ifTrue: [0] + ifFalse: + [last >= first + ifTrue: [last - first / manager wordSize + 1] + ifFalse: [limit - start - (first - last) / manager wordSize - 1]]! Item was changed: ----- 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 childBytes acceptedChunk acceptedNode | - | 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 << initialIndex)] 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: initialIndex put: next] ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. ^node]. prev := 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]. prev := node. node := next]]]]. "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]. prev := node. node := next]]]]]. "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. + node := acceptedChunk := acceptedNode := 0. - acceptedChunk := acceptedNode := 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." [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: child) ifTrue: + [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. + next = 0 + ifTrue: "no list; remove the interior node" + [self unlinkSolitaryFreeTreeNode: child] + ifFalse: "list; replace node with it" + [self inFreeTreeReplace: child with: next]. + ^self startOfObject: child]]. - (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: + [self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'. + acceptedNode = 0 ifTrue: - [acceptedNode = 0 ifTrue: [acceptedChunk := child. "first search the list." [acceptedChunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk. (acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue: [acceptedNode := child]. acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue. "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: (in category 'free space') ----- allocateOldSpaceChunkOfExactlyBytes: chunkBytes "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." + | index node child | - | index node nodeBytes child | "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" index := chunkBytes / self allocationUnit. index < self numFreeLists ifTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(node := freeLists at: index) ~= 0 ifTrue: [self assert: node = (self startOfObject: node). self assert: (self isValidFreeObject: node). totalFreeOldSpace := totalFreeOldSpace - chunkBytes. ^self unlinkFreeChunk: node atIndex: index]. freeListsMask := freeListsMask - (1 << index)]. ^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 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]. + "nothing acceptable on node's list; answer the node." + self unlinkSolitaryFreeTreeNode: child. + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^self startOfObject: child] - node := child. - nodeBytes := childBytes. - child := 0] "break out of loop to remove interior node" ifFalse: + [child := self fetchPointer: (childBytes < chunkBytes + ifTrue: [self freeChunkLargerIndex] + ifFalse: [self freeChunkSmallerIndex]) + ofFreeChunk: child]]. + ^nil! - [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 ifTrue: - [^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" - self unlinkSolitaryFreeTreeNode: node. - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self startOfObject: node! 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 | <inline: true> "must inline for acceptanceBlock" "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" index := chunkBytes / self allocationUnit. index < self numFreeLists ifTrue: [(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]. totalFreeOldSpace := totalFreeOldSpace - chunkBytes. ^node]. node := next]]]. ^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 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]]. + (acceptanceBlock value: child) ifFalse: + [^nil]. "node was right size but unaceptable." + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. + next = 0 + ifTrue: "no list; remove the interior node" + [self unlinkSolitaryFreeTreeNode: child] + ifFalse: "list; replace node with it" + [self inFreeTreeReplace: child with: next]. + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + ^self startOfObject: child] - node := child. - 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]]. + ^nil! - "if no chunk, there was no exact fit" - (node ~= 0 and: [acceptanceBlock value: node]) ifFalse: - [^nil]. - - "self printFreeChunk: parent" - 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]. - totalFreeOldSpace := totalFreeOldSpace - chunkBytes. - ^self startOfObject: node! Item was removed: - ----- 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." - - <inline: false> - | freePriorToExactFit | - self checkFreeSpace. - freePriorToExactFit := totalFreeOldSpace. - self exactFitCompact. - self checkFreeSpace. - highestObjects isEmpty ifTrue: - [^self]. "either no high objects, or no misfits." - statCompactPassCount := statCompactPassCount + 1. - 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 copyAndForward: o withBytes: b toFreeChunk: f]]. - self checkFreeSpace. - self flag: 'this should perhaps be a loop, recharging highestObjects as per exactFitCompact, but for now we assume the number of misfits not in highestObjects is very small'. - self allOldSpaceObjectsFrom: firstFreeChunk - 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 copyAndForward: o withBytes: b toFreeChunk: f]]]. - self checkFreeSpace. - self touch: freePriorToExactFit! Item was added: + ----- Method: SpurMemoryManager>>compact (in category 'compaction') ----- + compact + "We'd like to use exact fit followed by best fit. But in practice exact fit doesn't move + many objects (it does in artificial contexts such as the image bootstrap, but not in + use of a real system). bestFit is potentially worth-while but takes effort to code. + For now we just use fist-fit." + ^self firstFitCompact! Item was changed: ----- Method: SpurMemoryManager>>copyAndForward:withBytes:toFreeChunk: (in category 'compaction') ----- copyAndForward: objOop withBytes: bytes toFreeChunk: freeChunk + "Copy and forward objOop to freeChunk, the inner operation in compaction." - "Copy and forward objOop to freeChunk, the inner operation in - exact and best fit compact." <inline: true> | startOfObj freeObj | startOfObj := self startOfObject: objOop. self mem: freeChunk asVoidPointer cp: startOfObj asVoidPointer y: bytes. freeObj := freeChunk + (objOop - startOfObj). "leave it to followRememberedForwarders to remember..." "(self isRemembered: objOop) ifTrue: [scavenger remember: freeObj]." self forward: objOop to: freeObj! Item was added: + ----- Method: SpurMemoryManager>>countMarkedAndUnmarkdObjects: (in category 'debug support') ----- + countMarkedAndUnmarkdObjects: printFlags + "print the count of marked and unmarked objects. + In addition if 1 is set in printFlags, short-print marked objects, + and/or if 2 is set, short-print unmarked obejcts." + <api> + | nm nu | + nm := nu := 0. + self allObjectsDo: + [:o| + (self isMarked: o) + ifTrue: + [nm := nm + 1. + (printFlags anyMask: 1) ifTrue: + [coInterpreter shortPrintOop: o]] + ifFalse: + [nu := nu + 1. + (printFlags anyMask: 2) ifTrue: + [coInterpreter shortPrintOop: o]]]. + self print: 'n marked: '; print: nm; cr. + self print: 'n unmarked: '; print: nu; cr! 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 as many of the the highest objects as will fit are + recorded in highestObjects. Don't move pinned objects. - 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 (the misfits), and hence aren't moved, in highestObjects." <inline: false> + | misfits first nfits nmiss nHighest nMisses savedLimit | - | misfits first | <var: #misfits type: #usqInt> + self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. + highestObjects isEmpty ifTrue: + [^self]. + nfits := nmiss := 0. misfits := highestObjects last + self wordSize. [statCompactPassCount := statCompactPassCount + 1. highestObjects from: misfits - self wordSize reverseDo: [:o| | b | + self assert: o > firstFreeChunk. - o < firstFreeChunk ifTrue: - [misfits = (highestObjects last + self wordSize) - ifTrue: [highestObjects resetAsEmpty] - ifFalse: [highestObjects first: misfits]. - ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) ifNil: + [nmiss := nmiss + 1. + misfits := misfits - self wordSize. - [misfits := misfits - self wordSize. misfits < highestObjects start ifTrue: [misfits := highestObjects limit - self wordSize]. self longAt: misfits put: o] ifNotNil: + [:f| + nfits := nfits + 1. + self copyAndForward: o withBytes: b toFreeChunk: f]]]. + self checkFreeSpace. - [:f| self copyAndForward: o withBytes: b toFreeChunk: f]]]. "now highestObjects contains only misfits, if any, from misfits to last. set first to first failure and refill buffer. next cycle will add more misfits. give up on exact-fit when half of the highest objects fail to fit." + first := self longAt: highestObjects first. + self assert: first > firstFreeChunk. + nHighest := highestObjects usedSize. + highestObjects first: misfits. + nMisses := highestObjects usedSize. + nMisses > (nHighest // 2) ifTrue: + [coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. + ^self]. + self findFirstFreeChunkPostCompactionPass. + savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. + self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. + misfits := self moveMisfitsInHighestObjectsBack: savedLimit. + highestObjects usedSize > 0] whileTrue! - first := self longAt: highestObjects first. - first > firstFreeChunk ifTrue: - [| highestObjBytes failureBytes savedLimit | - highestObjBytes := highestObjects limit - highestObjects start. - failureBytes := highestObjects last >= misfits - ifTrue: [highestObjects last - misfits] - ifFalse: [highestObjBytes - (misfits - highestObjects last)]. - failureBytes >= (highestObjBytes // 2) ifTrue: - [highestObjects first: misfits. - ^self]. - savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. - self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. - misfits := self moveMisfitsInHighestObjectsBack: savedLimit]] repeat! Item was added: + ----- Method: SpurMemoryManager>>findFirstFreeChunkAfter: (in category 'compaction') ----- + findFirstFreeChunkAfter: start + self allOldSpaceObjectsFrom: start do: + [:o| + (self isFreeObject: o) ifTrue: + [^o]]. + ^endOfMemory! Item was added: + ----- Method: SpurMemoryManager>>findFirstFreeChunkPostCompactionPass (in category 'compaction') ----- + findFirstFreeChunkPostCompactionPass + (self isFreeObject: firstFreeChunk) ifFalse: + [firstFreeChunk := self findFirstFreeChunkAfter: firstFreeChunk]! Item was added: + ----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') ----- + firstFitCompact + "Compact all of memory above firstFreeChunk using first-fit, assuming free + space is sorted and that as many of the the highest objects as will fit are + recorded in highestObjects. Don't move pinned objects. + Note that we don't actually move; we merely copy and forward. Eliminating + forwarders will be done in a final pass." + + <inline: false> + | first nhits nmisses | + self checkFreeSpace. + totalFreeOldSpace = 0 ifTrue: [^self]. + highestObjects isEmpty ifTrue: + [^self]. + nhits := nmisses := 0. + [statCompactPassCount := statCompactPassCount + 1. + highestObjects reverseDo: + [:o| | b | + o <= firstFreeChunk ifTrue: + [coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr. + ^self]. + ((self isForwarded: o) or: [self isPinned: o]) ifFalse: + [b := self bytesInObject: o. + (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) + ifNil: + [nmisses := nmisses + 1] + ifNotNil: + [:f| + nhits := nhits + 1. + self copyAndForward: o withBytes: b toFreeChunk: f]]]. + self checkFreeSpace. + first := self longAt: highestObjects first. + self assert: first > firstFreeChunk. + self findFirstFreeChunkPostCompactionPass. + self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. + highestObjects usedSize > 0] whileTrue. + + coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr! Item was changed: ----- Method: SpurMemoryManager>>freeListsObj (in category 'free space') ----- freeListsObj + self assert: (self firstIndexableField: (self objectAfter: trueObj)) = freeLists. ^self objectAfter: trueObj! Item was added: + ----- Method: SpurMemoryManager>>freeSpaceCharacterisation (in category 'debug support') ----- + freeSpaceCharacterisation + <doNotGenerate> + | n s | + n := 0. + s := Bag new. + self allFreeObjectsDo: + [:f| n := n + 1. s add: (self bytesInObject: f)]. + ^{ n. s sortedCounts. s sortedElements }! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsAndSortAndCoalesceFreeSpace "Sweep all of old space, freeing unmarked objects, 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> 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". 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. (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]]] 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 setFree: here. 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 assert: self validObjStacks. self markObjects. self nilUnmarkedWeaklingSlots. self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace. + self runLeakCheckerForFullGC: true. + self compact. - self bestFitCompact. self eliminateAndFreeForwarders. self assert: self validObjStacks. self assert: self allObjectsUnmarked. self runLeakCheckerForFullGC: true! Item was changed: ----- Method: SpurMemoryManager>>isEnumerableObject: (in category 'object enumeration') ----- isEnumerableObject: objOop "Answer if objOop should be included in an allObjects...Do: enumeration. Non-objects should be excluded; these are bridges and free chunks." + | classIndex | + <inline: true> + classIndex := self classIndexOf: objOop. + self assert: (classIndex >= 0 and: [classIndex < (numClassTablePages * self classTablePageSize)]). + ^classIndex >= self isForwardedObjectClassIndexPun! - ^(self classIndexOf: objOop) >= self isForwardedObjectClassIndexPun! Item was changed: ----- Method: SpurMemoryManager>>markAccessibleObjects (in category 'gc - global') ----- markAccessibleObjects self assert: self validClassTableRootPages. self assert: segmentManager allBridgesMarked. - marking := true. self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)" inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]]. + + marking := true. + "This must come first to enable stack page reclamation. It clears + the trace flags on stack pages and so must preceed any marking. + Otherwise it will clear the trace flags of reached pages." + coInterpreter initStackPageGC. self markAndTraceHiddenRoots. self assert: self validClassTableRootPages. coInterpreter markAndTraceInterpreterOops: true. - self markAndTrace: self freeListsObj. - self markAndTrace: self specialObjectsOop. self assert: self validObjStacks. self markWeaklingsAndMarkAndFireEphemerons. self assert: self validObjStacks. marking := false! Item was changed: ----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') ----- markAndTraceClassOf: objOop "Ensure the class of the argument is marked, pushing it on the markStack if not already marked. + Also set the relevant bit in the classTableBitmap so that duplicate entries can be eliminated. + Note that this is recursive, but the metaclass chain should terminate quickly." - Also set the relevant bit in the classTableBitmap so that duplicate entries can be eliminated." <inline: false> | classIndex classObj | classIndex := self classIndexOf: objOop. self inClassTableBitmapSet: classIndex. classObj := self classAtIndex: classIndex. (self isMarked: classObj) ifFalse: [self setIsMarkedOf: classObj to: true. + self markAndTraceClassOf: classObj. self push: classObj onObjStack: markStack]! Item was changed: ----- Method: SpurMemoryManager>>markAndTraceHiddenRoots (in category 'gc - global') ----- markAndTraceHiddenRoots "The hidden roots hold both the class table pages and the obj stacks, and hence need special treatment. The obj stacks must be marked specially; their pages must be marked, but only the contents of the ephemeronQueue should be marked. If a class table page is weak we can mark and trace the hiddenRoots, which will not trace throguh class table opages because they are weak. But if class table pages are strong, we must mark the pages and *not* trace them so that only classes reachable from the true roots will be marked, and unreachable classes will be left unmarked." self markAndTraceObjStack: markStack andContents: false. self markAndTraceObjStack: weaklingStack andContents: false. self markAndTraceObjStack: ephemeronQueue andContents: true. + self setIsMarkedOf: self freeListsObj to: true. + (self isWeakNonImm: classTableFirstPage) ifTrue: [^self markAndTrace: hiddenRootsObj]. + self setIsMarkedOf: hiddenRootsObj to: true. self markAndTrace: classTableFirstPage. 1 to: numClassTablePages - 1 do: [:i| self setIsMarkedOf: (self fetchPointer: i ofObject: hiddenRootsObj) to: true]! Item was changed: InterpreterPrimitives subclass: #StackInterpreter instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex' + classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached' - classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable' poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets' category: 'VMMaker-Interpreter'! !StackInterpreter commentStamp: 'eem 9/11/2013 18:30' prior: 0! This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts. It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms. The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the…. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context. In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case. NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future. 1. There are a number of things that should be done the next time we plan to release a completely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item). 2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only. An even better solution is to eliminate compact classes altogether (see 6.). 3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes]. 4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache. 5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT. We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger. 6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images. [Late breaking news, the 2-word header scheme is more compact, by over 2%]. See SpurMemorymanager's class comment.! Item was changed: ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') ----- initializeMiscConstants super initializeMiscConstants. STACKVM := true. GCModeFull := 1. GCModeIncr := 2. GCModeScavenge := 3. GCModeBecome := 4. + StackPageTraceInvalid := -1. + StackPageUnreached := 0. + StackPageReachedButUntraced := 1. + StackPageTraced := 2. + DumpStackOnLowSpace := 0. PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall" MillisecondClockMask := 16r1FFFFFFF. "Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)" MaxExternalPrimitiveTableSize := 4096. "entries" MaxJumpBuf := 32. "max. callback depth" FailImbalancedPrimitives := true! Item was changed: ----- Method: StackInterpreter>>freeUntracedStackPages (in category 'object memory support') ----- freeUntracedStackPages "Free any untraced stack pages." <var: #thePage type: #'StackPage *'> <inline: false> 0 to: numStackPages - 1 do: [:i| | thePage | thePage := stackPages stackPageAt: i. ((stackPages isFree: thePage) not + and: [thePage trace = StackPageUnreached]) ifTrue: - and: [thePage trace = 0]) ifTrue: [self assert: (self noMarkedContextsOnPage: thePage). stackPages freeStackPage: thePage]. + self assert: (thePage trace: StackPageTraceInvalid) ~= 0] "Invalidate the trace state for assertion checks"! - self assert: (thePage trace: -1) ~= 0] "Invalidate the trace state for assertion checks"! Item was changed: ----- Method: StackInterpreter>>initStackPageGC (in category 'object memory support') ----- initStackPageGC "GC of pages. Throwing away all stack pages on full GC is simple but dangerous because it causes us to allocate lots of contexts immediately before a GC. Reclaiming pages whose top context is not referenced is poor because it would take N incrementalGCs to reclaim N unused pages. Only the page whose top context is not referred to by the bottom context of any other page would be reclaimed. Not until the next GC would the page whose top contect is the previously reclaimed page's base frame's bottom context be reclaimed. Better is to not mark stack pages until their contexts are encountered. We can eagerly trace the active page and the page reachable from its bottom context if any, and so on. Other pages can be marked when we encounter a married context." <var: #thePage type: #'StackPage *'> <inline: true> "Need to write back the frame pointers unless all pages are free (as in snapshot)" stackPage ~= 0 ifTrue: [self externalWriteBackHeadFramePointers]. 0 to: numStackPages - 1 do: [:i| | thePage | thePage := stackPages stackPageAt: i. + thePage trace: StackPageUnreached]! - thePage trace: 0]! Item was added: + ----- Method: StackInterpreter>>initializePageTraceToInvalid: (in category 'stack pages') ----- + initializePageTraceToInvalid: aPage + <var: #aPage type: #'StackPage *'> + aPage trace: StackPageTraceInvalid "for assert checking of the page tracing flags"! Item was changed: ----- Method: StackInterpreter>>markAndTraceStackPage: (in category 'object memory support') ----- markAndTraceStackPage: thePage | theSP theFP frameRcvrOffset callerFP oop | <var: #thePage type: #'StackPage *'> <var: #theSP type: #'char *'> <var: #theFP type: #'char *'> <var: #frameRcvrOffset type: #'char *'> <var: #callerFP type: #'char *'> <inline: false> + self assert: (stackPages isFree: thePage) not. + self assert: thePage trace ~= StackPageTraced. + thePage trace: StackPageTraced. + theSP := thePage headSP. theFP := thePage headFP. "Skip the instruction pointer on top of stack of inactive pages." thePage = stackPage ifFalse: [theSP := theSP + BytesPerWord]. [frameRcvrOffset := self frameReceiverOffset: theFP. [theSP <= frameRcvrOffset] whileTrue: [oop := stackPages longAt: theSP. (objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]. theSP := theSP + BytesPerWord]. (self frameHasContext: theFP) ifTrue: [self assert: (objectMemory isContext: (self frameContext: theFP)). objectMemory markAndTrace: (self frameContext: theFP)]. objectMemory markAndTrace: (self iframeMethod: theFP). (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: [theSP := theFP + FoxCallerSavedIP + BytesPerWord. theFP := callerFP]. theSP := theFP + FoxCallerSavedIP. "caller ip is frameCallerContext in a base frame" [theSP <= thePage baseAddress] whileTrue: [oop := stackPages longAt: theSP. (objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]. theSP := theSP + BytesPerWord]! Item was changed: ----- Method: StackInterpreter>>markAndTraceStackPages: (in category 'object memory support') ----- markAndTraceStackPages: fullGCFlag "GC of pages. Throwing away all stack pages on full GC is simple but dangerous because it causes us to allocate lots of contexts immediately before a GC. Reclaiming pages whose top context is not referenced is poor because it would take N incrementalGCs to reclaim N unused pages. Only the page whose top context is not referred to by the bottom context of any other page would be reclaimed. Not until the next GC would the page whose top contect is the previously reclaimed page's base frame's bottom context be reclaimed. Better is to not mark stack pages until their contexts are encountered. We can eagerly trace the active page and the page reachable from its bottom context if any, and so on. Other pages can be marked when we encounter a married context." | thePage context | <var: #thePage type: #'StackPage *'> <inline: false> + objectMemory hasSpurMemoryManagerAPI ifFalse: + [self initStackPageGC]. - self initStackPageGC. "On an incremental GC simply consider all non-free stack pages to be roots." fullGCFlag ifFalse: [0 to: numStackPages - 1 do: [:i| thePage := stackPages stackPageAt: i. (stackPages isFree: thePage) ifFalse: + [self markAndTraceStackPage: thePage]]. - [thePage trace: 2. - self markAndTraceStackPage: thePage]]. ^nil]. "On a full GC only eagerly trace pages referenced from the base of the active page, i.e. on the active stack." stackPage = 0 ifTrue: [^nil]. thePage := stackPage. + [self markAndTraceStackPage: thePage. - [thePage trace: 2. - self markAndTraceStackPage: thePage. context := self frameCallerContext: thePage baseFP. ((objectMemory isContext: context) and: [(self isMarriedOrWidowedContext: context) and: [self isStillMarriedContext: context]]) ifTrue: [thePage := stackPages stackPageFor: (self frameOfMarriedContext: context). self assert: (stackPages isFree: thePage) not]. + thePage trace < StackPageTraced] whileTrue! - thePage trace < 2] whileTrue! Item was changed: ----- Method: StackInterpreter>>markAndTraceUntracedReachableStackPages (in category 'object memory support') ----- markAndTraceUntracedReachableStackPages "Trace any untraced pages" | thePage foundToBeTracedPage | <var: #thePage type: #'StackPage *'> <inline: false> [foundToBeTracedPage := false. 0 to: numStackPages - 1 do: [:i| thePage := stackPages stackPageAt: i. ((stackPages isFree: thePage) not + and: [thePage trace = StackPageReachedButUntraced]) ifTrue: - and: [thePage trace = 1]) ifTrue: [foundToBeTracedPage := true. - thePage trace: 2. self markAndTraceStackPage: thePage]]. foundToBeTracedPage] whileTrue! Item was changed: ----- Method: StackInterpreter>>printFramesOnStackPageListInUse (in category 'debug printing') ----- printFramesOnStackPageListInUse <export: true> | page | <inline: false> <var: #page type: #'StackPage *'> page := stackPages mostRecentlyUsedPage. [(stackPages isFree: page) ifFalse: + [self print: 'page '; printHexnp: page; cr. + self printFramesInPage: page. - [self printFramesInPage: page. self cr]. (page := page prevPage) ~= stackPages mostRecentlyUsedPage] whileTrue! Item was changed: ----- Method: StackInterpreter>>setTraceFlagOnContextsFramesPageIfNeeded: (in category 'object memory support') ----- setTraceFlagOnContextsFramesPageIfNeeded: aContext | thePage | <inline: false> <var: #thePage type: #'StackPage *'> (self isStillMarriedContext: aContext) ifTrue: [thePage := stackPages stackPageFor: (self frameOfMarriedContext: aContext). + self assert: (thePage trace between: StackPageUnreached and: StackPageTraced). + thePage trace = StackPageUnreached ifTrue: + [thePage trace: StackPageReachedButUntraced]]! - self assert: (thePage trace between: 0 and: 2). - thePage trace = 0 ifTrue: - [thePage trace: 1]]! Item was changed: ----- Method: StackInterpreter>>shortPrintFramesOnStackPageListInUse (in category 'debug printing') ----- shortPrintFramesOnStackPageListInUse <export: true> | page | <inline: false> <var: #page type: #'StackPage *'> page := stackPages mostRecentlyUsedPage. [(stackPages isFree: page) ifFalse: + [self print: 'page '; printHexnp: page; cr. + self shortPrintFramesInPage: page. - [self shortPrintFramesInPage: page. self cr]. (page := page prevPage) ~= stackPages mostRecentlyUsedPage] whileTrue!

1 0

Re: [squeak-dev] A Bounty for CMake-ifying stack/Cog vm build process
by Eliot Miranda 07 Nov '13

07 Nov '13

Hi Timothy, On Thu, Nov 7, 2013 at 7:02 AM, gettimothy <gettimothy(a)zoho.com> wrote: > Is there any chance Cog could be made to run on AMD64 natively without 32 > bit libs? > Yes, that's a goal of my current work. Spur has a common object representation between 32- and 64-bits. Getting to a native Stack VM on AMD64 should be straight-forward. Getting to a Cog VM on AMD64 also requires writing a code generator for AMD64. That's actually a fun project. It involves configuring a Bochs plugin for an AMD64/IA32 simulator, and then writing a CogIA64Compiler subclass of CogAbstractInstruction. > If so, I would like to help out with whoever takes up this task. I would > need direction, however as I have been do app development for too many > years and my sys skills are atrophied. > How strong are your low-level skills? You'll need to be quite familiar with machine code, basic machine organization, etc. If you're not then you could instead have a go at getting the Stack VM working in 64-bits, and that would involve getting the 64-bit VM simulator working in VMMaker. It will be great to have another collaborator! > t. > > > > > > ---- On Thu, 07 Nov 2013 06:01:00 -0800 *Bob Arning<arning315(a)comcast.net > <arning315(a)comcast.net>>* wrote ---- > > It's absolutely none of my business what tools others choose to use, but > I will say this: > > Having more of this process in Smalltalk and less in other (arcane) > languages increases the confidence that, should we lose someone's services, > others could step up to fill the gap. > > Cheers, > Bob > > On 11/7/13 8:28 AM, Igor Stasenko wrote: > > Ec7Xf8-DaANjijv1beYiqxBApPntNg(a)mail.gmail.com" type="cite"> > > > > On 7 November 2013 08:58, Tobias Pape <Das.Linux(a)gmx.de> wrote: > > Hey Tim and all, > On 07.11.2013, at 05:00, Ron Teitelbaum <ron(a)usmedrec.com> wrote: > > > Hey Tim, > > > > Göran and Eliot have been discussing this. I just talked to Eliot about > it > > yesterday. He said he was happy to support cmake but didn't want to > have to > > do the work himself. I'm hoping that the work Göran is doing on this now > > can be turned over to Eliot when it is finished. I think there is > agreement > > that combining the excellent work of pharo build with Eliot's new vm > work is > > a very good thing to do. The work to merge the build environments is > > already being done at 3D ICC. We are working on this for the Mac also > but > > have not discussed it with Ian yet. > > > > Ron Teitelbaum > > > >> -----Original Message----- > >> From: squeak-dev-bounces(a)lists.squeakfoundation.org [mailto:squeak-dev- > >> bounces(a)lists.squeakfoundation.org] On Behalf Of tim Rowledge > >> Sent: Wednesday, November 06, 2013 9:04 PM > >> To: The general-purpose Squeak developers list > >> Subject: Re: [squeak-dev] A Bounty for CMake-ifying stack/Cog vm build > > process > >> > >> > >> Wow, no interest? Is it because make is painful or because nobody needs > to > >> make any more money? > > > I actually have interest but I am currently reluctant, > for time-capturing reasons in my personal and work life. > > However, Here is what I would do: > > • Start from Ians CMake work, and try to generalize it for the > non-Linux platforms > • Windows would be kind-of straight-forward, > • For OS X, I would really want to have the Cocoa-based VM stuff > (aka Squeak VM 5.4.7.x) integrated and proper Xcode files > generated, especially to be able to have iOS VMs built automatically. > Here, some information from John McIntosh would be helpfull, especially > a simple walk-through. > I have some experience with that[1] > > > Despite all admiration I have for the way the PharoVM is built, there is > one > thing that bothers me: > • You first somehow generate the VM sources (which is fine, and the > automated way is amazing) > • THEN, the a Script generates CMake-Files > • CMake then generates Makefiles > • and then finally a vm is compiled. > This is one generating step too much, for my taste. > Personally, I'd prefer CMake to just pick up the C-files generated by > VMMaker, > so that adding a new platform does not need to change the VMMaker… > > > The main big issue with 'platform-neutral' static source files, that > they tend to > grow with tons of #ifdef-s over time, reducing readability and creating > a mess. > > My point is that one or another way you have to deal with platform > differences, > and the way how i prefer to do it is using smalltalk code, > but not .m4 files, or .cmake files, or writing a medium novel long > configuration files > using strange (better to say weird) scripting DSL. > I can express all build process logic in smalltalk, which does not > lessens the amount > of work to deal with all platform nuances and dependencies etc, but at > least it allows me to organize and shape it > into some manageable form, which is easy to change & learn. > > And another difference is, that i prefer working with browser & classes > than > with dozens of directories and files lying here and there. > > But sure thing, it is a question of taste. If you prefer to maintain > this: > ------------------------- > MACRO (INTERNAL_PLUGIN plugin) > SET (plugin_sources "") > IF (DEFINED ${plugin}_sources) > SET (plugin_sources ${${plugin}_sources}) > ELSE (DEFINED ${plugin}_sources) > FOREACH (dir ${src}/vm/intplugins ${cross}/plugins ${unix}/plugins) > SET (tmp "") > AUX_SOURCE_DIRECTORY (${dir}/${plugin} tmp) > STRING_APPEND (plugin_sources "${tmp}") > ENDFOREACH (dir) > ENDIF (DEFINED ${plugin}_sources) > IF (DEFINED ${plugin}_extra_sources) > STRING_APPEND (plugin_sources "${${plugin}_extra_sources}") > ENDIF (DEFINED ${plugin}_extra_sources) > FILE (WRITE ${bld}/${plugin}/CMakeLists.in "") > FOREACH (dir ${unix}/plugins ${unix}) > FILE_APPEND (${bld}/${plugin}/CMakeLists.in > ${dir}/${plugin}/build.cmake) > ENDFOREACH (dir) > FILE_APPEND (${bld}/${plugin}/CMakeLists.in > ${config}/PluginInternal.cmake) > CONFIGURE_FILE (${bld}/${plugin}/CMakeLists.in > ${bld}/${plugin}/CMakeLists.txt @ONLY) > ADD_SUBDIRECTORY (${bld}/${plugin} ${bld}/${plugin}) > ENDMACRO (INTERNAL_PLUGIN) > -------------------------- > And/or this: > -------------------------- > AC_INIT([config.h.in]) > > SVNREV=`grep '\$Rev: ' > ${srcdir}/../../../platforms/Cross/vm/sqSCCSVersion.h \ > | sed 's/.*$Rev: $[[0-9]][[0-9]]*$.*/\1/'` > AC_VM_VERSION(4,0,${SVNREV},4,2,0) > > topdir=`cd ${srcdir}/../../..; pwd` > cfgdir=`cd ${srcdir}; pwd` > > AC_ARG_WITH(src, > [ --with-src=dir generated src directory [default=src]], > [ vmmsrc="${with_src}"], > [ vmmsrc="src"]) > > vmmdir="${topdir}/${vmmsrc}" > > if test ! -d "${topdir}/${vmmsrc}"; then > if test -d "${topdir}/platforms/unix/${vmmsrc}"; then > vmmdir="${topdir}/platforms/unix/${vmmsrc}" > AC_MSG_RESULT([using built-in src directory]) > fi > fi > > AC_MSG_RESULT(${vmmdir}) > > blddir=`pwd` > > AC_ARG_WITH(vmmcfg, > [ --with-vmmcfg=dir vm configuration directory containing > plugins.int and plugins.ext [default=.]], > [ vmmcfg="${with-vmmcfg}"], > [ vmmcfg="${blddir}"]) > > # Compiling a Cogit VM or not? If so, need a cogit$o, cointerp, etc. > > AC_ARG_ENABLE(cogit, > [ --enable-cogit compile a cogit VM [default=yes]], > cogit="no", cogit="yes") > AC_SUBST(cogit) > > #AC_ARG_ENABLE(jit, > #[ --enable-jit enable J4 support [default=no]], > #JIT="yes", JIT="no") > # > #test $JIT = "yes" && J_CFLAGS="-DJ_ENABLED" > #AC_SUBST(J_CFLAGS) > > # Check the generated src dir looks sane > > AC_CHECK_VMM_DIR > > AC_SUBST(topdir) > AC_SUBST(cfgdir) > AC_SUBST(vmmdir) > AC_SUBST(vmmcfg) > AC_SUBST(blddir) > > SQ_VERSION=${SQ_MAJOR}.${SQ_MINOR}-${SQ_UPDATE} > > AC_DEFINE_UNQUOTED(SQ_VERSION, "${SQ_VERSION}") > > AC_SUBST(SQ_MAJOR) > AC_SUBST(SQ_MINOR) > AC_SUBST(SQ_UPDATE) > AC_SUBST(SQ_VERSION) > > VM_VERSION=${VM_MAJOR}.${VM_MINOR}-${VM_RELEASE} > > AC_DEFINE_UNQUOTED(VM_VERSION, "${VM_VERSION}") > > AC_SUBST(VM_MAJOR) > AC_SUBST(VM_MINOR) > AC_SUBST(VM_RELEASE) > AC_SUBST(VM_VERSION) > > # libdir contains ${exec_prefix}, so we have to default and expand early > test "x$prefix" = xNONE && prefix=$ac_default_prefix > test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' > imgdir=`eval echo ${libdir}/squeak` > expanded_relative_imgdir=`eval echo lib/squeak/${VM_VERSION}` > plgdir='${imgdir}/'`eval echo ${VM_VERSION}` > > AC_SUBST(imgdir) > AC_SUBST(expanded_relative_imgdir) > AC_SUBST(plgdir) > > AC_DEFINE(OS_TYPE, "unix") > > AC_CANONICAL_HOST > > host_cpu=`echo $host | sed 's,-.*,,'` > host=`echo $host | sed 's,-unknown,,'` > > AC_SUBST(host) > AC_SUBST(host_cpu) > AC_SUBST(host_vendor) > AC_SUBST(host_os) > ---------------------------- > > instead of plain smalltalk code, it is up to you. > > But that's about 'too much' for my taste. > > > > But if the community is positive to just move to the Pharo way of > building VMs, I'd be fine with that, since that would unify a lot > of infrastructure :) > > Best > -Tobias > > [1] https://github.com/krono/self/blob/cmake/vm/cmake/mac_osx.cmake > > > > > > > > > > > -- > Best regards, > Igor Stasenko. > > > > > > > > > -- best, Eliot

1 0

VM Maker: VMMaker.oscog-eem.502.mcz
by commits＠source.squeak.org 07 Nov '13

07 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.502.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.502 Author: eem Time: 7 November 2013, 9:58:16.167 am UUID: 7071af43-79fc-4d30-855c-89cd6dc77fd5 Ancestors: VMMaker.oscog-eem.501 Handle the class table pages correctly re marking. If class table pages are strong they should be marked, not marked and traced, in order to mark only reachable classes. Make sure the simulator and the stack VM agree on heap size on launch for Spur. =============== Diff against VMMaker.oscog-eem.501 =============== Item was changed: ----- Method: SpurMemoryManager>>markAccessibleObjects (in category 'gc - global') ----- markAccessibleObjects self assert: self validClassTableRootPages. self assert: segmentManager allBridgesMarked. marking := true. self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)" inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]]. + self markAndTraceHiddenRoots. - self markAndTraceObjStacks. self assert: self validClassTableRootPages. coInterpreter markAndTraceInterpreterOops: true. self markAndTrace: self freeListsObj. - self markAndTrace: hiddenRootsObj. self markAndTrace: self specialObjectsOop. self assert: self validObjStacks. self markWeaklingsAndMarkAndFireEphemerons. self assert: self validObjStacks. marking := false! Item was added: + ----- Method: SpurMemoryManager>>markAndTraceHiddenRoots (in category 'gc - global') ----- + markAndTraceHiddenRoots + "The hidden roots hold both the class table pages and the obj stacks, + and hence need special treatment. + The obj stacks must be marked specially; their pages must be marked, + but only the contents of the ephemeronQueue should be marked. + If a class table page is weak we can mark and trace the hiddenRoots, + which will not trace throguh class table opages because they are weak. + But if class table pages are strong, we must mark the pages and *not* + trace them so that only classes reachable from the true roots will be + marked, and unreachable classes will be left unmarked." + + self markAndTraceObjStack: markStack andContents: false. + self markAndTraceObjStack: weaklingStack andContents: false. + self markAndTraceObjStack: ephemeronQueue andContents: true. + + (self isWeakNonImm: classTableFirstPage) ifTrue: + [^self markAndTrace: hiddenRootsObj]. + + self markAndTrace: classTableFirstPage. + 1 to: numClassTablePages - 1 do: + [:i| self setIsMarkedOf: (self fetchPointer: i ofObject: hiddenRootsObj) + to: true]! Item was removed: - ----- Method: SpurMemoryManager>>markAndTraceObjStacks (in category 'obj stacks') ----- - markAndTraceObjStacks - self markAndTraceObjStack: markStack andContents: false. - self markAndTraceObjStack: weaklingStack andContents: false. - self markAndTraceObjStack: ephemeronQueue andContents: true! Item was changed: ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory." "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command." "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!" | swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes headerFlags hdrMaxExtSemTabSize firstSegSize | <var: #f type: #sqImageFile> <var: #dataSize type: #'size_t'> <var: #heapBase type: #usqInt> <var: #desiredHeapSize type: #usqInt> <var: #headerStart type: #squeakFileOffsetType> <var: #imageOffset type: #squeakFileOffsetType> metaclassNumSlots := 6. "guess Metaclass instSize" classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position" headerSize := self getLongFromFile: f swap: swapBytes. dataSize := self getLongFromFile: f swap: swapBytes. oldBaseAddr := self getLongFromFile: f swap: swapBytes. objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes). objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used." savedWindowSize := self getLongFromFile: f swap: swapBytes. headerFlags := self getLongFromFile: f swap: swapBytes. self setImageHeaderFlagsFrom: headerFlags. extraVMMemory := self getLongFromFile: f swap: swapBytes. hdrNumStackPages := self getShortFromFile: f swap: swapBytes. "4 stack pages is small. Should be able to run with as few as three. 4 should be comfortable but slow. 8 is a reasonable default. Can be changed via vmParameterAt: 43 put: n. Can be set as a preference (Info.plist, VM.ini, command line etc). If desiredNumStackPages is already non-zero then it has been set as a preference. Ignore (but preserve) the header's default." numStackPages := desiredNumStackPages ~= 0 ifTrue: [desiredNumStackPages] ifFalse: [hdrNumStackPages = 0 ifTrue: [self defaultNumStackPages] ifFalse: [hdrNumStackPages]]. desiredNumStackPages := hdrNumStackPages. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. It is used for the cog code size in Cog. Preserve it to be polite to other VMs." theUnknownShort := self getShortFromFile: f swap: swapBytes. hdrEdenBytes := self getLongFromFile: f swap: swapBytes. objectMemory edenBytes: (desiredEdenBytes ~= 0 ifTrue: [desiredEdenBytes] ifFalse: [hdrEdenBytes = 0 ifTrue: [objectMemory defaultEdenBytes] ifFalse: [hdrEdenBytes]]). desiredEdenBytes := hdrEdenBytes. hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes. hdrMaxExtSemTabSize ~= 0 ifTrue: [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. firstSegSize := self getLongFromFile: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "decrease Squeak object heap to leave extra memory for the VM" + heapSize := desiredHeapSize + + objectMemory newSpaceBytes + + self interpreterAllocationReserveBytes. + heapSize := self reserveExtraCHeap: heapSize Bytes: extraVMMemory. - heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'. "compare memory requirements with availability". minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes. heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]. "allocate a contiguous block of memory for the Squeak heap" objectMemory memory: (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger. objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError]. heapBase := objectMemory memory. objectMemory setHeapBase: heapBase memoryLimit: (heapBase + heapSize) - 24 "decrease memoryLimit a tad for safety" endOfMemory: heapBase + dataSize. "position file after the header" self sqImageFile: f Seek: headerStart + headerSize. "read in the image in bulk, then swap the bytes if necessary" bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" ^dataSize! Item was changed: ----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') ----- openOn: fileName extraMemory: extraBytes "StackInterpreterSimulator new openOn: 'clone.im' extraMemory: 100000" | f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes + headerFlags heapBase firstSegSize heapSize + hdrNumStackPages hdrEdenBytes hdrMaxExtSemTabSize | - hdrNumStackPages hdrEdenBytes headerFlags heapBase firstSegSize hdrMaxExtSemTabSize | "open image file and read the header" ["begin ensure block..." f := FileStream readOnlyFileNamed: fileName. imageName := f fullName. f binary. version := self nextLongFrom: f. "current version: 16r1968 (=6504) vive la revolucion!!" (self readableFormat: version) ifTrue: [swapBytes := false] ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion ifTrue: [swapBytes := true] ifFalse: [self error: 'incomaptible image format']]. headerSize := self getLongFromFile: f swap: swapBytes. dataSize := self getLongFromFile: f swap: swapBytes. "length of heap in file" oldBaseAddr := self getLongFromFile: f swap: swapBytes. "object memory base address of image" objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes). objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "Should be loaded from, and saved to the image header" savedWindowSize := self getLongFromFile: f swap: swapBytes. headerFlags := self getLongFromFile: f swap: swapBytes. self setImageHeaderFlagsFrom: headerFlags. extraVMMemory := self getLongFromFile: f swap: swapBytes. hdrNumStackPages := self getShortFromFile: f swap: swapBytes. "4 stack pages is small. Should be able to run with as few as three. 4 should be comfortable but slow. 8 is a reasonable default. Can be changed via vmParameterAt: 43 put: n" numStackPages := desiredNumStackPages ~= 0 ifTrue: [desiredNumStackPages] ifFalse: [hdrNumStackPages = 0 ifTrue: [self defaultNumStackPages] ifFalse: [hdrNumStackPages]]. desiredNumStackPages := hdrNumStackPages. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. It is used for the cog code size in Cog. Preserve it to be polite to other VMs." theUnknownShort := self getShortFromFile: f swap: swapBytes. self assert: f position = 40. hdrEdenBytes := self getLongFromFile: f swap: swapBytes. objectMemory edenBytes: (hdrEdenBytes = 0 ifTrue: [objectMemory defaultEdenBytes] ifFalse: [hdrEdenBytes]). desiredEdenBytes := hdrEdenBytes. hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes. hdrMaxExtSemTabSize ~= 0 ifTrue: [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. self assert: f position = 48. firstSegSize := self getLongFromFile: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "allocate interpreter memory" heapBase := objectMemory startOfMemory. + heapSize := dataSize + + extraBytes + + objectMemory newSpaceBytes + + self interpreterAllocationReserveBytes + + (objectMemory hasSpurMemoryManagerAPI + ifTrue: [headerSize] + ifFalse: [0]). objectMemory setHeapBase: heapBase + memoryLimit: heapBase + heapSize + endOfMemory: heapBase + dataSize. "bogus for Spur" - memoryLimit: heapBase + dataSize + extraBytes + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes - endOfMemory: heapBase + dataSize. objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4). "read in the image in bulk, then swap the bytes if necessary" f position: headerSize. count := objectMemory readHeapFromImageFile: f dataBytes: dataSize. count ~= dataSize ifTrue: [self halt]. ] ensure: [f close]. self ensureImageFormatIsUpToDate: swapBytes. bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. "adjust pointers for zero base address" Utilities informUser: 'Relocating object pointers...' during: [self initializeInterpreter: bytesToShift]. !

1 0

VM Maker: VMMaker.oscog-eem.501.mcz
by commits＠source.squeak.org 07 Nov '13

07 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.501.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.501 Author: eem Time: 6 November 2013, 4:43:51.368 pm UUID: b9cdef67-871c-409e-8dd8-75c807a82d67 Ancestors: VMMaker.oscog-eem.500 Refactor (pop)storeLiteralVariable in the StackInterpreter so that all such bytecodes use storeLiteralVariable:withValue:. Put breakpoints in the simulator's pushLiteralVariable: & storeLiteralVariable:withValue: to catch forwarded objects. This for debugging restarting prims that have failed because of forwarded args. Use ^self in the clients (and in itemporary:in:put:) now that Slang can cope. Spur: Revise (and refactor) markAndTrace: so that - pure bits objects are not pushed on the stack - classes of objects are traced - checking for immediates, pure bits and weakness is done in markAndShouldScan: - class processing uses the classTableBitmap to expunge duplicate entries. Remove the bogus postCompactScanClassTable call from globalGarbageCollect. Add followForwardingPointersInScheduler and use it post-become. Refactor the all*Object*Do: methods to use isEnumerableObject:. Change the classIsItselfPun so that such objects answer true to isEnumerableObject:. Make sure that allocateSlots:format:classIndex: is inlined and that allocateSlotsInOldSpace:bytes:format:classIndex: and eliminateAndFreeForwarders are not. Provide class side utilities to show the class puns and the formats in order. Add the missing longPrintReferencesTo:. Fix printOopShortInner: for simulation. Mimic the free space determination in sqMacMain.c in the simulator's openOn:. [N.B. this fails to mimic because of bugs in or around readImageFormatFromFile:StartingAt:. Slang: Fix generation of asserts within struct classes in shouldExcludeReceiverAsFirstArgument:. =============== Diff against VMMaker.oscog-eem.500 =============== Item was changed: ----- Method: CoInterpreter>>extendedStoreBytecode (in category 'stack bytecodes') ----- extendedStoreBytecode "Override to use itemporary:in:put:" + | descriptor variableType variableIndex | - | descriptor variableType variableIndex association | <inline: true> descriptor := self fetchByte. self fetchNextBytecode. variableType := descriptor >> 6 bitAnd: 3. variableIndex := descriptor bitAnd: 63. variableType = 0 ifTrue: [^objectMemory storePointer: variableIndex ofObject: self receiver withValue: self internalStackTop]. variableType = 1 ifTrue: [^self itemporary: variableIndex in: localFP put: self internalStackTop]. variableType = 3 ifTrue: + [^self storeLiteralVariable: variableIndex withValue: self internalStackTop]. + self error: 'illegal store'! - [association := self literal: variableIndex. - ^objectMemory storePointer: ValueIndex ofObject: association withValue: self internalStackTop]. - self error: 'illegal store'. - ^nil! Item was changed: ----- Method: CoInterpreter>>itemporary:in:put: (in category 'internal interpreter access') ----- itemporary: offset in: theFP put: valueOop "Temporary access for an interpreter frame only." "See StackInterpreter class>>initializeFrameIndices" | frameNumArgs | <inline: true> <var: #theFP type: #'char *'> + offset < (frameNumArgs := self iframeNumArgs: theFP) - ^offset < (frameNumArgs := self iframeNumArgs: theFP) ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop] ifFalse: [stackPages longAt: theFP + FoxIFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]! Item was changed: ----- Method: CogVMSimulator>>openOn: (in category 'initialization') ----- openOn: fileName + "(CogVMSimulator new openOn: 'clonex.image') test" + objectMemory hasSpurMemoryManagerAPI ifTrue: + [| fileSize potSize | + fileSize := (FileDirectory directoryEntryFor: fileName) fileSize. + potSize := 1 << (fileSize - 1) highBit. + ^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize]. - "(InterpreterSimulator new openOn: 'clonex.image') test" self openOn: fileName extraMemory: 2500000.! Item was added: + ----- Method: Spur32BitMMLESimulator>>markAndTrace: (in category 'gc - global') ----- + markAndTrace: objOop + "objOop = 16rB26020 ifTrue: [self halt]. + objOop = 16rB25FD8 ifTrue: [self halt]. + objOop = 16rB26010 ifTrue: [self halt]." + ^super markAndTrace: objOop! Item was changed: ----- Method: Spur32BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') ----- setIsMarkedOf: objOop to: aBoolean + "objOop = 16rB26020 ifTrue: [self halt]." super setIsMarkedOf: objOop to: aBoolean. "(aBoolean and: [(self isContextNonImm: objOop) and: [(coInterpreter checkIsStillMarriedContext: objOop currentFP: coInterpreter framePointer) and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue: [self halt]"! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex + <inline: true> | numBytes newObj | "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), 16 bytes otherwise (num slots in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." numSlots >= self numSlotsMask ifTrue: [newObj := freeStart + self baseHeaderSize. numBytes := self baseHeaderSize + self baseHeaderSize "double header" + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots <= 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" freeStart + numBytes > scavengeThreshold ifTrue: [needGCFlag ifFalse: [self scheduleScavenge]. freeStart + numBytes > scavenger eden limit ifTrue: [^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. self assert: numBytes \\ self allocationUnit = 0. self assert: newObj \\ self allocationUnit = 0. freeStart := freeStart + numBytes. ^newObj! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header will have been filled-in but not the contents." + <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes. self checkFreeSpace. chunk ifNil: [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: chunk put: numSlots. self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). ^chunk + self baseHeaderSize]. self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). ^chunk! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex + <inline: true> | numBytes newObj | "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), 16 bytes otherwise (num slots in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." numSlots >= self numSlotsMask ifTrue: [numSlots > 16rffffffff ifTrue: [^nil]. newObj := freeStart + self baseHeaderSize. numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" + (numSlots * self bytesPerSlot)] ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots < 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots * self bytesPerSlot])]. freeStart + numBytes > scavengeThreshold ifTrue: [needGCFlag ifFalse: [self scheduleScavenge]. freeStart + numBytes > scavenger eden limit ifTrue: [^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. self assert: numBytes \\ self allocationUnit = 0. self assert: newObj \\ self allocationUnit = 0. freeStart := freeStart + numBytes. ^newObj! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header will have been filled-in but not the contents." + <inline: false> | chunk | chunk := self allocateOldSpaceChunkOfBytes: totalBytes. chunk ifNil: [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self longAt: chunk put: numSlots + (self numSlotsMask << self numSlotsFullShift). self longAt: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). ^chunk + self baseHeaderSize]. self longAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). ^chunk! Item was added: + ----- Method: SpurMemoryManager class>>classIndicesMap (in category 'accessing') ----- + classIndicesMap + "self classIndicesMap" + | map | + map := Dictionary new. + self selectorsAndMethodsDo: + [:s :m| | mn | + (('*classindex*' match: s) or: ['*bridge*'match: s]) + and: [mn := m methodNode block. + (mn statements size = 1 + and: [mn statements first expr isConstantNumber]) ifTrue: + [map at: mn statements first expr key put: s]]]. + ^map keys sort collect: + [:n| + { n. map at: n }]! Item was added: + ----- Method: SpurMemoryManager class>>objectFormatsMap (in category 'accessing') ----- + objectFormatsMap + "self objectFormatsMap" + | map | + map := Dictionary new. + self selectorsAndMethodsDo: + [:s :m| | mn | + ('*format*' match: s) + and: [mn := m methodNode block. + (mn statements size = 1 + and: [mn statements first expr isConstantNumber]) ifTrue: + [map at: mn statements first expr key put: s]]]. + ^map keys sort collect: + [:n| + { n. map at: n }]! Item was changed: ----- Method: SpurMemoryManager>>allExistingNewSpaceObjectsDo: (in category 'object enumeration') ----- allExistingNewSpaceObjectsDo: aBlock <inline: true> | prevObj prevPrevObj objOop limit | prevPrevObj := prevObj := nil. "After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace." objOop := self objectStartingAt: scavenger eden start. limit := freeStart. [objOop < limit] whileTrue: + [(self isEnumerableObject: objOop) ifTrue: - [(self isFreeObject: objOop) ifFalse: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: freeStart]. objOop := self objectStartingAt: scavenger pastSpace start. limit := pastSpaceStart. [objOop < limit] whileTrue: [(self isFreeObject: objOop) ifFalse: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: limit]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>allExistingOldSpaceObjectsDo: (in category 'object enumeration') ----- allExistingOldSpaceObjectsDo: aBlock "Enumerate all old space objects, excluding any objects created during the execution of allExistingOldSpaceObjectsDo:." <inline: true> | oldSpaceLimit prevObj prevPrevObj objOop | prevPrevObj := prevObj := nil. objOop := self firstObject. oldSpaceLimit := freeOldSpaceStart. [self assert: objOop \\ self allocationUnit = 0. objOop < oldSpaceLimit] whileTrue: + [(self isEnumerableObject: objOop) ifTrue: - [(self isFreeObject: objOop) ifFalse: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: freeOldSpaceStart]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>allNewSpaceObjectsDo: (in category 'object enumeration') ----- allNewSpaceObjectsDo: aBlock "Enumerate all new space objects, excluding any objects created during the execution of allNewSpaceObjectsDo:." <inline: true> | prevObj prevPrevObj objOop limit | prevPrevObj := prevObj := nil. "After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace." objOop := self objectStartingAt: scavenger eden start. [objOop < freeStart] whileTrue: + [(self isEnumerableObject: objOop) ifTrue: - [(self isFreeObject: objOop) ifFalse: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: freeStart]. objOop := self objectStartingAt: scavenger pastSpace start. limit := pastSpaceStart. [objOop < limit] whileTrue: + [(self isEnumerableObject: objOop) ifTrue: - [(self isFreeObject: objOop) ifFalse: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: limit]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>allOldSpaceObjectsFrom:do: (in category 'object enumeration') ----- allOldSpaceObjectsFrom: initialObject do: aBlock + "Enumerate all objects (i.e. exclude bridges, forwarders and free chunks) + in oldSpace starting at initialObject." <inline: true> | prevObj prevPrevObj objOop | prevPrevObj := prevObj := nil. objOop := initialObject. [self assert: objOop \\ self allocationUnit = 0. objOop < freeOldSpaceStart] whileTrue: + [(self isEnumerableObject: objOop) ifTrue: - [(self isFreeObject: objOop) ifFalse: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: freeOldSpaceStart]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>classIsItselfClassIndexPun (in category 'class table puns') ----- classIsItselfClassIndexPun + "Class puns are class indices not used by any class. There is an entry + for the pun that refers to the notional class of objects with this class + index. But because the index doesn't match the class it won't show up + in allInstances, hence hiding the object with a pun as its class index. + The puns occupy indices 16 through 31." + ^31! - ^4! Item was changed: ----- 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 | + <inline: false> self assert: (self isForwarded: nilObj) not. self assert: (self isForwarded: falseObj) not. self assert: (self isForwarded: trueObj) not. self assert: (self isForwarded: hiddenRootsObj) not. (self isForwarded: specialObjectsOop) ifTrue: [specialObjectsOop := self followForwarded: specialObjectsOop]. self followForwardedObjStacks. scavenger followRememberedForwardersAndForgetFreeObjects. self doScavenge: DontTenureButDoUnmark. lowestForwarded := 0. "sweep, following forwarders in all live objects, and finding the first forwarder." 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. "sweep from lowest forwarder, coalescing runs of forwarders." 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]]. firstForwarded ~= 0 ifTrue: [| start bytes | start := self startOfObject: firstForwarded. bytes := (self addressAfter: lastForwarded) - start. self addFreeChunkWithBytes: bytes at: start].! Item was changed: ----- Method: SpurMemoryManager>>forwardSurvivor:to: (in category 'become implementation') ----- forwardSurvivor: obj1 to: obj2 self assert: (self isInNewSpace: obj1). + self assert: ((self isInFutureSpace: obj2) or: [self isInOldSpace: obj2]). - self assert: ((self isInFutureSpace: obj2) or: (self isInOldSpace: obj2)). self storePointerUnchecked: 0 ofObject: obj1 withValue: obj2. self setFormatOf: obj1 to: self forwardedFormat. self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect self runLeakCheckerForFullGC: true. self assert: self validObjStacks. self markObjects. self nilUnmarkedWeaklingSlots. self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace. self bestFitCompact. - self postCompactScanClassTable. self eliminateAndFreeForwarders. self assert: self validObjStacks. self assert: self allObjectsUnmarked. self runLeakCheckerForFullGC: true! Item was added: + ----- Method: SpurMemoryManager>>isEnumerableObject: (in category 'object enumeration') ----- + isEnumerableObject: objOop + "Answer if objOop should be included in an allObjects...Do: enumeration. + Non-objects should be excluded; these are bridges and free chunks." + ^(self classIndexOf: objOop) >= self isForwardedObjectClassIndexPun! Item was added: + ----- Method: SpurMemoryManager>>isPureBitsFormat: (in category 'header formats') ----- + isPureBitsFormat: format + ^format >= self sixtyFourBitIndexableFormat + and: [format < self firstCompiledMethodFormat]! Item was added: + ----- Method: SpurMemoryManager>>longPrintReferencesTo: (in category 'debug printing') ----- + longPrintReferencesTo: anOop + "Scan the heap long printing the oops of any and all objects that refer to anOop" + | prntObj | + <api> + prntObj := false. + self allObjectsDo: + [:obj| | i | + ((self isPointersNonImm: obj) or: [self isCompiledMethod: obj]) ifTrue: + [(self isCompiledMethod: obj) + ifTrue: + [i := (coInterpreter literalCountOf: obj) + LiteralStart] + ifFalse: + [(self isContextNonImm: obj) + ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)] + ifFalse: [i := self numSlotsOf: obj]]. + [(i := i - 1) >= 0] whileTrue: + [anOop = (self fetchPointer: i ofObject: obj) ifTrue: + [coInterpreter printHex: obj; print: ' @ '; printNum: i; cr. + prntObj := true. + i := 0]]. + prntObj ifTrue: + [prntObj := false. + coInterpreter longPrintOop: obj]]]! Item was added: + ----- Method: SpurMemoryManager>>markAndShouldScan: (in category 'gc - global') ----- + markAndShouldScan: objOop + "Mark the argument, and answer if its fields should be scanned now. + Immediate objects don't need to be marked. + Already marked objects have already been processed. + Pure bits objects don't need scanning, although their class does. + Weak objects should be pushed on the weakling stack. + Anything else need scanning." + | format | + (self isImmediate: objOop) ifTrue: + [^false]. + self assert: (self isForwarded: objOop) not. + (self isMarked: objOop) ifTrue: + [^false]. + self setIsMarkedOf: objOop to: true. + format := self formatOf: objOop. + (self isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack" + [self markAndTraceClassOf: objOop. + ^false]. + format = self weakArrayFormat ifTrue: "push weaklings on the weakling stack to scan later" + [self push: objOop onObjStack: weaklingStack. + ^false]. + ^true! Item was changed: ----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') ----- markAndTrace: objOop "Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack. Follow forwarding pointers in the scan." + | objToScan numStrongSlots index field | + (self markAndShouldScan: objOop) ifFalse: + [^self]. - | objToScan index field | - self assert: (self isNonImmediate: objOop). "if markAndTrace: is to follow and eliminate forwarding pointers in its scan it cannot be handed an r-value which is forwarded." self assert: (self isForwarded: objOop) not. - (self isMarked: objOop) ifTrue: - [^self]. - "self setIsMarkedOf: objOop to: false" "for debugging" - self setIsMarkedOf: objOop to: true. "Now scan the object, and any remaining objects on the mark stack." objToScan := objOop. "To avoid overflowing the mark stack when we encounter large objects, we push the obj, then its numStrongSlots, and then index the object from the stack." + [((self isImmediate: objToScan) + or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. - [| numStrongSlots | - ((self isImmediate: objToScan) - or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. numStrongSlots > self traceImmediatelySlotLimit]) ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any." [(self isImmediate: objToScan) ifTrue: [index := self integerValueOf: objToScan. objToScan := self topOfObjStack: markStack] ifFalse: + [index := numStrongSlots. + self markAndTraceClassOf: objToScan]. - [index := numStrongSlots]. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. (self isOopForwarded: field) ifTrue: [field := self followForwarded: field. self storePointerUnchecked: index ofObject: objToScan withValue: field]. + (self markAndShouldScan: field) ifTrue: + [index > 0 ifTrue: + [(self topOfObjStack: markStack) ~= objToScan ifTrue: + [self push: objToScan onObjStack: markStack]. + self push: (self integerObjectOf: index) onObjStack: markStack]. + objToScan := field. + index := -1]]. - ((self isImmediate: field) - or: [self isMarked: field]) ifFalse: - [self setIsMarkedOf: field to: true. - (self isWeakNonImm: field) - ifTrue: [self push: field onObjStack: weaklingStack] - ifFalse: - [index > 0 ifTrue: - [(self topOfObjStack: markStack) ~= objToScan ifTrue: - [self push: objToScan onObjStack: markStack]. - self push: (self integerObjectOf: index) onObjStack: markStack. - objToScan := field. - index := -1]]]]. index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack." [objToScan := self popObjStack: markStack. objToScan = objOop ifTrue: [objToScan := self popObjStack: markStack]]] ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack." [index := numStrongSlots. + self markAndTraceClassOf: objToScan. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. (self isOopForwarded: field) ifTrue: [field := self followForwarded: field. self storePointerUnchecked: index ofObject: objToScan withValue: field]. + (self markAndShouldScan: field) ifTrue: + [self push: field onObjStack: markStack. + numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. + numStrongSlots > self traceImmediatelySlotLimit ifTrue: + [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]. - ((self isImmediate: field) - or: [self isMarked: field]) ifFalse: - [self setIsMarkedOf: field to: true. - (self isWeakNonImm: field) - ifTrue: [self push: field onObjStack: weaklingStack] - ifFalse: - [self push: field onObjStack: markStack. - numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. - numStrongSlots > self traceImmediatelySlotLimit ifTrue: - [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]]. objToScan := self popObjStack: markStack]. objToScan notNil] whileTrue! Item was added: + ----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') ----- + markAndTraceClassOf: objOop + "Ensure the class of the argument is marked, pushing it on the markStack if not already marked. + Also set the relevant bit in the classTableBitmap so that duplicate entries can be eliminated." + <inline: false> + | classIndex classObj | + classIndex := self classIndexOf: objOop. + self inClassTableBitmapSet: classIndex. + classObj := self classAtIndex: classIndex. + (self isMarked: classObj) ifFalse: + [self setIsMarkedOf: classObj to: true. + self push: classObj onObjStack: markStack]! Item was changed: ----- Method: SpurMemoryManager>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') ----- markAndTraceWeaklingsFrom: startIndex "Mark weaklings on the weaklingStack, ignoring startIndex number of elements on the bottom of the stack. Answer the size of the stack *before* the enumeration began." ^self objStack: weaklingStack from: startIndex do: [:weakling| + self markAndTraceClassOf: weakling. 0 to: (self numStrongSlotsOf: weakling ephemeronInactiveIf: nil) - 1 do: [:i| | field | field := self fetchPointer: i ofObject: weakling. ((self isImmediate: field) or: [self isMarked: field]) ifFalse: [self markAndTrace: field]]]! Item was changed: ----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') ----- markObjects "Mark all accessible objects." "If the incremental collector is running mark bits may be set; stop it and clear them if necessary." self ensureAllMarkBitsAreZero. + self ensureAdequateClassTableBitmap. self initializeUnscannedEphemerons. self initializeMarkStack. self initializeWeaklingStack. + self markAccessibleObjects. + self expungeDuplicateClasses! - self markAccessibleObjects! Item was changed: ----- Method: SpurMemoryManager>>printReferencesTo: (in category 'debug printing') ----- printReferencesTo: anOop "Scan the heap printing the oops of any and all objects that refer to anOop" <api> self allObjectsDo: [:obj| | i | i := self numPointerSlotsOf: obj. [(i := i - 1) >= 0] whileTrue: + [anOop = (self fetchPointer: i ofMaybeForwardedObject: obj) ifTrue: - [anOop = (self fetchPointer: i ofObject: obj) ifTrue: [coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr. i := 0]]]! 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 | - | byte2 byte3 opType top lit | 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: + [^self storeLiteralVariable: byte3 withValue: top]. - [lit := self literal: byte3. - objectMemory storePointer: ValueIndex ofObject: lit withValue: top. - ^self]. "opType = 5 is store; opType = 6 = storePop" opType = 6 ifTrue: [self internalPop: 1]. + self storeMaybeContextReceiverVariable: byte3 withValue: top! - ^self storeMaybeContextReceiverVariable: byte3 withValue: top! Item was changed: ----- Method: StackInterpreter>>extStoreLiteralVariableBytecode (in category 'stack bytecodes') ----- extStoreLiteralVariableBytecode "233 11101001 i i i i i i i i Store Literal Variable #iiiiiiii (+ Extend A * 256)" + | variableIndex | - | association variableIndex | variableIndex := self fetchByte + (extA << 8). self fetchNextBytecode. extA := 0. + self storeLiteralVariable: variableIndex withValue: self internalStackTop! - association := self literal: variableIndex. - objectMemory storePointer: ValueIndex ofObject: association withValue: self internalStackTop! Item was changed: ----- Method: StackInterpreter>>extendedStoreBytecode (in category 'stack bytecodes') ----- extendedStoreBytecode + | descriptor variableType variableIndex | - | descriptor variableType variableIndex association | <inline: true> descriptor := self fetchByte. self fetchNextBytecode. variableType := descriptor >> 6 bitAnd: 3. variableIndex := descriptor bitAnd: 63. variableType = 0 ifTrue: [^objectMemory storePointer: variableIndex ofObject: self receiver withValue: self internalStackTop]. variableType = 1 ifTrue: [^self temporary: variableIndex in: localFP put: self internalStackTop]. variableType = 3 ifTrue: + [^self storeLiteralVariable: variableIndex withValue: self internalStackTop]. + self error: 'illegal store'! - [association := self literal: variableIndex. - ^objectMemory storePointer: ValueIndex ofObject: association withValue: self internalStackTop]. - self error: 'illegal store'. - ^nil! Item was added: + ----- Method: StackInterpreter>>followField:in: (in category 'lazy become') ----- + followField: fieldIndex in: anObject + "Make sure the oop at fieldIndex in anObject is not forwarded (follow the + forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex." + | field | + field := objectMemory fetchPointer: fieldIndex ofObject: anObject. + (objectMemory isForwarded: field) ifTrue: + [field := objectMemory followForwarded: field. + objectMemory storePointer: fieldIndex ofObject: anObject withValue: field]. + ^field! Item was added: + ----- Method: StackInterpreter>>followForwardingPointersInScheduler (in category 'object memory support') ----- + followForwardingPointersInScheduler + | schedAssoc sched procLists | + schedAssoc := objectMemory splObj: SchedulerAssociation. + "the GC follows pointers in the special objects array for us." + self assert: (objectMemory isForwarded: schedAssoc) not. + + sched := self followField: ValueIndex in: schedAssoc. + + procLists := self followField: ProcessListsIndex in: sched. + + 0 to: (objectMemory numSlotsOf: procLists) - 1 do: + [:i| | list first last next | + list := self followField: i in: procLists. + first := self followField: FirstLinkIndex in: list. + last := self followField: LastLinkIndex in: list. + [first ~= last] whileTrue: + [next := self followField: NextLinkIndex in: first. + first := next]] + ! Item was changed: ----- Method: StackInterpreter>>methodClassOf: (in category 'compiled methods') ----- methodClassOf: methodPointer ^self cppIf: NewspeakVM ifTrue: + [| literal | + literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer. + self assert: (objectMemory isForwarded: literal) not. + literal = objectMemory nilObject - [ | literal | - literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer. - literal = objectMemory nilObject ifTrue: [literal] ifFalse: [objectMemory fetchPointer: ValueIndex ofObject: literal]] ifFalse: + [| literal | + literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer. + self assert: (objectMemory isForwarded: literal) not. + objectMemory fetchPointer: ValueIndex ofObject: literal]! - [objectMemory fetchPointer: ValueIndex ofObject: (self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer)]! Item was changed: ----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') ----- postBecomeAction: theBecomeEffectsFlags theBecomeEffectsFlags ~= 0 ifTrue: + [self followForwardingPointersInStackZone: theBecomeEffectsFlags. + self followForwardingPointersInScheduler]! - [self followForwardingPointersInStackZone: theBecomeEffectsFlags]! Item was changed: ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') ----- printOopShortInner: oop | classOop name nameLen | <var: #name type: #'char *'> <inline: true> (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: [self printChar: $$; printChar: (objectMemory characterValueOf: oop); printChar: $(; printHex: (objectMemory integerValueOf: oop); printChar: $). ^nil]. self printNum: (objectMemory integerValueOf: oop); printChar: $(; printHex: (objectMemory integerValueOf: oop); printChar: $). ^nil]. (objectMemory addressCouldBeObj: oop) ifFalse: [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [' is not on the heap']); cr. ^nil]. (self isFloatObject: oop) ifTrue: [self printFloat: (self dbgFloatValueOf: oop). ^nil]. classOop := objectMemory fetchClassOfNonImm: oop. (objectMemory addressCouldBeObj: classOop) ifFalse: [self print: 'a ??'. ^nil]. (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue: [self printNameOfClass: oop count: 5. ^nil]. oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil]. oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil]. oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil]. nameLen := self lengthOfNameOfClass: classOop. nameLen = 0 ifTrue: [self print: 'a ??'. ^nil]. name := self nameOfClass: classOop. nameLen = 10 ifTrue: [(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue: [self printChar: $'; printStringOf: oop; printChar: $'. ^nil]. (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue: [self printChar: $#; printStringOf: oop. ^nil]]. (nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue: [self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)). ^nil]. self print: 'a(n) '. + self + cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]] + inSmalltalk: + [name isString + ifTrue: [self print: name] + ifFalse: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]]. - 0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]. "Try to spot association-like things; they're all subclasses of LookupKey" ((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1) and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation))) and: [objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue: [self space; printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop); print: ' -> '; printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]! Item was changed: ----- Method: StackInterpreter>>pushLiteralVariable: (in category 'stack bytecodes') ----- pushLiteralVariable: literalIndex + objectMemory hasSpurMemoryManagerAPI + ifTrue: + [| litVar | + "push/store/popLiteralVariable all fetch a literal, and either read or write the literal's value field. + The fetch of the literal needs an explicit check (otherwise we would have to scan all literals in + all methods in the stack zone, and the entire method on return, and global variables are relatively + rare; in my work image 8.7% of literals are globals)." + litVar := self literal: literalIndex. + (objectMemory isForwarded: litVar) ifTrue: + [litVar := objectMemory followForwarded: litVar]. + self internalPush: + (objectMemory fetchPointer: ValueIndex ofObject: litVar)] + ifFalse: + [self internalPush: + (objectMemory fetchPointer: ValueIndex ofObject: (self literal: literalIndex))]! - - self internalPush: - (objectMemory fetchPointer: ValueIndex ofObject: (self literal: literalIndex)).! Item was added: + ----- Method: StackInterpreter>>storeLiteralVariable:withValue: (in category 'stack bytecodes') ----- + storeLiteralVariable: literalIndex withValue: anObject + | litVar | + litVar := self literal: literalIndex. + "push/store/popLiteralVariable all fetch a literal, and either read or write the literal's value field. + The fetch of the literal needs an explicit check (otherwise we would have to scan all literals in + all methods in the stack zone, and the entire method on return, and global variables are relatively + rare; in my work image 8.7% of literals are globals)." + + (objectMemory isForwarded: litVar) ifTrue: + [litVar := objectMemory followForwarded: litVar]. + objectMemory storePointer: ValueIndex ofObject: litVar withValue: anObject! Item was added: + ----- Method: StackInterpreterSimulator>>literal: (in category 'compiled methods') ----- + literal: offset + "trap pushes of forwarded literals to help debug following forwarded primitive args. + it is not an error to push a forwarded literal, but we'd like to step through any resulting + primtive failure code" + | lit | + lit := super literal: offset. + (objectMemory isOopForwarded: lit) ifTrue: + [self halt: 'forwarded literal in ', thisContext selector]. + ^lit! Item was changed: ----- Method: StackInterpreterSimulator>>openOn: (in category 'initialization') ----- openOn: fileName + "(StackInterpreterSimulator new openOn: 'clonex.image') test" + objectMemory hasSpurMemoryManagerAPI ifTrue: + [| fileSize potSize | + fileSize := (FileDirectory directoryEntryFor: fileName) fileSize. + potSize := 1 << (fileSize - 1) highBit. + ^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize]. - "(InterpreterSimulator new openOn: 'clonex.image') test" - self openOn: fileName extraMemory: 2500000.! 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 | + (aCodeGen isAssertSelector: selector) ifTrue: + [^true]. + (receiver isSend and: [receiver receiver isVariable and: [(self isSelfReference: receiver receiver in: aCodeGen) or: [self isStructReference: receiver receiver in: aCodeGen]]]) ifTrue: [^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector]. ^receiver isVariable and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name) or: [(self isSelfReference: receiver in: aCodeGen) and: [(m := aCodeGen methodNamed: selector) isNil or: [m typeForSelf == #implicit]]]]!

1 0

Presentation as FOSDEM?
by Stephan Eggermont 07 Nov '13

07 Nov '13

Spur developments would make an excellent subject for the FOSDEM smalltalk devroom. Would anyone be willing to present something there? Or would that be too early? https://fosdem.org/2014/news/2013-10-02-accepted-devrooms/ Cheers, Stephan Eggermont

2 1

Suspect code in LittleEndianBitmap
by Nicolas Cellier 07 Nov '13

07 Nov '13

In recent COG, I see: LittleEndianBitmap>>byteAt: byteAddress put: byte "Insert a byte into a Bitmap (little-endian version). N.B. Signedness will be lost since byteAt: answers non-negative values. We can add a signedByteAt: if needed." | value longWord shift lowBits longAddr | (byte < 0 or:[byte > 255]) ifTrue:[^self errorImproperStore]. value := byte < 0 ifTrue: [byte < 128 ifTrue: [self errorImproperStore]. It looks suspect to me, wouldn't the intention be ifTrue: [byte < -128 ifTrue: [self errorImproperStore].

6 15

Frequent SegFaults in PharoVM with Pharo 3.0
by Max Leske 06 Nov '13

06 Nov '13

Hi We’ve been encountering frequent SegFaults when running the Fuel tests on the Pharo CI (https://ci.inria.fr/pharo-contribution/job/Fuel/). Since today I’ve also been able to reproduce the SegFaults on my MacBook Pro (OS X 10.9) too. We have not been able to determine the cause of the SegFault but we can produce SegFaults often, although not reliable (more reliable on the CI). The CI uses the stable VM: http://files.pharo.org/vm/pharo/linux/stable.zip I use a newer version from October on my machine: http://files.pharo.org/vm/pharo/mac/273.zip I’ve attached all the dumps of the crashes I was able to produce on my machine, together with Apple’s crash logs. I’ve been able to deduce the following: - garbage collection seems to be a trigger for the SegFault. When one of the methods FLMethodContextSerialization>>testFuelShouldIgnoreFuel and FLMethodContextSerialization>>testMethodContextWithNilPc contain the line “3 timesRepeat: [Smalltalk garbageCollect]” the SegFault appears nearly always (on CI). When I remove the line the builds run through. - Not all methods with the garbage collect line trigger a SegFault (I could only identify those two) - the garbage collect line itself suffices as a trigger in the mentioned methods. - The number of tests (amount of used memory?) seems to influence the appearence of the SegFault (e.g. loading "DevelopmentGroup" seems to trigger it more often than loading “Benchmarks”) - the SegFault always appears after the tests with the garbage collect line have been run, never before - the VM can’t write the crash.dmp every time Since the SegFaults are so random I cannot give you an image to reproduce the problem. I’ve had the best results using a fresh 3.0 image (http://files.pharo.org/image/30/30549.zip) and then evaluating the following in a workspace: Gofer it smalltalkhubUser: 'Pharo' project: 'Fuel'; package: 'ConfigurationOfFuel'; load. ((Smalltalk at: #ConfigurationOfFuel) project version: #bleedingEdge) load: 'DevelopmentGroup'. HDTestReport runClasses: (TestCase allSubclasses select: [ :class | class name beginsWith: 'FL']) named: ‘foo' If it doesn’t work, try using the TestRunner manually. Select the default Fuel tests (alphabetically at F) and the additional Fuel tests (at the bottom of the list) and run them. If anybody has any clue about what could be going on I’d really appreciate any input. I’ll happily provide more information if I can. Thanks for reading :) Max

2 1

VM Maker: VMMaker.oscog-eem.500.mcz
by commits＠source.squeak.org 06 Nov '13

06 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.500.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.500 Author: eem Time: 5 November 2013, 4:00:30.969 pm UUID: 72bc8825-af12-430c-96ad-be11ea0330a2 Ancestors: VMMaker.oscog-eem.499 Fix fetchPointer:ofObject: assert for forwarders and free objs, followForwardedObjectFields:toDepth: for CompiledMethods, and forwardSurvivor:to: for tenured objs. Remember to invoke the method that scans the class table post compact. Fix bug in markAndTrace: with objs indexed from mark stack (could get caught in an infinite loop). Fix several bugs in SpurCircularBuffer. Fix bug in exactFitCompact. Fix BalloonEngineSImulation by ensuring that workBuffer is initialized with 0s not nils. Global GC appears functional. =============== Diff against VMMaker.oscog-eem.499 =============== Item was changed: ----- Method: BalloonEngineSimulation>>workBufferPut: (in category 'simulation') ----- workBufferPut: wbOop interpreterProxy isInterpreterProxy ifTrue:[^super workBufferPut: wbOop]. workBuffer := ((interpreterProxy firstIndexableField: wbOop) as: BalloonArray) asCArrayAccessor. workBufferArray ifNil: + [workBufferArray := Array new: (interpreterProxy slotSizeOf: wbOop) withAll: 0]. - [workBufferArray := Array new: (interpreterProxy slotSizeOf: wbOop)]. workBuffer getObject setSimArray: workBufferArray! Item was changed: ----- Method: Spur32BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. + self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs"]]). - self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was changed: ----- Method: Spur32BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') ----- setIsMarkedOf: objOop to: aBoolean super setIsMarkedOf: objOop to: aBoolean. + "(aBoolean - (aBoolean and: [(self isContextNonImm: objOop) and: [(coInterpreter checkIsStillMarriedContext: objOop currentFP: coInterpreter framePointer) and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue: + [self halt]"! - [self halt]! Item was changed: ----- Method: SpurCircularBuffer>>addLast: (in category 'accessing') ----- addLast: element | newLast | newLast := last + manager wordSize. + newLast >= limit ifTrue: - newLast > limit ifTrue: [newLast := start]. (newLast = first and: [last >= start]) ifTrue: "wrapped; bump first" [(first := newLast + manager wordSize) >= limit ifTrue: [first := start]]. last := newLast. + self assert: (first >= start and: [first < limit]). + self assert: (last >= start and: [last < limit]). manager longAt: newLast put: element! Item was changed: ----- Method: SpurCircularBuffer>>from:reverseDo: (in category 'enumerating') ----- from: initialPtr reverseDo: aBlock <inline: true> | ptr | last >= start ifTrue: [ptr := initialPtr. + first <= last + ifTrue: "enum in first to last range, last to first" + [ptr >= first ifTrue: + [[aBlock value: (manager longAt: ptr). + (ptr := ptr - manager wordSize) < first ifTrue: + [^nil]] repeat]] + ifFalse: "enum in start to last range, last to start" + [ptr <= last ifTrue: + [[ptr >= start] whileTrue: + [aBlock value: (manager longAt: ptr). + ptr := ptr - manager wordSize]. + ptr := limit]. + "now enum in first to limit range, limit to first" + [ptr >= first] whileTrue: + [aBlock value: (manager longAt: ptr). + ptr := ptr - manager wordSize]]]. - [aBlock value: (manager longAt: ptr). - ptr = first ifTrue: [^nil]. - (ptr := ptr - manager wordSize) < start ifTrue: - [ptr := limit]] repeat]. ^nil! Item was added: + ----- Method: SpurCircularBuffer>>printOn: (in category 'printing') ----- + printOn: aStream + <doNotGenerate> + super printOn: aStream. + first ifNotNil: + [aStream nextPutAll: ' first: '; nextPutAll: first hex]. + last ifNotNil: + [aStream nextPutAll: ' last: '; nextPutAll: last hex]! Item was changed: ----- Method: SpurCircularBuffer>>reverseDo: (in category 'enumerating') ----- reverseDo: aBlock | ptr | last >= start ifTrue: [ptr := last. + [self assert: (first <= last + ifTrue: [first <= ptr and: [ptr <= last]] + ifFalse: [(start <= ptr and: [ptr <= last]) or: [first <= ptr and: [ptr < limit]]]). + aBlock value: (manager longAt: ptr). - [aBlock value: (manager longAt: ptr). ptr = first ifTrue: [^nil]. (ptr := ptr - manager wordSize) < start ifTrue: [ptr := limit]] repeat]. ^nil! 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 (the misfits), and hence aren't moved, in highestObjects." - forwarders will be done in a final pass. - Leave the objects that don't fit exactly, and hence aren't moved, in highestObjects." <inline: false> | misfits first | <var: #misfits type: #usqInt> totalFreeOldSpace = 0 ifTrue: [^self]. misfits := highestObjects last + self wordSize. [statCompactPassCount := statCompactPassCount + 1. highestObjects from: misfits - self wordSize reverseDo: [:o| | b | o < firstFreeChunk ifTrue: [misfits = (highestObjects last + self wordSize) ifTrue: [highestObjects resetAsEmpty] ifFalse: [highestObjects first: misfits]. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) ifNil: [misfits := misfits - self wordSize. misfits < highestObjects start ifTrue: + [misfits := highestObjects limit - self wordSize]. - [misfits := highestObjects limit]. self longAt: misfits put: o] ifNotNil: [:f| self copyAndForward: o withBytes: b toFreeChunk: f]]]. "now highestObjects contains only misfits, if any, from misfits to last. set first to first failure and refill buffer. next cycle will add more misfits. 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 >= misfits ifTrue: [highestObjects last - misfits] ifFalse: [highestObjBytes - (misfits - highestObjects last)]. failureBytes >= (highestObjBytes // 2) ifTrue: [highestObjects first: misfits. ^self]. savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. misfits := self moveMisfitsInHighestObjectsBack: savedLimit]] repeat! Item was changed: ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'become api') ----- followForwardedObjectFields: objOop toDepth: depth "follow pointers in the object to depth. How to avoid cyclic structures?? A temproary mark bit?" | oop | + self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]). - self assert: (self isPointers: objOop). 0 to: (self numSlotsOf: objOop) - 1 do: [:i| oop := self fetchPointer: i ofObject: objOop. ((self isNonImmediate: oop) and: [self isForwarded: oop]) ifTrue: [oop := self followForwarded: oop. self storePointer: i ofObject: objOop withValue: oop]. depth > 0 ifTrue: [self followForwardedObjectFields: objOop toDepth: depth - 1]]! Item was changed: ----- Method: SpurMemoryManager>>forwardSurvivor:to: (in category 'become implementation') ----- forwardSurvivor: obj1 to: obj2 self assert: (self isInNewSpace: obj1). + self assert: ((self isInFutureSpace: obj2) or: (self isInOldSpace: obj2)). - self assert: (self isInFutureSpace: obj2). self storePointerUnchecked: 0 ofObject: obj1 withValue: obj2. self setFormatOf: obj1 to: self forwardedFormat. self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect self runLeakCheckerForFullGC: true. self assert: self validObjStacks. self markObjects. self nilUnmarkedWeaklingSlots. self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace. self bestFitCompact. + self postCompactScanClassTable. self eliminateAndFreeForwarders. self assert: self validObjStacks. self assert: self allObjectsUnmarked. self runLeakCheckerForFullGC: true! Item was changed: ----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') ----- markAndTrace: objOop "Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack. Follow forwarding pointers in the scan." | objToScan index field | self assert: (self isNonImmediate: objOop). "if markAndTrace: is to follow and eliminate forwarding pointers in its scan it cannot be handed an r-value which is forwarded." self assert: (self isForwarded: objOop) not. (self isMarked: objOop) ifTrue: [^self]. "self setIsMarkedOf: objOop to: false" "for debugging" self setIsMarkedOf: objOop to: true. "Now scan the object, and any remaining objects on the mark stack." objToScan := objOop. "To avoid overflowing the mark stack when we encounter large objects, we push the obj, then its numStrongSlots, and then index the object from the stack." [| numStrongSlots | ((self isImmediate: objToScan) or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. numStrongSlots > self traceImmediatelySlotLimit]) ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any." [(self isImmediate: objToScan) ifTrue: [index := self integerValueOf: objToScan. objToScan := self topOfObjStack: markStack] ifFalse: [index := numStrongSlots]. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. (self isOopForwarded: field) ifTrue: [field := self followForwarded: field. self storePointerUnchecked: index ofObject: objToScan withValue: field]. ((self isImmediate: field) or: [self isMarked: field]) ifFalse: [self setIsMarkedOf: field to: true. + (self isWeakNonImm: field) - (self isWeakNonImm: objToScan) ifTrue: [self push: field onObjStack: weaklingStack] ifFalse: + [index > 0 ifTrue: + [(self topOfObjStack: markStack) ~= objToScan ifTrue: + [self push: objToScan onObjStack: markStack]. + self push: (self integerObjectOf: index) onObjStack: markStack. + objToScan := field. + index := -1]]]]. - [(self topOfObjStack: markStack) ~= objToScan ifTrue: - [self push: objToScan onObjStack: markStack]. - self push: (self integerObjectOf: index) onObjStack: markStack]. - objToScan := field. - index := -1]]. index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack." [objToScan := self popObjStack: markStack. objToScan = objOop ifTrue: [objToScan := self popObjStack: markStack]]] ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack." [index := numStrongSlots. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. (self isOopForwarded: field) ifTrue: [field := self followForwarded: field. self storePointerUnchecked: index ofObject: objToScan withValue: field]. ((self isImmediate: field) or: [self isMarked: field]) ifFalse: [self setIsMarkedOf: field to: true. (self isWeakNonImm: field) ifTrue: [self push: field onObjStack: weaklingStack] ifFalse: [self push: field onObjStack: markStack. numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. numStrongSlots > self traceImmediatelySlotLimit ifTrue: [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]]. objToScan := self popObjStack: markStack]. objToScan notNil] whileTrue! Item was changed: ----- Method: SpurMemoryManager>>postBecomeOrCompactScanClassTable: (in category 'become implementation') ----- postBecomeOrCompactScanClassTable: effectsFlags "Scan the class table post-become (iff a pointer object or compiled method was becommed), or post-compact. Note that one-way become can cause duplications in the class table. When can these be eliminated? We use the classTableBitmap to mark classTable entries (not the classes themselves, since marking a class doesn't help in knowing if its index is used). On image load, and during incrememtal scan-mark and full GC, classIndices are marked. We can somehow avoid following classes from the classTable until after this mark phase." self assert: self validClassTableRootPages. (effectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self]. 0 to: numClassTablePages - 1 do: [:i| | page | page := self fetchPointer: i ofObject: hiddenRootsObj. + self assert: (self isForwarded: page) not. 0 to: (self numSlotsOf: page) - 1 do: [:j| | classOrNil | classOrNil := self fetchPointer: j ofObject: page. classOrNil ~= nilObj ifTrue: [(self isForwarded: classOrNil) ifTrue: [classOrNil := self followForwarded: classOrNil. self storePointer: j ofObject: page withValue: classOrNil]. self scanClassPostBecome: classOrNil effects: effectsFlags]]]! Item was changed: ----- Method: SpurMemoryManager>>postCompactScanClassTable (in category 'become implementation') ----- postCompactScanClassTable "Scan the class table post-compact. Ensure all pages and all classes are not forwarded." 0 to: numClassTablePages - 1 do: [:i| | page | page := self fetchPointer: i ofObject: hiddenRootsObj. (self isForwarded: page) ifTrue: "this check is for eliminateAndFreeForwarders" [page := self followForwarded: page. self storePointer: i ofObject: hiddenRootsObj withValue: page]]. self assert: self validClassTableRootPages. + self postBecomeOrCompactScanClassTable: BecamePointerObjectFlag+BecameCompiledMethodFlag! - self postBecomeOrCompactScanClassTable: BecamePointerObjectFlag!

1 0

key-up events missing for some unix machines?
by tim Rowledge 05 Nov '13

05 Nov '13

I’m trying to get some idea where the problem lies when my Pi fairly frequently misses key-ups; this results in scratch sprite going spinning when they should just make a quick turn. I’m reasonably sure it’s not the image level code but I’m not making enough sense out of the key handling code in vm-display-X11/sqUnixX11.c to be sure there are no loopholes there. Another possibility that needs testing is the lower level OS code, since there have been Pi USB issues in the past. Does anyone else see the problem? Have any ideas for testing ? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Testicle (n.), a humorous question on an exam.

4 6

Gemstone 64-bit object format and pointers
by btc＠openinworld.com 04 Nov '13

04 Nov '13

I just watched [1] on Gemstone's object format and was interested to see how it uses 000 in the low order bits for direct in-memory object pointers. I presume Spur does something similar but was curious how it specifically compares. [1] http://www.youtube.com/watch?v=BAFUafgEwvw Also, probably not a good idea but I wondered what pros/cons there might be to just adopting Gemstone's object format. cheers -ben

2 1

← Newer
1
...
5
6
7
8
9
10
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev November 2013