Vm-dev May 2014

vm-dev@lists.squeakfoundation.org

32 participants
151 discussions

VM Maker: VMMaker.oscog-eem.689.mcz
by commits＠source.squeak.org 01 May '14

01 May '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.689.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.689 Author: eem Time: 30 April 2014, 5:57:41.953 pm UUID: 5cdb2e07-b8ad-48ca-9dc9-aa3b6ab22693 Ancestors: VMMaker.oscog-djm.688 Spur: Implement "pig compact", a much more functional compaction algorithm that works by doubly-linking free chunks in address order, therefore allowing e.g. easy enumeration of the objects between the penultimate and ultimate free chunks. Hence the algorithm moves all the objects it can at the end of memory to free chunks at lower addresses. It is piggish for several reasons: 1. it is greedy, using parts of a free chunk, not looking for a best or perfect fit. 2. it is greedy trying to move a run of objects at a time 3. it deals with large objects ("pigs") by searching the free list for a free chunk large enough to hold the pig. (and what constitutes a pig remains to be tuned; currently it is 8 * the average object size. Write the totalFreeOldSpace to the image header immediately following the size of the first segment. This to allow better determination of how much free space to allocate on startup. Use cCode:inSmalltalk: to encapsulate the printing of the gc stages, and delete the overrides in the simulator subclasses. Make sure the last bridge is marked to simplify coallesceFreeChunk: Rename averageObjectSize to averageObjectSizeInBytes. Add printOopsFrom:to: General VM: Nuke unused writeImageFile: Fix a slip and a bug in printObjectsFrom:to: Add a convenience to open a multi-window browser on the Spur classes, and relevant allies. Cogit: Add inline pragmas to the concretize methods that were lacking them. =============== Diff against VMMaker.oscog-djm.688 =============== Item was changed: ----- Method: CogAbstractInstruction>>concretizeLabel (in category 'generate machine code') ----- concretizeLabel + <inline: true> <var: #dependentChain type: #'AbstractInstruction *'> | dependentChain | dependentChain := dependent. [dependentChain isNil] whileFalse: [dependentChain updateLabel: self. dependentChain := dependentChain dependent]. ^machineCodeSize := 0! Item was changed: ----- Method: CogIA32Compiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code') ----- concretizeArithmeticShiftRightCqR + <inline: true> | shiftCount reg | shiftCount := (operands at: 0) min: 31. reg := self concreteRegister: (operands at: 1). shiftCount = 1 ifTrue: [machineCode at: 0 put: 16rD1; at: 1 put: (self mod: ModReg RM: reg RO: 7). ^machineCodeSize := 2]. machineCode at: 0 put: 16rC1; at: 1 put: (self mod: ModReg RM: reg RO: 7); at: 2 put: shiftCount. ^machineCodeSize := 3! Item was changed: ----- Method: CogIA32Compiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code') ----- concretizeArithmeticShiftRightRR "On the x86 the only instructions that shift by the value of a register require the shift count to be in %ecx. So we may have to use swap instructions to get the count into %ecx." + <inline: true> | shiftCountReg destReg regToShift | shiftCountReg := self concreteRegister: (operands at: 0). destReg := self concreteRegister: (operands at: 1). shiftCountReg = ECX ifTrue: [machineCode at: 0 put: 16rD3; at: 1 put: (self mod: ModReg RM: destReg RO: 7). ^machineCodeSize := 2]. regToShift := destReg == shiftCountReg ifTrue: [ECX] ifFalse: [destReg = ECX ifTrue: [shiftCountReg] ifFalse: [destReg]]. shiftCountReg = EAX ifTrue: [machineCode at: 0 put: 16r90 + ECX; "XCHG EAX,ECX" at: 1 put: 16rD3; "SAR ECX,EAX" at: 2 put: (self mod: ModReg RM: regToShift RO: 7); at: 3 put: 16r90 + ECX. "XCHG EAX,ECX" ^machineCodeSize := 4]. machineCode at: 0 put: 16r87; "XCHG E?X,ECX" at: 1 put: (self mod: ModReg RM: ECX RO: shiftCountReg); at: 2 put: 16rD3; "SAR ECX,E!!X" at: 3 put: (self mod: ModReg RM: regToShift RO: 7); at: 4 put: 16r87; "XCHG E?X,ECX" at: 5 put: (self mod: ModReg RM: ECX RO: shiftCountReg). ^machineCodeSize := 6! Item was changed: ----- Method: CogIA32Compiler>>concretizeCMPXCHGAwR (in category 'generate machine code') ----- concretizeCMPXCHGAwR + <inline: true> | addressOperand reg | addressOperand := operands at: 0. reg := self concreteRegister: (operands at: 1). machineCode at: 0 put: 16r0F; at: 1 put: 16rB1; at: 2 put: (self mod: ModRegInd RM: 5 RO: reg); at: 3 put: (addressOperand bitAnd: 16rFF); at: 4 put: (addressOperand >> 8 bitAnd: 16rFF); at: 5 put: (addressOperand >> 16 bitAnd: 16rFF); at: 6 put: (addressOperand >> 24 bitAnd: 16rFF). ^machineCodeSize := 7! Item was changed: ----- Method: CogIA32Compiler>>concretizeCMPXCHGMwrR (in category 'generate machine code') ----- concretizeCMPXCHGMwrR + <inline: true> | srcReg offset destReg | offset := operands at: 0. srcReg := self concreteRegister: (operands at: 1). destReg := self concreteRegister: (operands at: 2). srcReg ~= ESP ifTrue: [(self isQuick: offset) ifTrue: [machineCode at: 0 put: 16r0F; at: 1 put: 16rB1; at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg); at: 3 put: (offset bitAnd: 16rFF). ^machineCodeSize := 4]. machineCode at: 0 put: 16r0F; at: 1 put: 16rB1; at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg); at: 3 put: (offset bitAnd: 16rFF); at: 4 put: (offset >> 8 bitAnd: 16rFF); at: 5 put: (offset >> 16 bitAnd: 16rFF); at: 6 put: (offset >> 24 bitAnd: 16rFF). ^machineCodeSize := 7]. "ESP:" (self isQuick: offset) ifTrue: [machineCode at: 0 put: 16r0F; at: 1 put: 16rB1; at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg); at: 3 put: (self s: SIB1 i: 4 b: srcReg); at: 4 put: (offset bitAnd: 16rFF). ^machineCodeSize := 5]. machineCode at: 0 put: 16r0F; at: 1 put: 16rB1; at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg); at: 3 put: (self s: SIB1 i: 4 b: srcReg); at: 4 put: (offset bitAnd: 16rFF); at: 5 put: (offset >> 8 bitAnd: 16rFF); at: 6 put: (offset >> 16 bitAnd: 16rFF); at: 7 put: (offset >> 24 bitAnd: 16rFF). ^machineCodeSize := 8! Item was changed: ----- Method: CogIA32Compiler>>concretizeCPUID (in category 'generate machine code') ----- concretizeCPUID + <inline: true> machineCode at: 0 put: 16r0F; at: 1 put: 16rA2. ^machineCodeSize := 2! Item was changed: ----- Method: CogIA32Compiler>>concretizeFENCE: (in category 'generate machine code') ----- concretizeFENCE: regOpcode + <inline: true> machineCode at: 0 put: 16r0F; at: 1 put: 16rAE; at: 2 put: (self mod: ModReg RM: 0 RO: regOpcode). ^machineCodeSize := 3! Item was changed: ----- Method: CogIA32Compiler>>concretizeFill16 (in category 'generate machine code') ----- concretizeFill16 + <inline: true> | word | <var: #word type: 'unsigned short'> self assert: maxSize == 2. word := operands at: 0. machineCode at: 0 put: (word bitAnd: 16rFF). machineCode at: 1 put: word >> 8. ^machineCodeSize := 2! Item was changed: ----- Method: CogIA32Compiler>>concretizeFill32 (in category 'generate machine code') ----- concretizeFill32 + <inline: true> | word | <var: #word type: #'unsigned long'> word := operands at: 0. machineCode at: 0 put: (word bitAnd: 16rFF). machineCode at: 1 put: word >> 8. machineCode at: 2 put: word >> 16. machineCode at: 3 put: word >> 24. ^machineCodeSize := 4! Item was changed: ----- Method: CogIA32Compiler>>concretizeFillFromWord (in category 'generate machine code') ----- concretizeFillFromWord + <inline: true> | word | <var: #word type: #'unsigned long'> self assert: maxSize == 4. word := (operands at: 0) + (operands at: 1). 0 to: 3 do: [:i| machineCode at: i put: (word bitAnd: 16rFF). word := word >> 8]. ^machineCodeSize := maxSize! Item was changed: ----- Method: CogIA32Compiler>>concretizeJumpR (in category 'generate machine code') ----- concretizeJumpR + <inline: true> | reg | reg := self concreteRegister: (operands at: 0). machineCode at: 0 put: 16rFF; at: 1 put: (self mod: ModReg RM: reg RO: 4). ^machineCodeSize := 2! Item was changed: ----- Method: CogIA32Compiler>>concretizeLOCK (in category 'generate machine code') ----- concretizeLOCK + <inline: true> machineCode at: 0 put: 16rF0. ^machineCodeSize := 1! Item was changed: ----- Method: CogIA32Compiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code') ----- concretizeLogicalShiftLeftRR + <inline: true> "On the x86 the only instructions that shift by the value of a register require the shift count to be in %ecx. So we may have to use swap instructions to get the count into %ecx." | shiftCountReg destReg regToShift | shiftCountReg := self concreteRegister: (operands at: 0). destReg := self concreteRegister: (operands at: 1). shiftCountReg = ECX ifTrue: [machineCode at: 0 put: 16rD3; at: 1 put: (self mod: ModReg RM: destReg RO: 4). ^machineCodeSize := 2]. regToShift := destReg == shiftCountReg ifTrue: [ECX] ifFalse: [destReg = ECX ifTrue: [shiftCountReg] ifFalse: [destReg]]. shiftCountReg = EAX ifTrue: [machineCode at: 0 put: 16r90 + ECX; "XCHG EAX,ECX" at: 1 put: 16rD3; "SAR ECX,EAX" at: 2 put: (self mod: ModReg RM: regToShift RO: 4); at: 3 put: 16r90 + ECX. "XCHG EAX,ECX" ^machineCodeSize := 4]. machineCode at: 0 put: 16r87; "XCHG E?X,ECX" at: 1 put: (self mod: ModReg RM: ECX RO: shiftCountReg); at: 2 put: 16rD3; "SAR ECX,E!!X" at: 3 put: (self mod: ModReg RM: regToShift RO: 4); at: 4 put: 16r87; "XCHG E?X,ECX" at: 5 put: (self mod: ModReg RM: ECX RO: shiftCountReg). ^machineCodeSize := 6! Item was changed: ----- Method: CogIA32Compiler>>concretizeNop (in category 'generate machine code') ----- concretizeNop + <inline: true> machineCode at: 0 put: 16r90. ^machineCodeSize := 1! Item was changed: ----- Method: CogIA32Compiler>>concretizeXCHGAwR (in category 'generate machine code') ----- concretizeXCHGAwR + <inline: true> | addressOperand reg | addressOperand := operands at: 0. reg := self concreteRegister: (operands at: 1). machineCode at: 0 put: 16r87; at: 1 put: (self mod: ModRegInd RM: 5 RO: reg); at: 2 put: (addressOperand bitAnd: 16rFF); at: 3 put: (addressOperand >> 8 bitAnd: 16rFF); at: 4 put: (addressOperand >> 16 bitAnd: 16rFF); at: 5 put: (addressOperand >> 24 bitAnd: 16rFF). ^machineCodeSize := 6! Item was changed: ----- Method: CogIA32Compiler>>concretizeXCHGMwrR (in category 'generate machine code') ----- concretizeXCHGMwrR + <inline: true> | srcReg offset destReg | offset := operands at: 0. srcReg := self concreteRegister: (operands at: 1). destReg := self concreteRegister: (operands at: 2). srcReg ~= ESP ifTrue: [(self isQuick: offset) ifTrue: [machineCode at: 0 put: 16r87; at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg); at: 2 put: (offset bitAnd: 16rFF). ^machineCodeSize := 3]. machineCode at: 0 put: 16r87; at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg); at: 2 put: (offset bitAnd: 16rFF); at: 3 put: (offset >> 8 bitAnd: 16rFF); at: 4 put: (offset >> 16 bitAnd: 16rFF); at: 5 put: (offset >> 24 bitAnd: 16rFF). ^machineCodeSize := 6]. "ESP:" (self isQuick: offset) ifTrue: [machineCode at: 0 put: 16r87; at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg); at: 2 put: (self s: SIB1 i: 4 b: srcReg); at: 3 put: (offset bitAnd: 16rFF). ^machineCodeSize := 4]. machineCode at: 0 put: 16r87; at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg); at: 2 put: (self s: SIB1 i: 4 b: srcReg); at: 3 put: (offset bitAnd: 16rFF); at: 4 put: (offset >> 8 bitAnd: 16rFF); at: 5 put: (offset >> 16 bitAnd: 16rFF); at: 6 put: (offset >> 24 bitAnd: 16rFF). ^machineCodeSize := 7! Item was changed: ----- Method: CogIA32Compiler>>concretizeXCHGRR (in category 'generate machine code') ----- concretizeXCHGRR + <inline: true> | reg1 reg2 | reg1 := self concreteRegister: (operands at: 0). reg2 := self concreteRegister: (operands at: 1). reg2 = EAX ifTrue: [reg2 := reg1. reg1 := EAX]. reg1 = EAX ifTrue: [machineCode at: 0 put: 16r90 + reg2. ^machineCodeSize := 1]. machineCode at: 0 put: 16r87; at: 1 put: (self mod: ModReg RM: reg1 RO: reg2). ^machineCodeSize := 2! Item was changed: ----- Method: NewObjectMemory>>printObjectsFrom:to: (in category 'debug printing') ----- printObjectsFrom: startAddress to: endAddress <api> | oop | oop := startAddress. [self oop: oop isLessThan: endAddress] whileTrue: [(self isFreeObject: oop) ifFalse: + [coInterpreter printOop: oop]. - [self printOop: oop]. oop := self objectAfter: oop].! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>eliminateAndFreeForwarders (in category 'gc - global') ----- - eliminateAndFreeForwarders - coInterpreter transcript nextPutAll: 'eliminating forwarders...'; flush. - ^super eliminateAndFreeForwarders! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>exactFitCompact (in category 'compaction') ----- - exactFitCompact - coInterpreter transcript nextPutAll: 'ef compacting...'; flush. - ^super exactFitCompact! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>firstFitCompact (in category 'compaction') ----- - firstFitCompact - coInterpreter transcript nextPutAll: 'ff compacting...'; flush. - ^super firstFitCompact! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- - freeUnmarkedObjectsAndSortAndCoalesceFreeSpace - coInterpreter transcript nextPutAll: 'sweeping...'; flush. - ^super freeUnmarkedObjectsAndSortAndCoalesceFreeSpace! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>markObjects (in category 'gc - global') ----- - markObjects - coInterpreter transcript nextPutAll: 'marking...'; flush. - ^super markObjects! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>nilUnmarkedWeaklingSlots (in category 'gc - global') ----- - nilUnmarkedWeaklingSlots - coInterpreter transcript nextPutAll: 'nilling...'; flush. - ^super nilUnmarkedWeaklingSlots! Item was removed: - ----- Method: Spur32BitMMLESimulator>>eliminateAndFreeForwarders (in category 'gc - global') ----- - eliminateAndFreeForwarders - coInterpreter transcript nextPutAll: 'eliminating forwarders...'; flush. - ^super eliminateAndFreeForwarders! Item was removed: - ----- Method: Spur32BitMMLESimulator>>exactFitCompact (in category 'compaction') ----- - exactFitCompact - coInterpreter transcript nextPutAll: 'ef compacting...'; flush. - ^super exactFitCompact! Item was removed: - ----- Method: Spur32BitMMLESimulator>>firstFitCompact (in category 'compaction') ----- - firstFitCompact - coInterpreter transcript nextPutAll: 'ff compacting...'; flush. - ^super firstFitCompact! Item was removed: - ----- Method: Spur32BitMMLESimulator>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- - freeUnmarkedObjectsAndSortAndCoalesceFreeSpace - coInterpreter transcript nextPutAll: 'sweeping...'; flush. - ^super freeUnmarkedObjectsAndSortAndCoalesceFreeSpace! Item was removed: - ----- Method: Spur32BitMMLESimulator>>markObjects (in category 'gc - global') ----- - markObjects - coInterpreter transcript nextPutAll: 'marking...'; flush. - ^super markObjects! Item was removed: - ----- Method: Spur32BitMMLESimulator>>nilUnmarkedWeaklingSlots (in category 'gc - global') ----- - nilUnmarkedWeaklingSlots - coInterpreter transcript nextPutAll: 'nilling...'; flush. - ^super nilUnmarkedWeaklingSlots! Item was added: + ----- Method: SpurGenerationScavenger>>followRememberedForwardersAndForgetFreeObjectsForPigCompact (in category 'gc - global') ----- + followRememberedForwardersAndForgetFreeObjectsForPigCompact + "Scan the remembered set. Follow any forwarded objects, + and remove free objects. This is for global scan-mark GC." + | index obj | + index := 0. + [index < rememberedSetSize] whileTrue: + [obj := rememberedSet at: index. + (manager isFreeObject: obj) "free; remove by overwriting with last element" + ifTrue: + [rememberedSetSize := rememberedSetSize - 1. + rememberedSet at: index put: (rememberedSet at: rememberedSetSize)] + ifFalse: + [(manager isForwarded: obj) ifTrue: + [manager setIsRememberedOf: obj to: false. + obj := manager followForwarded: obj. + self assert: (manager isRemembered: obj). + rememberedSet at: index put: obj]. + index := index + 1]]! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') ----- initialize "SpurMemoryManager initialize" BitsPerByte := 8. + UseFitCompact := false. + "An obj stack is a stack of objects stored in a hidden root slot, such as the markStack or the ephemeronQueue. It is a linked list of segments, with the hot end at the head of the list. It is a word object. The stack pointer is in ObjStackTopx and 0 means empty. The list goes through ObjStackNextx. We don't want to shrink objStacks, since they're used in GC and its good to keep their memory around. So unused pages created by popping emptying pages are kept on the ObjStackFreex list. ObjStackNextx must be the last field for swizzleObjStackAt:." ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits" ObjStackTopx := 0. ObjStackMyx := 1. ObjStackFreex := 2. ObjStackNextx := 3. ObjStackFixedSlots := 4. ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots. "There are currently three obj stacks, the mark stack, the weaklings and the ephemeron queue." MarkStackRootIndex := self basicNew classTableRootSlots. WeaklingStackRootIndex := MarkStackRootIndex + 1. EphemeronQueueRootIndex := MarkStackRootIndex + 2. CheckObjectOverwrite := true. "The remap buffer support is for compatibility; Spur doesn't GC during allocation. Eventually this should die." RemapBufferSize := 25. "Extra roots are for plugin support." ExtraRootsSize := 2048 "max. # of external roots"! Item was added: + ----- Method: SpurMemoryManager>>anyMobileObjectsFrom:below: (in category 'compaction') ----- + anyMobileObjectsFrom: initialOop below: limit + self allOldSpaceEntitiesFrom: initialOop + do: [:objOop| | isMobile | "this variable is to avoid limitations in Slang's inliner" + isMobile := self isMobileObject: objOop. + isMobile ifTrue: + [^true]]. + ^false! Item was added: + ----- Method: SpurMemoryManager>>atLeastClassIndexHalfHeader: (in category 'compaction') ----- + atLeastClassIndexHalfHeader: obj + "PRIVATE: For compaction, answer the bits contaning the + classIndex and isPinned bits in the most natural form." + ^self longAt: obj! Item was removed: - ----- Method: SpurMemoryManager>>averageObjectSize (in category 'accessing') ----- - averageObjectSize - "Answer an approximation of the average object size. This is a bit of an underestimate. - In the 32-bit system average object size is about 11 words per object, including header." - ^8 * self bytesPerSlot! Item was added: + ----- Method: SpurMemoryManager>>averageObjectSizeInBytes (in category 'accessing') ----- + averageObjectSizeInBytes + "Answer an approximation of the average object size. This is a bit of an underestimate. + In the 32-bit system average object size is about 11 words per object, including header." + ^8 * self bytesPerSlot! Item was added: + ----- Method: SpurMemoryManager>>checkNoForwardersBelowFirstFreeChunk (in category 'gc - global') ----- + checkNoForwardersBelowFirstFreeChunk + self allOldSpaceEntitiesDo: + [:o| + o >= firstFreeChunk ifTrue: + [^true]. + (self asserta: (self isForwarded: o) not) ifFalse: + [^false]]. + ^true! Item was added: + ----- Method: SpurMemoryManager>>checkTraversableSortedFreeList (in category 'simulation only') ----- + checkTraversableSortedFreeList + | prevFree freeChunk next | + prevFree := 0. + freeChunk := firstFreeChunk. + self allOldSpaceEntitiesDo: + [:o| | objOop | + (self isFreeObject: o) ifTrue: + [self assert: o = freeChunk. + next := self nextInSortedFreeListLink: freeChunk given: prevFree. + "coInterpreter transcript cr; print: freeChunk; tab; print: o; tab; print: prevFree; nextPutAll: '<->'; print: next; flush." + objOop := freeChunk. + [(objOop := self objectAfter: objOop) < next] whileTrue: + [self assert: (self isFreeObject: objOop) not]. + prevFree := freeChunk. + freeChunk := next]]. + self assert: prevFree = lastFreeChunk. + self assert: freeChunk = 0! Item was added: + ----- Method: SpurMemoryManager>>coallesceFreeChunk: (in category 'gc - global') ----- + coallesceFreeChunk: objOop + "Attempt to coallesce objOop with the following objects in memory. + Answer the possibly changed start of objOop after coallescing." + | here next | + here := objOop. + self assert: (self isRemembered: here) not. + "Because lastBridge is marked loop below will terminate on reaching lastBridge." + self assert: (self isMarked: segmentManager lastBridge). + next := self objectAfter: here limit: endOfMemory. + [self isMarked: next] whileFalse: "coalescing; rare case" + [self assert: (self isRemembered: next) not. + statCoalesces := statCoalesces + 1. + here := self coalesce: here and: next. + next := self objectAfter: here limit: endOfMemory]. + ^here! Item was changed: ----- Method: SpurMemoryManager>>compact (in category 'compaction') ----- compact + "We'd like to use exact fit followed by best or first fit, but it doesn't work + well enough in practice. So use pig compact. Fill large free objects starting + from low memory with objects taken from the end of memory." - "We'd like to use exact fit followed by best fit, but best-fit is complex to implement - and potentially expensive. So just use exactFit followed, if necessary, by first-fit." <inline: false> self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]). + UseFitCompact + ifTrue: + [self exactFitCompact. + self assert: (firstFreeChunk = 0 + or: [(self isFreeObject: firstFreeChunk) + or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]). + highestObjects usedSize > 0 ifTrue: + [self firstFitCompact]] + ifFalse: + [self pigCompact]! - self exactFitCompact. - self assert: (firstFreeChunk = 0 - or: [(self isFreeObject: firstFreeChunk) - or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]). - highestObjects usedSize > 0 ifTrue: - [self firstFitCompact]! 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, coalescing with free space as we go." + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'eliminating forwarders...'; flush]. + UseFitCompact + ifTrue: [self eliminateAndFreeForwardersForFitCompact] + ifFalse: [self eliminateAndFreeForwardersForPigCompact]! - | lowestFree firstFree lastFree | - <inline: false> - self flag: 'this might be unnecessary. if we were to track firstFreeChunk we might be able to repeat the freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until firstFreeChunk reaches a fixed point'. - self assert: (self isForwarded: nilObj) not. - self assert: (self isForwarded: falseObj) not. - self assert: (self isForwarded: trueObj) not. - self assert: (self isForwarded: self freeListsObj) not. - self assert: (self isForwarded: hiddenRootsObj) not. - self assert: (self isForwarded: classTableFirstPage) not. - self followSpecialObjectsOop. - "N.B. we don't have to explicitly do mapInterpreterOops - since the scavenge below will do it." - self followForwardedObjStacks. - scavenger followRememberedForwardersAndForgetFreeObjects. - self doScavenge: DontTenureButDoUnmark. - self checkFreeSpace. - lowestFree := 0. - "sweep, following forwarders in all live objects, and finding the first forwarder." - self allOldSpaceEntitiesDo: - [:o| - ((self isFreeObject: o) or: [self isForwarded: o]) - ifTrue: - [lowestFree = 0 ifTrue: - [lowestFree := 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 storePointer: i ofObject: o withValue: f]]]]. - self checkFreeSpace. - lowestFree = 0 ifTrue: "yeah, right..." - [^self]. - firstFree := lastFree := 0. - "Sweep from lowest forwarder, coalescing runs of forwarders and free objects." - self allOldSpaceEntitiesFrom: lowestFree do: - [:o| - (self isFreeObject: o) - ifTrue: "two cases, isolated, in which case leave alone, or adjacent, - in which case, remove from free set prior to coalesce." - [| next | - next := self objectAfter: o limit: endOfMemory. - self assert: (next = endOfMemory or: [(self isFreeObject: next) not]). "free chunks have already been coalesced" - (firstFree ~= 0 - or: [next ~= endOfMemory and: [self isForwarded: next]]) ifTrue: - [firstFree = 0 ifTrue: - [firstFree := o]. - lastFree := o. - self detachFreeObject: o. - self checkFreeSpace]] - ifFalse: - [(self isForwarded: o) - ifTrue: - [firstFree = 0 ifTrue: - [firstFree := o]. - lastFree := o] - ifFalse: - [firstFree ~= 0 ifTrue: - [| start bytes | - start := self startOfObject: firstFree. - bytes := (self addressAfter: lastFree) - start. - self addFreeChunkWithBytes: bytes at: start. - self checkFreeSpace]. - firstFree := 0]]]. - firstFree ~= 0 ifTrue: - [| start bytes | - start := self startOfObject: firstFree. - bytes := (self addressAfter: lastFree) - start. - self addFreeChunkWithBytes: bytes at: start]. - self checkFreeSpace! Item was added: + ----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForFitCompact (in category 'gc - global') ----- + eliminateAndFreeForwardersForFitCompact + "As the final phase of global garbage collect, sweep the heap to follow + forwarders, then free forwarders, coalescing with free space as we go." + | lowestFree firstFree lastFree | + <inline: false> + self flag: 'this might be unnecessary. if we were to track firstFreeChunk we might be able to repeat the freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until firstFreeChunk reaches a fixed point'. + self assert: (self isForwarded: nilObj) not. + self assert: (self isForwarded: falseObj) not. + self assert: (self isForwarded: trueObj) not. + self assert: (self isForwarded: self freeListsObj) not. + self assert: (self isForwarded: hiddenRootsObj) not. + self assert: (self isForwarded: classTableFirstPage) not. + self followSpecialObjectsOop. + "N.B. we don't have to explicitly do mapInterpreterOops + since the scavenge below will do it." + self followForwardedObjStacks. + scavenger followRememberedForwardersAndForgetFreeObjects. + self doScavenge: DontTenureButDoUnmark. + self checkFreeSpace. + lowestFree := 0. + "sweep, following forwarders in all live objects, and finding the first forwarder." + self allOldSpaceEntitiesDo: + [:o| + ((self isFreeObject: o) or: [self isForwarded: o]) + ifTrue: + [lowestFree = 0 ifTrue: + [lowestFree := 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 storePointer: i ofObject: o withValue: f]]]]. + self checkFreeSpace. + lowestFree = 0 ifTrue: "yeah, right..." + [^self]. + firstFree := lastFree := 0. + "Sweep from lowest forwarder, coalescing runs of forwarders and free objects." + self allOldSpaceEntitiesFrom: lowestFree do: + [:o| + (self isFreeObject: o) + ifTrue: "two cases, isolated, in which case leave alone, or adjacent, + in which case, remove from free set prior to coalesce." + [| next | + next := self objectAfter: o limit: endOfMemory. + self assert: (next = endOfMemory or: [(self isFreeObject: next) not]). "free chunks have already been coalesced" + (firstFree ~= 0 + or: [next ~= endOfMemory and: [self isForwarded: next]]) ifTrue: + [firstFree = 0 ifTrue: + [firstFree := o]. + lastFree := o. + self detachFreeObject: o. + self checkFreeSpace]] + ifFalse: + [(self isForwarded: o) + ifTrue: + [firstFree = 0 ifTrue: + [firstFree := o]. + lastFree := o] + ifFalse: + [firstFree ~= 0 ifTrue: + [| start bytes | + start := self startOfObject: firstFree. + bytes := (self addressAfter: lastFree) - start. + self addFreeChunkWithBytes: bytes at: start. + self checkFreeSpace]. + firstFree := 0]]]. + firstFree ~= 0 ifTrue: + [| start bytes | + start := self startOfObject: firstFree. + bytes := (self addressAfter: lastFree) - start. + self addFreeChunkWithBytes: bytes at: start]. + self checkFreeSpace! Item was added: + ----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForPigCompact (in category 'gc - global') ----- + eliminateAndFreeForwardersForPigCompact + "As the final phase of global garbage collect, sweep the heap to follow + forwarders, then free forwarders, coalescing with free space as we go." + <inline: false> + self assert: (self isForwarded: nilObj) not. + self assert: (self isForwarded: falseObj) not. + self assert: (self isForwarded: trueObj) not. + self assert: (self isForwarded: self freeListsObj) not. + self assert: (self isForwarded: hiddenRootsObj) not. + self assert: (self isForwarded: classTableFirstPage) not. + self followSpecialObjectsOop. + "N.B. we don't have to explicitly do mapInterpreterOops + since the scavenge below will do it." + self followForwardedObjStacks. + scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact. + self doScavenge: DontTenureButDoUnmark. + self sweepToFollowForwardersForPigCompact. + self sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact. + self checkFreeSpace! 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. 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 | <var: #misfits type: #usqInt> + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'ef compacting...'; flush]. 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 oop: o isGreaterThan: firstFreeChunk) ifFalse: [highestObjects first: misfits. coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^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 < highestObjects start ifTrue: [misfits := highestObjects limit - self wordSize]. self longAt: misfits put: o] ifNotNil: [:f| | fo | nfits := nfits + 1. "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk is a large chunk then firstFreeChunk will no longer point to an object header. So check and adjust firstFreeChunk if it is assigned to." fo := self objectStartingAt: f. fo = firstFreeChunk ifTrue: [firstFreeChunk := self objectAfter: fo]. self copyAndForward: o withBytes: b toFreeChunk: f]]]. self checkFreeSpace. "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: (self oop: first isGreaterThan: 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]. savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first. misfits := self moveMisfitsInHighestObjectsBack: savedLimit. highestObjects usedSize > 0] whileTrue! Item was changed: ----- 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 cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'ff compacting...'; flush]. self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nhits := nmisses := 0. [statCompactPassCount := statCompactPassCount + 1. highestObjects reverseDo: [:o| | b | self assert: (firstFreeChunk = 0 or: [(self isFreeObject: firstFreeChunk) or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]). (self oop: o isLessThanOrEqualTo: 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| | fo | nhits := nhits + 1. "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk is a large chunk then firstFreeChunk will no longer point to an object header. So check and adjust firstFreeChunk if it is assigned to." fo := self objectStartingAt: f. fo = firstFreeChunk ifTrue: [firstFreeChunk := lastSubdividedFreeChunk = 0 ifTrue: [self objectAfter: fo] ifFalse: [self objectStartingAt: lastSubdividedFreeChunk]]. self copyAndForward: o withBytes: b toFreeChunk: f. self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]]. self checkFreeSpace. first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first. highestObjects usedSize > 0] whileTrue. coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr! Item was changed: ----- Method: SpurMemoryManager>>freeChunkNextIndex (in category 'free space') ----- freeChunkNextIndex + "for linking objecs on each free list, or, during pigCompact, doubly- + linking the free objects in address order using the xor link hack." - "for linking objecs on each free list" ^0! 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. + Sort to suit the compaction algorithm being used." + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'sweeping...'; flush]. + UseFitCompact + ifTrue: [self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForFitCompact] + ifFalse: [self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact]! - - 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 | - <inline: false> - <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 start - self wordSize. "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 assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]). - (self isMarked: o) - ifTrue: "forwarders should have been followed in markAndTrace:" - [self assert: (self isForwarded: o) not. - self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:" - (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. - lastHighest := highestObjects start]. - self longAt: lastHighest put: o]]] - ifFalse: "unmarked; two cases, an unreachable object or a free chunk." - [| here limit next | - self assert: (self isRemembered: o) not. "scavenger should have cleared this above" - here := o. - limit := endOfMemory - self bridgeSize. - next := self objectAfter: here limit: limit. - [next = limit or: [self isMarked: next]] whileFalse: "coalescing; rare case" - [self assert: (self isRemembered: o) not. - statCoalesces := statCoalesces + 1. - here := self coalesce: here and: next. - next := self objectAfter: here limit: limit]. - (self isLargeFreeObject: here) - ifTrue: - [self setFree: here. - lastLargeFree = 0 - ifTrue: [sortedFreeChunks := lastLargeFree := here] - ifFalse: - [self storePointer: self freeChunkNextAddressIndex - ofFreeChunk: lastLargeFree - withValue: here]. - lastLargeFree := here] - ifFalse: - [self freeSmallObject: here]. - firstFreeChunk = 0 ifTrue: - [self assert: (self isFreeObject: here). - firstFreeChunk := 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 added: + ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForFitCompact (in category 'gc - global') ----- + freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForFitCompact + "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 | + <inline: false> + <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 start - self wordSize. "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 assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]). + (self isMarked: o) + ifTrue: "forwarders should have been followed in markAndTrace:" + [self assert: (self isForwarded: o) not. + self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:" + (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. + lastHighest := highestObjects start]. + self longAt: lastHighest put: o]]] + ifFalse: "unmarked; two cases, an unreachable object or a free chunk." + [| here | + here := self coallesceFreeChunk: o. + (self isLargeFreeObject: here) + ifTrue: + [self setFree: here. + lastLargeFree = 0 + ifTrue: [sortedFreeChunks := lastLargeFree := here] + ifFalse: + [self storePointer: self freeChunkNextAddressIndex + ofFreeChunk: lastLargeFree + withValue: here]. + lastLargeFree := here] + ifFalse: + [self freeSmallObject: here]. + firstFreeChunk = 0 ifTrue: + [self assert: (self isFreeObject: here). + firstFreeChunk := 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 added: + ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') ----- + freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact + "Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space. + + Doubly-link the free chunks in address order through the freeChunkNextIndex field using the + xor trick to use only one field, see e.g. + The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18 + http://en.wikipedia.org/wiki/XOR_linked_list. + Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk. + + Let the segmentManager mark which segments contain pinned objects via notePinned:." + + | prevPrevFree prevFree | + <inline: false> + self checkFreeSpace. + scavenger forgetUnmarkedRememberedObjects. + segmentManager prepareForGlobalSweep."for notePinned:" + "throw away the list heads, including the tree." + self resetFreeListHeads. + firstFreeChunk := prevPrevFree := prevFree := 0. + self allOldSpaceEntitiesForCoalescingDo: + [:o| + self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]). + (self isMarked: o) + ifTrue: "forwarders should have been followed in markAndTrace:" + [self assert: (self isForwarded: o) not. + self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:" + (self isPinned: o) ifTrue: + [segmentManager notePinned: o]] + ifFalse: "unmarked; two cases, an unreachable object or a free chunk." + [| here | + self assert: (self isRemembered: o) not. "scavenger should have cleared this above" + here := self coallesceFreeChunk: o. + self setFree: here. + self inSortedFreeListLink: prevFree to: here given: prevPrevFree. + prevPrevFree := prevFree. + prevFree := here]]. + prevFree ~= firstFreeChunk ifTrue: + [self storePointer: self freeChunkNextIndex + ofFreeChunk: prevFree + withValue: prevPrevFree]. + lastFreeChunk := prevFree. + self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]! Item was added: + ----- Method: SpurMemoryManager>>inSortedFreeListLink:to:given: (in category 'compaction') ----- + inSortedFreeListLink: freeChunk to: nextFree given: prevFree + "Doubly-link the free chunk in address order through the freeChunkNextIndex field using the + xor trick to use only one field, see e.g. + The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18 + http://en.wikipedia.org/wiki/XOR_linked_list." + freeChunk = 0 + ifTrue: + [firstFreeChunk := nextFree] + ifFalse: + [self storePointer: self freeChunkNextIndex + ofFreeChunk: freeChunk + withUncheckedValue: (prevFree bitXor: nextFree)]! Item was added: + ----- Method: SpurMemoryManager>>isMobileObject: (in category 'object enumeration') ----- + isMobileObject: objOop + "Answer if objOop should be moved during compaction. Non-objects + (free chunks & bridges), forwarders and pinned objects are excluded." + | classIndex | + <inline: true> + classIndex := self classIndexOf: objOop. + self assert: ((self long64At: objOop) ~= 0 + and: [classIndex < (numClassTablePages * self classTablePageSize)]). + ^classIndex > self isForwardedObjectClassIndexPun + and: [(self isPinned: objOop) not]! Item was added: + ----- Method: SpurMemoryManager>>isMobileObjectHeader: (in category 'object enumeration') ----- + isMobileObjectHeader: objHeader + "Answer if an object with header objHeader should be moved during compaction. + Non-objects (free chunks & bridges), forwarders and pinned objects are excluded." + <inline: true> + ^(objHeader >> self pinnedBitShift bitAnd: 1) ~= 0 + ifTrue: [false] + ifFalse: [(self classIndexOfHeader: objHeader) > self isForwardedObjectClassIndexPun]! Item was added: + ----- Method: SpurMemoryManager>>isRememberedObjectHeader: (in category 'object enumeration') ----- + isRememberedObjectHeader: objHeader + "Answer if an object with header objHeader is remembered." + <inline: true> + ^(objHeader >> self rememberedBitShift bitAnd: 1) ~= 0! Item was changed: ----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') ----- markObjects <inline: false> "Mark all accessible objects." "If the incremental collector is running mark bits may be set; stop it and clear them if necessary." + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush]. self ensureAllMarkBitsAreZero. self ensureAdequateClassTableBitmap. self initializeUnscannedEphemerons. self initializeMarkStack. self initializeWeaklingStack. self markAccessibleObjects! Item was added: + ----- Method: SpurMemoryManager>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') ----- + moveARunOfObjectsStartingAt: startAddress upTo: limit + "Move the sequence of movable objects starting at startAddress. Answer the start + of the next sequence of movable objects after a possible run of unmovable objects, + or the limit, if there are no more movable objects, or 0 if no more compaction can be + done. Compaction is done when the search through the freeList has reached the + address from which objects are being moved from. + + There are two broad cases to be dealt with here. One is a run of smallish objects + that can easily be moved into free chunks. The other is a large object that is unlikely + to fit in the typical free chunk. This second pig needs careful handling; it needs to be + moved to the lowest place it will fit and not cause the scan to skip lots of smaller + free chunks looking in vain for somewhere to put it." + | here prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk | + here := startAddress. + prevPrevFreeChunk := prevFreeChunk := 0. + thisFreeChunk := maxFreeChunk := firstFreeChunk. + [thisFreeChunk ~= 0] whileTrue: + [| freeBytes endOfFree nextFree destination hereObj hereObjHeader there moved | + + [hereObj := self objectStartingAt: here. + hereObjHeader := self atLeastClassIndexHalfHeader: hereObj. + (self isMobileObjectHeader: hereObjHeader)] whileFalse: + [here := self addressAfter: hereObj. + here >= limit ifTrue: + [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]]]. + + freeBytes := self bytesInObject: thisFreeChunk. + nextFree := self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk. + destination := self startOfObject: thisFreeChunk. + endOfFree := destination + freeBytes. + moved := false. + maxFreeChunk := maxFreeChunk max: nextFree. + + "move as many objects as will fit in freeBytes..." + [there := self addressAfter: hereObj. + (self isMobileObjectHeader: hereObjHeader) + and: [there - here < (freeBytes - self allocationUnit) + or: [there - here = freeBytes]]] whileTrue: + [moved := true. + self mem: destination cp: here y: there - here. + self forward: hereObj to: destination + (hereObj - here). + destination := destination + (there - here). + freeBytes := freeBytes - (there - here). + hereObj := self objectStartingAt: there. + here := there. + hereObjHeader := self atLeastClassIndexHalfHeader: hereObj]. + + moved + ifTrue: "need to repair the free list" + [| nextNextFree | + nextFree ~= 0 ifTrue: + [nextNextFree := self nextInSortedFreeListLink: nextFree given: thisFreeChunk]. + (destination > thisFreeChunk "if false couldn't move anything" + and: [destination < endOfFree]) "if false, filled entire free chunk" + ifTrue: + [thisFreeChunk := self initFreeChunkWithBytes: endOfFree - destination at: destination. + self inSortedFreeListLink: prevFreeChunk to: thisFreeChunk given: prevPrevFreeChunk. + self inSortedFreeListLink: thisFreeChunk to: nextFree given: prevFreeChunk. + nextFree ~= 0 ifTrue: + [self inSortedFreeListLink: nextFree to: nextNextFree given: thisFreeChunk]. + prevPrevFreeChunk := prevFreeChunk. + prevFreeChunk := thisFreeChunk. + thisFreeChunk := nextFree] + ifFalse: + [self inSortedFreeListLink: prevFreeChunk to: nextFree given: prevPrevFreeChunk. + nextFree ~= 0 ifTrue: + [self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk. + thisFreeChunk := nextFree]]. + "self checkTraversableSortedFreeList"] + ifFalse: "out of space (or immobile object); move on up the free list..." + [prevPrevFreeChunk := prevFreeChunk. + prevFreeChunk := thisFreeChunk. + thisFreeChunk := nextFree]. + + (self isMobileObjectHeader: hereObjHeader) ifFalse: + [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]. + + "Was the loop stopped by a pig? If so, try and find space for it" + (there - here >= (self averageObjectSizeInBytes * 8) "256b in 32 bit, 512b in 64 bit" + and: [self isMobileObject: hereObj]) ifTrue: + [| usedChunk | + usedChunk := self tryToMovePig: hereObj at: here end: there. + "if it couldn't be moved we need to advance, so always + set here to there whether the pig was moved or not." + here := there. + "In general it's a bad idea to reset the enumeration; it leads to N^2 behaviour + when encountering pigs. But if the move affected the enumeration this is + simpler than resetting the list pointers." + (usedChunk = prevPrevFreeChunk + or: [usedChunk = prevFreeChunk + or: [usedChunk = thisFreeChunk]]) ifTrue: "a bad idea; leads to N^2 behaviour when encountering pigs" + ["reset the scan for free space back to the start of the list" + prevPrevFreeChunk := prevFreeChunk := 0. + thisFreeChunk := firstFreeChunk]]. + + (there >= limit + or: [maxFreeChunk >= startAddress]) ifTrue: + [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].! Item was added: + ----- Method: SpurMemoryManager>>nextInSortedFreeListLink:given: (in category 'compaction') ----- + nextInSortedFreeListLink: freeChunk given: prevFree + "Answer the next free free chunk using the xor trick to use only one field, see e.g. + The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18 + http://en.wikipedia.org/wiki/XOR_linked_list." + ^(self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk) bitXor: prevFree! Item was changed: ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlots (in category 'weakness and ephemerality') ----- nilUnmarkedWeaklingSlots "Nil the unmarked slots in the weaklings on the weakling stack, finalizing those that lost references. Finally, empty the weaklingStack." <inline: false> + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'nilling...'; flush]. weaklingStack = nilObj ifTrue: [^self]. self objStack: weaklingStack from: 0 do: [:weakling| (self nilUnmarkedWeaklingSlotsIn: weakling) ifTrue: [coInterpreter signalFinalization: weakling]]. self emptyObjStack: weaklingStack! Item was changed: ----- Method: SpurMemoryManager>>objectBefore: (in category 'object enumeration') ----- objectBefore: objOop <api> | prev | prev := nil. (self oop: objOop isLessThan: newSpaceLimit) ifTrue: + [self allNewSpaceEntitiesDo: - [self allNewSpaceObjectsDo: [:o| (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue: [^prev]. prev := o]. ^prev]. + self allOldSpaceEntitiesDo: - self allOldSpaceObjectsDo: [:o| (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue: [^prev]. prev := o]. ^prev! Item was added: + ----- Method: SpurMemoryManager>>pigCompact (in category 'compaction') ----- + pigCompact + "Traverse the sorted free list, moving objects from the high-end of + memory to the free objects in the low end of memory. Return when + the address at which objects are being copiecd to meets the address + from which objects are being copied from." + self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'pig compacting...'; flush]. + self sortedFreeListPairwiseReverseDo: + [:low :high| | scanAddress | + scanAddress := self addressAfter: low. + [scanAddress < high] whileTrue: + [scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high. + scanAddress = 0 ifTrue: + [^self]]]! Item was changed: ----- Method: SpurMemoryManager>>printObjectsFrom:to: (in category 'debug printing') ----- printObjectsFrom: startAddress to: endAddress <api> | oop | oop := self objectBefore: startAddress. oop := oop ifNil: [startAddress] ifNotNil: [(self objectAfter: oop) = startAddress ifTrue: [startAddress] ifFalse: [oop]]. [self oop: oop isLessThan: endAddress] whileTrue: + [((self isFreeObject: oop) + or: [self isSegmentBridge: oop]) ifFalse: + [coInterpreter printOop: oop]. - [(self isFreeObject: oop) ifFalse: - [self printOop: oop]. oop := self objectAfter: oop]! Item was added: + ----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') ----- + printOopsFrom: startAddress to: endAddress + <api> + | oop | + oop := self objectBefore: startAddress. + oop := oop + ifNil: [startAddress] + ifNotNil: [(self objectAfter: oop) = startAddress + ifTrue: [startAddress] + ifFalse: [oop]]. + [self oop: oop isLessThan: endAddress] whileTrue: + [coInterpreter + printHex: oop; print: '/'; printNum: oop; space; + print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse: + [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse: + [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse: + ['object']]]); + cr. + oop := self objectAfter: oop]! Item was changed: ----- Method: SpurMemoryManager>>slotSizeOf: (in category 'object access') ----- slotSizeOf: oop "*DO NOT CONFUSE THIS WITH numSlotsOf:. + This is an ObjectMemory compatibility method with questionable semantics. - This is an ObjectMemory compatibility method with quesitonable semantics. Answers the number of slots in the receiver. If the receiver is a byte object, return the number of bytes. Otherwise return the number of words." (self isImmediate: oop) ifTrue: [^0]. ^self lengthOf: oop! Item was added: + ----- Method: SpurMemoryManager>>sortedFreeListPairwiseReverseDo: (in category 'compaction') ----- + sortedFreeListPairwiseReverseDo: aBinaryBlock + "Evaluate aBinaryBlock with adjacent entries in the free list, from + high address to low address. The second argument is in fact the + start of the next free chunk, not the free chunk itself. Use + endOfMemory - bridgeSize as the second argument in the first evaluation." + | free prevFree nextFree | + free := lastFreeChunk. + prevFree := 0. + [free ~= 0] whileTrue: + [nextFree := self nextInSortedFreeListLink: free given: prevFree. + self assert: (nextFree = 0 or: [self isFreeObject: nextFree]). + self assert: (prevFree = 0 or: [prevFree > free]). + aBinaryBlock value: free value: (prevFree = 0 + ifTrue: [endOfMemory - self bridgeSize] + ifFalse: [self startOfObject: prevFree]). + prevFree := free. + free := nextFree]! Item was added: + ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withUncheckedValue: (in category 'heap management') ----- + storePointer: fieldIndex ofFreeChunk: objOop withUncheckedValue: valuePointer + + self assert: (self isFreeObject: objOop). + ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! Item was added: + ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact (in category 'gc - global') ----- + sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact + "Coallesce free chunks and forwarders and rebuild the free list." + | firstFree firstFreeStart lastFree | + self checkNoForwardersBelowFirstFreeChunk. + firstFree := totalFreeOldSpace := 0. + self allOldSpaceEntitiesFrom: firstFreeChunk do: + [:o| + ((self isFreeObject: o) or: [self isForwarded: o]) + ifTrue: + [firstFree = 0 ifTrue: + [firstFree := o]. + lastFree := o. + firstFreeStart := self startOfObject: o] + ifFalse: + [firstFree ~= 0 ifTrue: + [| bytes | + bytes := (self addressAfter: lastFree) - firstFreeStart. + self addFreeChunkWithBytes: bytes at: firstFreeStart]. + firstFree := 0]]. + firstFree ~= 0 ifTrue: + [| bytes | + bytes := (self addressAfter: lastFree) - firstFreeStart. + self addFreeChunkWithBytes: bytes at: firstFreeStart]. + firstFreeChunk := lastFreeChunk := 0! Item was added: + ----- Method: SpurMemoryManager>>sweepToFollowForwarders (in category 'gc - global') ----- + sweepToFollowForwarders + "sweep, following forwarders in all live objects, and answering the first forwarder or free object." + | lowestFree | + lowestFree := 0. + self allOldSpaceEntitiesDo: + [:o| + ((self isFreeObject: o) or: [self isForwarded: o]) + ifTrue: + [lowestFree = 0 ifTrue: + [lowestFree := 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 storePointer: i ofObject: o withValue: f]]]]. + ^lowestFree + ! Item was added: + ----- Method: SpurMemoryManager>>sweepToFollowForwardersForPigCompact (in category 'gc - global') ----- + sweepToFollowForwardersForPigCompact + "sweep, following forwarders in all live objects." + self allOldSpaceObjectsDo: + [:o| + (self isForwarded: 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 storePointer: i ofObject: o withValue: f]]]]! Item was changed: ----- Method: SpurMemoryManager>>tenuringThreshold (in category 'accessing') ----- tenuringThreshold "In the scavenger the tenuring threshold is effectively a number of bytes of objects, accessed as a proportion of pastSpace from 0 to 1. In the Squeak image the tenuring threshold is an object count. Marry the two notions by multiplying the proportion by the size of pastSpace and dividing by the average object size, as derived from observation." + ^(scavenger scavengerTenuringThreshold * scavenger pastSpaceBytes // self averageObjectSizeInBytes) asInteger! - ^(scavenger scavengerTenuringThreshold * scavenger pastSpaceBytes // self averageObjectSize) asInteger! Item was changed: ----- Method: SpurMemoryManager>>tenuringThreshold: (in category 'accessing') ----- tenuringThreshold: threshold "c.f. tenuringThreshold" scavenger scavengerTenuringThreshold: + (threshold * self averageObjectSizeInBytes) asFloat - (threshold * self averageObjectSize) asFloat / scavenger pastSpaceBytes asFloat! Item was added: + ----- Method: SpurMemoryManager>>tryToMovePig:at:end: (in category 'compaction') ----- + tryToMovePig: pigObj at: pigStart end: pigEnd + "Try to move a pig (a largish object) to a free chunk in low memory. + Answer the freeChunk that was used to house the moved pig, or + 0 if no free chunk could be found." + | freeChunk prevFree prevPrevFree pigBytes nextNext | + prevPrevFree := prevFree := 0. + freeChunk := firstFreeChunk. + pigBytes := pigEnd - pigStart. + [freeChunk ~= 0 and: [freeChunk < pigObj]] whileTrue: + [| next dest chunkBytes newChunk | + next := self nextInSortedFreeListLink: freeChunk given: prevFree. + dest := self startOfObject: freeChunk. + chunkBytes := (self addressAfter: freeChunk) - dest. + (chunkBytes = pigBytes + or: [chunkBytes - self allocationUnit > pigBytes]) ifTrue: + [self mem: dest cp: pigStart y: pigBytes. + self forward: pigObj to: dest + (pigObj - pigStart). + next ~= 0 ifTrue: + [nextNext := self nextInSortedFreeListLink: next given: freeChunk]. + "now either shorten the chunk, or remove it, adjusting the links to keep the list sorted." + pigBytes < chunkBytes "if false, filled entire free chunk" + ifTrue: + [newChunk := self initFreeChunkWithBytes: chunkBytes - pigBytes at: dest + pigBytes. + self inSortedFreeListLink: prevFree to: newChunk given: prevPrevFree. + self inSortedFreeListLink: newChunk to: next given: prevFree. + next ~= 0 ifTrue: + [self inSortedFreeListLink: next to: nextNext given: newChunk]] + ifFalse: + [self inSortedFreeListLink: prevFree to: next given: prevPrevFree. + next ~= 0 ifTrue: + [self inSortedFreeListLink: next to: nextNext given: prevFree]]. + "self checkTraversableSortedFreeList." + ^freeChunk]. + prevPrevFree := prevFree. + prevFree := freeChunk. + freeChunk := next]. + ^0! Item was added: + ----- Method: SpurSegmentManager>>lastBridge (in category 'accessing') ----- + lastBridge + ^self bridgeAt: numSegments - 1! Item was changed: ----- Method: SpurSegmentManager>>prepareForGlobalSweep (in category 'pinning') ----- prepareForGlobalSweep + "Let the segmentManager mark which segments contain pinned objects via notePinned:. + For coallesceFreeChunk:, ensure that the last bridge is marked." - "Let the segmentManager mark which segments contain pinned objects via notePinned:" sweepIndex := 0. 0 to: numSegments - 1 do: + [:i| (segments at: i) containsPinned: false]. + manager + setIsMarkedOf: (self bridgeAt: numSegments - 1) + to: true! - [:i| (segments at: i) containsPinned: false]! Item was removed: - ----- Method: StackInterpreter>>writeImageFile: (in category 'image save/restore') ----- - writeImageFile: imageBytes - - | fn | - <var: #fn type: 'void *'> - self writeImageFileIO: imageBytes. - self successful ifTrue: - ["set Mac file type and creator; this is a noop on other platforms" - fn := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'. - fn = 0 ifFalse: - [self cCode:'((sqInt (*)(char*, char*, char*))fn)(imageName, "STim", "FAST")']] - ! Item was changed: ----- Method: StackInterpreter>>writeImageFileIO (in category 'image save/restore') ----- writeImageFileIO "Write the image header and heap contents to imageFile for snapshot." | imageName headerStart headerSize f imageBytes bytesWritten sCWIfn okToWrite | <var: #f type: #sqImageFile> <var: #headerStart type: #squeakFileOffsetType> <var: #sCWIfn type: #'void *'> <var: #imageName declareC: 'extern char imageName[]'> + self cCode: [] inSmalltalk: [imageName := 'sooth compiler'. ^self writeImageFileIOSimulation]. - self cCode: [] inSmalltalk: [^self writeImageFileIOSimulation]. "If the security plugin can be loaded, use it to check for write permission. + If not, assume it's ok" - If not, assume it's ok" sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'. sCWIfn ~= 0 ifTrue: [okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'. okToWrite ifFalse:[^self primitiveFail]]. "local constants" headerStart := 0. headerSize := 64. "header size in bytes; do not change!!" f := self sqImageFile: imageName Open: 'wb'. f = nil ifTrue: "could not open the image file for writing" [^self primitiveFail]. imageBytes := objectMemory imageSizeToWrite. headerStart := self sqImage: f File: imageName StartLocation: headerSize + imageBytes. self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'. "position file to start of header" self sqImageFile: f Seek: headerStart. self putLong: self imageFormatVersion toFile: f. self putLong: headerSize toFile: f. self putLong: imageBytes toFile: f. self putLong: objectMemory baseAddressOfImage toFile: f. self putLong: objectMemory specialObjectsOop toFile: f. self putLong: objectMemory newObjectHash toFile: f. self putLong: self ioScreenSize toFile: f. self putLong: self getImageHeaderFlags toFile: f. self putLong: extraVMMemory toFile: f. self putShort: desiredNumStackPages toFile: f. self putShort: self unknownShortOrCodeSizeInKs toFile: f. self putLong: desiredEdenBytes toFile: f. self putShort: (maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]) toFile: f. self putShort: the2ndUnknownShort toFile: f. objectMemory hasSpurMemoryManagerAPI ifTrue: + [self putLong: objectMemory firstSegmentBytes toFile: f. + self putLong: objectMemory bytesLeftInOldSpace toFile: f. + 1 to: 2 do: [:i| self putLong: 0 toFile: f] "Pad the rest of the header."] - [self putLong: objectMemory firstSegmentBytes toFile: f."Pad the rest of the header." - 1 to: 3 do: [:i| self putLong: 0 toFile: f]] ifFalse: [1 to: 4 do: [:i| self putLong: 0 toFile: f]]. "fill remaining header words with zeros" "position file after the header" self sqImageFile: f Seek: headerStart + headerSize. self successful ifFalse: "file write or seek failure" [self sqImageFileClose: f. ^nil]. "write the image data" objectMemory hasSpurMemoryManagerAPI ifTrue: [bytesWritten := objectMemory writeImageSegmentsToFile: f] ifFalse: [bytesWritten := self sq: (self pointerForOop: objectMemory baseAddressOfImage) Image: (self sizeof: #char) File: imageBytes Write: f]. self success: bytesWritten = imageBytes. self sqImageFileClose: f! Item was changed: ----- Method: StackInterpreter>>writeImageFileIOSimulation (in category 'image save/restore') ----- writeImageFileIOSimulation "Write the image header and heap contents to imageFile for snapshot. c.f. writeImageFileIO" <doNotGenerate> | headerSize file | BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet']. headerSize := 64. (file := FileStream fileNamed: self imageName) ifNil: [self primitiveFail. ^nil]. [ file binary. { self imageFormatVersion. headerSize. objectMemory imageSizeToWrite. objectMemory baseAddressOfImage. objectMemory specialObjectsOop. objectMemory lastHash. self ioScreenSize. self getImageHeaderFlags. extraVMMemory ifNil: [0] } do: [:long | self putLong: long toFile: file]. { desiredNumStackPages. self unknownShortOrCodeSizeInKs } do: [:short| self putShort: short toFile: file]. self putLong: desiredEdenBytes toFile: file. { maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]. 0 } do: [:short| self putShort: short toFile: file]. objectMemory hasSpurMemoryManagerAPI ifTrue: [| bytesWritten | + self putLong: objectMemory firstSegmentBytes toFile: file. + self putLong: objectMemory bytesLeftInOldSpace toFile: file. + 2 timesRepeat: [self putLong: 0 toFile: file "Pad the rest of the header."]. - self putLong: objectMemory firstSegmentBytes toFile: file."Pad the rest of the header." - 3 timesRepeat: [self putLong: 0 toFile: file]. "Position the file after the header." file position: headerSize. bytesWritten := objectMemory writeImageSegmentsToFile: file. self assert: bytesWritten = objectMemory imageSizeToWrite] ifFalse: ["Pad the rest of the header." 4 timesRepeat: [self putLong: 0 toFile: file]. "Position the file after the header." file position: headerSize. "Write the object memory." objectMemory baseAddressOfImage // 4 + 1 to: objectMemory baseAddressOfImage + objectMemory imageSizeToWrite // 4 do: [:index | self putLong: (objectMemory memory at: index) toFile: file]]. self success: true ] ensure: [file ifNotNil: [file close]]! Item was added: + ----- Method: VMClass class>>openSpurMultiWindowBrowser (in category 'utilities') ----- + openSpurMultiWindowBrowser + "Answer a new multi-window browser on the Spur classes, the Cog StackInterpreter classes, and the support classes" + | b | + b := Browser open. + #( SpurMemoryManager Spur32BitMemoryManager Spur64BitMemoryManager + SpurGenerationScavenger SpurSegmentManager + Spur32BitMMLESimulator SpurGenerationScavengerSimulator + InterpreterPrimitives StackInterpreter StackInterpreterPrimitives + VMStructType VMMaker CCodeGenerator TMethod) + do: [:className| + (Smalltalk classNamed: className) ifNotNil: + [:class| b selectCategoryForClass: class; selectClass: class]] + separatedBy: + [b multiWindowState addNewWindow]. + b multiWindowState selectWindowIndex: 1!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev May 2014