Vm-dev September 2013

vm-dev@lists.squeakfoundation.org

31 participants
155 discussions

VM Maker: Cog-eem.100.mcz
by commits＠source.squeak.org 24 Sep '13

24 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.100.mcz ==================== Summary ==================== Name: Cog-eem.100 Author: eem Time: 24 September 2013, 1:24:54.567 pm UUID: 95a46b20-6f47-408d-8ff0-9b1903ef860c Ancestors: Cog-eem.99 Fix a typo in a prootype method. Report on heap growth during bootstrap. =============== Diff against Cog-eem.99 =============== Item was changed: Object subclass: #SpurBootstrap + instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym classMetaclass' - instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym classMetaclass' classVariableNames: 'ImageHeaderFlags ImageName TransformedImage' poolDictionaries: 'VMObjectIndices' category: 'Cog-Bootstrapping'! !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0! SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format. e.g. (SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image') transform; launch Bootstrap issues: - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load. - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)? Instance Variables classToIndex: <Dictionary> lastClassTablePage: <Integer> map: <Dictionary> methodClasses: <Set> newHeap: <SpurMemoryManager> oldHeap: <NewObjectMemory> oldInterpreter: <StackInterpreterSimulator> reverseMap: <Dictionary> symbolMap: <Dictionary> classToIndex - oldClass to new classIndex map lastClassTablePage - oop in newHeap of last classTable page. U<sed in validation to filter-out class table. methodClasses - cache of methodClassAssociations for classes in which modified methods are installed map - oldObject to newObject map newHeap - the output, bootstrapped image oldHeap - the input, image oldInterpreter - the interpreter associated with oldHeap, needed for a hack to grab WeakArray reverseMap - newObject to oldObject map symbolMap - symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap! Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') ----- BehaviorPROTOTYPEinstSpec "Answer the instance specification part of the format that defines what kind of object + an instance of the receiver is. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) - an instance of the receiver is. The formats are0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 unused, reserved for exotic pointer objects? 7 reserved by the VM 8 unused, reserved for exotic non-pointer objects? 9 (?) 64-bit indexable 10 - 11 32-bit indexable 12 - 15 16-bit indexable 16 - 23 byte indexable 24 - 31 compiled method" ^(format bitShift: -16) bitAnd: 16r1F! Item was changed: ----- Method: SpurBootstrap>>bootstrapImage (in category 'bootstrap image') ----- bootstrapImage + oldHeap fullGC. + oldHeapSize := oldHeap freeStart. Transcript cr; nextPutAll: 'transforming image...'; flush. self cloneNilTrueAndFalse. self buildClassMap. self allocateClassTable. self cloneObjects. self fillInObjects. self fillInClassTable. + newHeapSize := newHeap freeStart. newHeap initializePostBootstrap! Item was changed: ----- Method: SpurBootstrap>>transform (in category 'bootstrap image') ----- transform + | change | self rememberRehashSymbol. self findRequiredGlobals. self installModifiedMethods. self bootstrapImage. self validate. self rehashImage. self followForwardingPointers. self scavengeImage. self freeForwarders. self compactImage. + change := newHeapSize - oldHeapSize / oldHeapSize. + Transcript + nextPutAll: 'done.'; cr; + nextPutAll: 'old heap size: '; print: oldHeapSize; cr; + nextPutAll: 'initial new heap size: '; print: newHeapSize; cr; + nextPutAll: 'change: '; print: (change * 100.0 roundTo: 0.01); nextPut: $%; cr; + flush. + newHeapSize := newHeap endOfMemory + - newHeap scavenger eden limit + - newHeap totalFreeListBytes. + change := newHeapSize - oldHeapSize / oldHeapSize. + Transcript + nextPutAll: 'final new heap size: '; print: newHeapSize; cr; + nextPutAll: 'change: '; print: (change * 100.0 roundTo: 0.01); nextPut: $%; cr; + flush.! - Transcript nextPutAll: 'done.'; flush.!

1 0

Re: [Vm-dev] VM Maker: Cog-eem.98.mcz
by Frank Shearar 24 Sep '13

24 Sep '13

On 21 September 2013 15:41, <commits(a)source.squeak.org> wrote: > > Eliot Miranda uploaded a new version of Cog to project VM Maker: > http://source.squeak.org/VMMaker/Cog-eem.98.mcz > > ==================== Summary ==================== > > Name: Cog-eem.98 > Author: eem > Time: 21 September 2013, 7:41:44.069 am > UUID: 8027e935-f7b0-417a-be44-954c5765582d > Ancestors: Cog-eem.97 > > fix a couple of comments > > =============== Diff against Cog-eem.97 =============== > > Item was changed: > ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') ----- > SmalltalkImagePROTOTYPEsetGCParameters > "Adjust the VM's default GC parameters to avoid too much tenuring. > Maybe this should be left to the VM?" > > | proportion edenSize survivorSize averageObjectSize numObjects | > proportion := 0.9. "tenure when 90% of pastSpace is full" > edenSize := SmalltalkImage current vmParameterAt: 44. > + survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" > - survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur does the same :-)" > averageObjectSize := 8 * self wordSize. "a good approximation" > numObjects := (proportion * survivorSize / averageObjectSize) rounded. > SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"! > > Item was changed: > ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') ----- > SystemDictionaryPROTOTYPEsetGCParameters > "Adjust the VM's default GC parameters to avoid too much tenuring. > Maybe this should be left to the VM?" > > | proportion edenSize survivorSize averageObjectSize numObjects | > proportion := 0.9. "tenure when 90% of pastSpace is full" > edenSize := SmalltalkImage current vmParameterAt: 44. > + survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" I presume that's David Ungar? Which paper is it? Thanks! frank

4 4

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

23 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.406.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.406 Author: eem Time: 23 September 2013, 2:38:38.527 pm UUID: fa4c2477-036c-424e-9c73-f4e4c8a9bd3f Ancestors: VMMaker.oscog-eem.405 Fix the scavengeLoop for the mapInterpreterOops call. mIO can cause objects to be copied and forwarded /and/ remembered (if tenured) so the termination condition is nothing forwarded /and/ northing remembered, hence previousRememberedSetSize must be recorded before sending mIO. Fix objectBytesForSlots:; ot forgot to include the forwarding slot in empty objects. Fix allocateOldSpaceChunkOfBytes: to use freeListsMask (<= not >=). Fix instanceAfter: (use of objOop after the fact). refactor objectAfter:limit:, it differs slightly between 32 & 64 bits. Make printNameOfClass:count: accet a nil class (as answered by classAtIndex:). Simulator: Implement cloneSimulation for debugging. Allows e.g. rerunning the same scavenge in the clone for repeatibility. Simplify the window quitBlocks now I know about containingWindow. =============== Diff against VMMaker.oscog-eem.405 =============== Item was changed: ----- Method: CogVMSimulator>>openAsMorph (in category 'UI') ----- openAsMorph "Open a morphic view on this simulation." + | localImageName borderWidth window | - | localImageName borderWidth theWindow | localImageName := imageName ifNotNil: [FileDirectory default localNameFor: imageName] ifNil: [' synthetic image']. + window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self. - theWindow := (SystemWindow labelled: 'Simulation of ', localImageName) model: self. + window addMorph: (displayView := ImageMorph new image: displayForm) - theWindow addMorph: (displayView := ImageMorph new image: displayForm) frame: (0@0 corner: 1(a)0.8). transcript := TranscriptStream on: (String new: 10000). + window addMorph: (PluggableTextMorph - theWindow addMorph: (PluggableTextMorph on: transcript text: nil accept: nil readSelection: nil menu: #codePaneMenu:shifted:) frame: (0(a)0.8 corner: 0.7@1). + window addMorph: (PluggableTextMorph on: self - theWindow addMorph: (PluggableTextMorph on: self text: #byteCountText accept: nil readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely frame: (0.7(a)0.8 corner: 1@1). borderWidth := [SystemWindow borderWidth] "Squeak 4.1" on: MessageNotUnderstood do: [:ex| 0]. "3.8" + borderWidth := borderWidth + window borderWidth. + window openInWorldExtent: (self desiredDisplayExtent - borderWidth := borderWidth + theWindow borderWidth. - theWindow openInWorldExtent: (self desiredDisplayExtent + (2 * borderWidth) + + (0@window labelHeight) + * (1(a)(1/0.8))) rounded. + ^window! - + (0@theWindow labelHeight) - * (1(a)(1/0.8))) rounded! Item was changed: ----- Method: CogVMSimulator>>run (in category 'testing') ----- run "Just run" + quitBlock := [displayView ifNotNil: + [displayView containingWindow ifNotNil: + [:topWindow| + ((World submorphs includes: topWindow) + and: [UIManager default confirm: 'close?']) ifTrue: + [topWindow delete]]]. - quitBlock := [| topWindow | - - (displayView notNil - and: [topWindow := displayView outermostMorphThat: - [:m| m isSystemWindow and: [World submorphs includes: m]]. - topWindow notNil - and: [UIManager default confirm: 'close?']]) ifTrue: - [topWindow delete]. ^self]. self initStackPages. self loadInitialContext. self initialEnterSmalltalkExecutive! Item was changed: ----- Method: CogVMSimulator>>runWithBreakCount: (in category 'testing') ----- runWithBreakCount: theBreakCount "Just run, halting when byteCount is reached" + quitBlock := [displayView ifNotNil: + [displayView containingWindow ifNotNil: + [:topWindow| + ((World submorphs includes: topWindow) + and: [UIManager default confirm: 'close?']) ifTrue: + [topWindow delete]]]. - quitBlock := [(displayView notNil - and: [UIManager default confirm: 'close?']) ifTrue: - [(displayView outermostMorphThat: [:m| m isSystemWindow]) ifNotNil: - [:topWindow| topWindow delete]]. ^self]. breakCount := theBreakCount. self initStackPages. self loadInitialContext. self initialEnterSmalltalkExecutive! Item was changed: ----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') ----- openAsMorph "Open a morphic view on this simulation." | window localImageName | localImageName := imageName ifNotNil: [FileDirectory default localNameFor: imageName] ifNil: [' synthetic image']. window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self. window addMorph: (displayView := ImageMorph new image: displayForm) frame: (0@0 corner: 1(a)0.8). transcript := TranscriptStream on: (String new: 10000). window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil readSelection: nil menu: #codePaneMenu:shifted:) frame: (0(a)0.8 corner: 0.7@1). window addMorph: (PluggableTextMorph on: self text: #byteCountText accept: nil) hideScrollBarsIndefinitely frame: (0.7(a)0.8 corner: 1@1). + window openInWorld. + ^window! - window openInWorld! Item was changed: ----- Method: NewspeakInterpreterSimulator>>openAsMorph (in category 'UI') ----- openAsMorph "Open a morphic view on this simulation." | window localImageName | localImageName := imageName ifNotNil: [FileDirectory default localNameFor: imageName] ifNil: [' synthetic image']. window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self. window addMorph: (displayView := ImageMorph new image: displayForm) frame: (0@0 corner: 1(a)0.8). transcript := TranscriptStream on: (String new: 10000). window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil readSelection: nil menu: #codePaneMenu:shifted:) frame: (0(a)0.8 corner: 0.7@1). window addMorph: (PluggableTextMorph on: self text: #byteCountText accept: nil readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely frame: (0.7(a)0.8 corner: 1@1). window openInWorldExtent: (self desiredDisplayExtent + (2 * window borderWidth) + (0@window labelHeight) + * (1(a)(1/0.8))) rounded. + ^window! - * (1(a)(1/0.8))) rounded! 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 = 16r11D8240 and: [a32BitValue = 16r1D8368]) ifTrue: - "(byteAddress = 16r120DBDC and: [a32BitValue = 16r16000000]) ifTrue: [self halt]." byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was changed: ----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') ----- longLongAt: byteAddress put: a64BitValue "memory is a Bitmap, a 32-bit indexable array of bits" byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. + "(byteAddress = 16r11D8240 and: [(a64BitValue bitAnd: 16rffffffff) = 16r1D8368]) ifTrue: + [self halt]." - "((byteAddress = 16r120DBDC or: [byteAddress = 16r120DBD8]) - and: [a64BitValue >> 32 = 16r16000000 - or: [(a64BitValue bitAnd: 16rffffffff) = 16r16000000]]) ifTrue: - [self halt]." memory at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff); at: byteAddress // 4 + 2 put: a64BitValue >> 32. ^a64BitValue! Item was added: + ----- Method: Spur32BitMMLESimulator>>stObject:at:put: (in category 'simulation only') ----- + stObject: objOop at: indexOop put: valueOop + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter stObject: objOop at: indexOop put: valueOop! Item was added: + ----- Method: Spur32BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') ----- + objectAfter: objOop limit: limit + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." + | followingWordAddress followingWord | + followingWordAddress := self addressAfter: objOop. + followingWordAddress >= limit ifTrue: + [^limit]. + self flag: #endianness. + followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask + ifTrue: [followingWordAddress + self baseHeaderSize] + ifFalse: [followingWordAddress]! Item was changed: ----- Method: Spur32BitMemoryManager>>objectBytesForSlots: (in category 'object enumeration') ----- objectBytesForSlots: numSlots "Answer the total number of bytes in an object with the given number of slots, including header and possible overflow size header." + ^(numSlots = 0 + ifTrue: [self allocationUnit] "always at least one slot for forwarding pointer" + ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord]) - ^numSlots + (numSlots bitAnd: 1) << self shiftForWord + (numSlots >= self numSlotsMask ifTrue: [self baseHeaderSize + self baseHeaderSize] ifFalse: [self baseHeaderSize])! Item was added: + ----- Method: Spur64BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') ----- + objectAfter: objOop limit: limit + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." + | followingWordAddress followingWord | + followingWordAddress := self addressAfter: objOop. + followingWordAddress >= limit ifTrue: + [^limit]. + self flag: #endianness. + followingWord := self longAt: followingWordAddress. + ^followingWord >> self numSlotsFullShift = self numSlotsMask + ifTrue: [followingWordAddress + self baseHeaderSize] + ifFalse: [followingWordAddress]! Item was changed: ----- Method: Spur64BitMemoryManager>>objectBytesForSlots: (in category 'object enumeration') ----- objectBytesForSlots: numSlots "Answer the total number of bytes in an object with the given number of slots, including header and possible overflow size header." + ^(numSlots max: 1) << self shiftForWord - ^numSlots << self shiftForWord + (numSlots >= self numSlotsMask ifTrue: [self baseHeaderSize + self baseHeaderSize] ifFalse: [self baseHeaderSize])! Item was changed: ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') ----- scavengeLoop "This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from the promoted. This loop continues until no more reachable objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as detecting closure. If this were not true, some pointers might get forwarded twice." | firstTime previousRememberedSetSize previousFutureSurvivorStart | self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start" firstTime := true. previousRememberedSetSize := 0. previousFutureSurvivorStart := futureSurvivorStart. [self scavengeRememberedSetStartingAt: previousRememberedSetSize. + previousRememberedSetSize := rememberedSetSize. firstTime ifTrue: [coInterpreter mapInterpreterOops. firstTime := false]. + "nothing more copied and forwarded (or remembered by mapInterpreterOops) + to scavenge so scavenge is done." + (previousRememberedSetSize = rememberedSetSize + and: [previousFutureSurvivorStart = futureSurvivorStart]) ifTrue: - "northing more copied and forwarded to scavenge so scavenge is done." - previousFutureSurvivorStart = futureSurvivorStart ifTrue: [^self]. - previousRememberedSetSize := rememberedSetSize. self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart. "no more roots created to scavenge, so scavenge is done." previousRememberedSetSize = rememberedSetSize ifTrue: [^self]. previousFutureSurvivorStart := futureSurvivorStart] repeat! Item was changed: ----- Method: SpurGenerationScavengerSimulator>>copyAndForward: (in category 'scavenger') ----- copyAndForward: survivor | newLocation | + true ifTrue: [^super copyAndForward: survivor.]. + "(#(16r13BC78 16r13BD68 16r1ED780 16r1FC558) includes: survivor) ifTrue: [self halt]." - survivor = 16r19BC60 ifTrue: [self halt]. newLocation := super copyAndForward: survivor. comeFroms at: newLocation put: survivor. + "((manager isContextNonImm: newLocation) + and: [#(16r11D6988 16r11D6A48 16r11D6AC0 16r11D6B80) includes: newLocation]) ifTrue: + [self halt]." ^newLocation! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if 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 chunk nextIndex nodeBytes parent child smaller larger | totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" index := chunkBytes / self allocationUnit. + (index < NumFreeLists and: [1 << index <= freeListsMask]) ifTrue: - (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). ^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. + [1 << index <= freeListsMask - [1 << index >= freeListsMask and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "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." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [nodeBytes := self bytesInObject: child. parent := child. nodeBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^self startOfObject: chunk]. child := 0] "break out of loop to remove interior node" ifFalse:"walk down the tree" [child := self fetchPointer: (nodeBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: child]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "no list; remove an interior node" chunk := parent. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. "coInterpreter transcript ensureCr. coInterpreter print: 'new free tree root '. (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. coInterpreter cr." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S |" self halt. "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" self halt! Item was changed: ----- Method: SpurMemoryManager>>instanceAfter: (in category 'object enumeration') ----- instanceAfter: objOop | actualObj classIndex | actualObj := objOop. classIndex := self classIndexOf: objOop. + (self isInEden: objOop) ifTrue: + [[actualObj := self objectAfter: actualObj limit: freeStart. + actualObj < freeStart] whileTrue: - [actualObj := self objectAfter: actualObj limit: freeStart. - [objOop < freeStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: + [^actualObj]]. - [^actualObj]. - actualObj := self objectAfter: objOop limit: freeStart]. actualObj := pastSpaceStart > scavenger pastSpace start ifTrue: [self objectStartingAt: scavenger pastSpace start] ifFalse: [nilObj]]. + (self isInSurvivorSpace: actualObj) ifTrue: + [[actualObj := self objectAfter: actualObj limit: pastSpaceStart. + actualObj < pastSpaceStart] whileTrue: - [actualObj := self objectAfter: actualObj limit: pastSpaceStart. - [objOop < pastSpaceStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: + [^actualObj]]. - [^actualObj]. - actualObj := self objectAfter: objOop limit: pastSpaceStart]. actualObj := nilObj]. + + [actualObj := self objectAfter: actualObj limit: freeOldSpaceStart. + actualObj < freeOldSpaceStart] whileTrue: - actualObj := self objectAfter: actualObj limit: freeOldSpaceStart. - [objOop < freeOldSpaceStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: + [^actualObj]]. - [^actualObj]. - actualObj := self objectAfter: objOop limit: freeOldSpaceStart]. ^nil! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." | sel | sel := thisContext sender method selector. (#( DoIt DoItIn: on:do: "from the debugger" makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: primitiveMakePoint primitiveAsCharacter primitiveInputSemaphore baseFrameReturn primitiveExternalCall primDigitCompare: isLiveContext: numPointerSlotsOf: fileValueOf: loadBitBltDestForm fetchIntOrFloat:ofObject:ifNil: fetchIntOrFloat:ofObject: loadBitBltSourceForm loadPoint:from: primDigitAdd: primDigitSubtract: positive64BitValueOf: digitBitLogic:with:opIndex: + signed32BitValueOf: + isNormalized: + primDigitDiv:negative:) includes: sel) ifFalse: - signed32BitValueOf:) includes: sel) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: SpurMemoryManager>>objectAfter:limit: (in category 'object enumeration') ----- objectAfter: objOop limit: limit "Object parsing. 1. all objects have at least a word following the header, for a forwarding pointer. 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word following an object doesn't have a saturated numSlots field it must be a single-header object. If the word following does have a saturated numSlots it must be the overflow size word." + ^self subclassResponsibility! - | followingWordAddress followingWord | - followingWordAddress := self addressAfter: objOop. - followingWordAddress >= limit ifTrue: - [^limit]. - self flag: #endianness. - followingWord := self longAt: followingWordAddress + 4. - ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ifTrue: [followingWordAddress + self baseHeaderSize] - ifFalse: [followingWordAddress]! Item was changed: ----- Method: StackInterpreter>>printNameOfClass:count: (in category 'debug printing') ----- printNameOfClass: classOop count: cnt "Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object." <inline: false> + (classOop isNil or: [classOop = 0 or: [cnt <= 0]]) ifTrue: [^self print: 'bad class']. - (classOop = 0 or: [cnt <= 0]) ifTrue: [^self print: 'bad class']. ((objectMemory sizeBitsOf: classOop) = metaclassSizeBits and: [metaclassSizeBits > (thisClassIndex * BytesPerOop)]) "(Metaclass instSize * 4)" ifTrue: [self printNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) count: cnt - 1. self print: ' class'] ifFalse: [self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)]! Item was added: + ----- Method: StackInterpreterSimulator>>cloneSimulation (in category 'debug support') ----- + cloneSimulation + | savedDisplayView savedDisplayForm savedQuitBlock savedTranscript | + savedDisplayView := displayView. displayView := nil. + savedDisplayForm := displayForm. displayForm = nil. + savedQuitBlock := quitBlock. quitBlock := nil. + savedTranscript := transcript. transcript := nil. + + [| clone window | + clone := self veryDeepCopy. + window := clone openAsMorph. + window setLabel: 'Clone of ', (savedDisplayView containingWindow label allButFirst: 'Simulation of ' size)] + ensure: + [displayView := savedDisplayView. + displayForm = savedDisplayForm. + quitBlock := savedQuitBlock. + transcript := savedTranscript]! Item was changed: ----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') ----- openAsMorph "Open a morphic view on this simulation." | window localImageName | localImageName := imageName ifNotNil: [FileDirectory default localNameFor: imageName] ifNil: [' synthetic image']. window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self. window addMorph: (displayView := ImageMorph new image: displayForm) frame: (0@0 corner: 1(a)0.8). transcript := TranscriptStream on: (String new: 10000). window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil readSelection: nil menu: #codePaneMenu:shifted:) frame: (0(a)0.8 corner: 0.7@1). window addMorph: (PluggableTextMorph on: self text: #byteCountText accept: nil readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely frame: (0.7(a)0.8 corner: 1@1). window openInWorldExtent: (self desiredDisplayExtent + (2 * window borderWidth) + (0@window labelHeight) + * (1(a)(1/0.8))) rounded. + ^window! - * (1(a)(1/0.8))) rounded! Item was changed: ----- Method: StackInterpreterSimulator>>run (in category 'testing') ----- run "Just run" + quitBlock := [displayView ifNotNil: + [displayView containingWindow ifNotNil: + [:topWindow| + ((World submorphs includes: topWindow) + and: [UIManager default confirm: 'close?']) ifTrue: + [topWindow delete]]]. - quitBlock := [| topWindow | - - (displayView notNil - and: [topWindow := displayView outermostMorphThat: - [:m| m isSystemWindow and: [World submorphs includes: m]]. - topWindow notNil - and: [UIManager default confirm: 'close?']]) ifTrue: - [topWindow delete]. ^self]. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. atEachStepBlock value. "N.B. may be nil" self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. localIP := localIP - 1. "undo the pre-increment of IP before returning" self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') ----- runWithBreakCount: theBreakCount "Just run, halting when byteCount is reached" + quitBlock := [displayView ifNotNil: + [displayView containingWindow ifNotNil: + [:topWindow| + ((World submorphs includes: topWindow) + and: [UIManager default confirm: 'close?']) ifTrue: + [topWindow delete]]]. - quitBlock := [| topWindow | - - (displayView notNil - and: [topWindow := displayView outermostMorphThat: - [:m| m isSystemWindow and: [World submorphs includes: m]]. - topWindow notNil - and: [UIManager default confirm: 'close?']]) ifTrue: - [topWindow delete]. ^self]. breakCount := theBreakCount. self initStackPages. self loadInitialContext. self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. localIP := localIP - 1. "undo the pre-increment of IP before returning" self externalizeIPandSP! Item was changed: ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') ----- utilitiesMenu: aMenuMorph aMenuMorph add: 'toggle transcript' action: #toggleTranscript; + add: 'clone VM' action: #cloneSimulation; addLine; add: 'print ext head frame' action: #printExternalHeadFrame; add: 'print int head frame' action: #printHeadFrame; add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer]; add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP]; add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer]; add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP]; add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]]; add: 'print call stack' action: #printCallStack; add: 'print stack call stack' action: #printStackCallStack; add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]]; add: 'print all stacks' action: #printAllStacks; add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP. self writeBackHeadFramePointers]; addLine; add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]]; add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]]; addLine; add: 'inspect object memory' target: objectMemory action: #inspect; add: 'inspect cointerpreter' action: #inspect; addLine; add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'. s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]]; add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'. s notEmpty ifTrue: [self setBreakSelector: s]]; add: (printSends ifTrue: ['no print sends'] ifFalse: ['print sends']) action: [self ensureDebugAtEachStepBlock. printSends := printSends not]; "currently printReturns does nothing" "add: (printReturns ifTrue: ['no print returns'] ifFalse: ['print returns']) action: [self ensureDebugAtEachStepBlock. printReturns := printReturns not];" add: (printBytecodeAtEachStep ifTrue: ['no print bytecode each bytecode'] ifFalse: ['print bytecode each bytecode']) action: [self ensureDebugAtEachStepBlock. printBytecodeAtEachStep := printBytecodeAtEachStep not]; add: (printFrameAtEachStep ifTrue: ['no print frame each bytecode'] ifFalse: ['print frame each bytecode']) action: [self ensureDebugAtEachStepBlock. printFrameAtEachStep := printFrameAtEachStep not]. ^aMenuMorph!

1 0

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

23 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.405.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.405 Author: eem Time: 23 September 2013, 9:40:28.87 am UUID: 85f4af17-796e-433f-afc4-aeecc29cfd1a Ancestors: VMMaker.oscog-eem.404 Refactor SpurMemoryManager and the 64Bit & 32Bit subclasses in the light of longAt:[put:] accessing 64-bits in the 64-bit system. Fix termination condition in scavenge loop to accomodate mapInterpreterOops (move mapInterpreterOops next to scavengeRememberedSetStartingAt:). Fix SpurMemMgr>>initializeOldSpaceFirstFree: for the bootstrap's dual use (create, then launch). Fix a slip in allocateOldSpaceChunkOfBytes:. Add a simulator subclass to the scavenger and add a nice pre-scavenge halt for debugging. Also collect corpse->forwarded info for debugging. =============== Diff against VMMaker.oscog-eem.404 =============== Item was added: + ----- Method: Spur32BitMMLESimulator>>scavengingGC (in category 'generation scavenging') ----- + scavengingGC + "Run the scavenger." + self halt: (statScavenges + 1) printString, (#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th'), ' scavenge'. + ^super scavengingGC! Item was removed: - ----- Method: Spur32BitMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- - adjustFieldsAndClassOf: oop by: offsetBytes - "Adjust all pointers in this object by the given offset." - | fieldAddr fieldOop | - <inline: true> - <asmLabel: false> - fieldAddr := oop + (self lastPointerOf: oop). - [self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue: - [fieldOop := self longAt: fieldAddr. - (self isImmediate: fieldOop) ifFalse: - [self longAt: fieldAddr put: fieldOop + offsetBytes]. - fieldAddr := fieldAddr - BytesPerOop]! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | 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). - 16 bytes otherwise (slot size 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" - self assert: numBytes \\ self allocationUnit = 0. freeStart + numBytes > scavengeThreshold ifTrue: [needGCFlag ifFalse: [self scheduleScavenge]. freeStart + numBytes > scavenger eden limit ifTrue: [^self allocateSlotsInOldSpace: numSlots 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 removed: - ----- Method: Spur32BitMemoryManager>>checkHeapIntegrity (in category 'debug support') ----- - checkHeapIntegrity - "Perform an integrity/leak check using the heapMap. Assume - clearLeakMapAndMapAccessibleObjects has set a bit at each - object's header. Scan all objects in the heap checking that every - pointer points to a header. Scan the rootTable, remapBuffer and - extraRootTable checking that every entry is a pointer to a header. - Check that the number of roots is correct and that all rootTable - entries have their rootBit set. Answer if all checks pass." - | prevObj prevPrevObj ok numRememberedRootsInHeap | - <inline: false> - ok := true. - numRememberedRootsInHeap := 0. - self allHeapEntitiesDo: - [:obj| | containsYoung fieldOop classIndex classOop | - (self isFreeObject: obj) ifFalse: - [containsYoung := false. - (self isRemembered: obj) ifTrue: - [numRememberedRootsInHeap := numRememberedRootsInHeap + 1. - (scavenger isInRememberedTable: obj) ifFalse: - [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr. - self eek. - ok := false]]. - (self isForwarded: obj) - ifTrue: - [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. - (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: - [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. - self eek. - ok := false]. - (self isYoung: fieldOop) ifTrue: - [containsYoung := true]] - ifFalse: - [classOop := self classAtIndex: (classIndex := self classIndexOf: obj). - (classOop isNil or: [classOop = nilObj]) ifTrue: - [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; printHex: classOop; cr. - self eek. - ok := false]. - self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do: - [:ptr| - fieldOop := self longAt: obj + ptr. - (self isNonImmediate: fieldOop) ifTrue: - [| fi | - fi := ptr - self baseHeaderSize / self wordSize. - (fieldOop bitAnd: self wordSize - 1) ~= 0 - ifTrue: - [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. - self eek. - ok := false] - ifFalse: - [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: - [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. - self eek. - ok := false]. - (self isYoung: fieldOop) ifTrue: - [containsYoung := true]]]]]. - (containsYoung and: [(self isYoung: obj) not]) ifTrue: - [(self isRemembered: obj) ifFalse: - [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr. - self eek. - ok := false]]]. - prevPrevObj := prevObj. - prevObj := obj]. - numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue: - [coInterpreter - print: 'root count mismatch. #heap roots '; - printNum: numRememberedRootsInHeap; - print: '; #roots '; - printNum: scavenger rememberedSetSize; - cr. - "But the system copes with overflow..." - self flag: 'no support for remembered set overflow yet'. - "ok := rootTableOverflowed and: [needGCFlag]"]. - scavenger rememberedSetWithIndexDo: - [:obj :i| - (obj bitAnd: self wordSize - 1) ~= 0 - ifTrue: - [coInterpreter print: 'misaligned oop in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr. - self eek. - ok := false] - ifFalse: - [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 - ifTrue: - [coInterpreter print: 'object leak in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr. - self eek. - ok := false] - ifFalse: - [(self isYoung: obj) ifTrue: - [coInterpreter print: 'non-root in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr. - self eek. - ok := false]]]]. - self flag: 'no support for remap buffer yet'. - "1 to: remapBufferCount do: - [:ri| - obj := remapBuffer at: ri. - (obj bitAnd: self wordSize - 1) ~= 0 - ifTrue: - [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr. - self eek. - ok := false] - ifFalse: - [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 - ifTrue: - [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr. - self eek. - ok := false]]]." - self flag: 'no support for extraRoots yet'. - "1 to: extraRootCount do: - [:ri| - obj := (extraRoots at: ri) at: 0. - (obj bitAnd: self wordSize - 1) ~= 0 - ifTrue: - [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr. - self eek. - ok := false] - ifFalse: - [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 - ifTrue: - [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr. - self eek. - ok := false]]]." - ^ok! Item was removed: - ----- Method: Spur32BitMemoryManager>>classIndexOf: (in category 'header access') ----- - classIndexOf: objOop - self flag: #endianness. - ^(self longAt: objOop) bitAnd: self classIndexMask! Item was removed: - ----- Method: Spur32BitMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') ----- - fetchPointer: fieldIndex ofFreeChunk: objOop - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was removed: - ----- Method: Spur32BitMemoryManager>>fetchPointer:ofMaybeForwardedObject: (in category 'heap management') ----- - fetchPointer: fieldIndex ofMaybeForwardedObject: objOop - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was removed: - ----- Method: Spur32BitMemoryManager>>fetchPointer:ofObject: (in category 'object access') ----- - fetchPointer: fieldIndex ofObject: objOop - self assert: (self isForwarded: objOop) not. - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was removed: - ----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'allocation') ----- - fillObj: objOop numSlots: numSlots with: fillValue - objOop + self baseHeaderSize - to: objOop + self baseHeaderSize + (numSlots * 4) - 1 - by: self allocationUnit - do: [:p| - self assert: p < (self addressAfter: objOop). - self longAt: p put: fillValue; - longAt: p + 4 put: fillValue]! Item was removed: - ----- Method: Spur32BitMemoryManager>>formatOf: (in category 'object access') ----- - formatOf: objOop - "0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6 unused, reserved for exotic pointer objects? - 7 Forwarded Object, 1st field is pointer, rest of fields are ignored - 8 unused, reserved for exotic non-pointer objects? - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - self flag: #endianness. - ^(self longAt: objOop) >> self formatShift bitAnd: self formatMask! Item was removed: - ----- Method: Spur32BitMemoryManager>>initSpaceForAllocationCheck: (in category 'allocation') ----- - initSpaceForAllocationCheck: aNewSpace - CheckObjectOverwrite ifTrue: - [aNewSpace start - to: aNewSpace limit - 1 - by: self wordSize - do: [:p| self longAt: p put: p]]! Item was removed: - ----- Method: Spur32BitMemoryManager>>printMemoryFrom:to: (in category 'debug printing') ----- - printMemoryFrom: start to: end - <doNotGenerate> - | address | - address := start bitAnd: (BytesPerWord - 1) bitInvert. - [address < end] whileTrue: - [coInterpreter printHex: address; printChar: $:; space; printHex: (self longAt: address); cr. - address := address + BytesPerWord]! Item was added: + ----- Method: Spur32BitMemoryManager>>setClassIndexOf:to: (in category 'header access') ----- + setClassIndexOf: objOop to: classIndex + self assert: (classIndex between: 0 and: self classIndexMask). + self flag: #endianness. + self longAt: objOop + put: ((self longAt: objOop) bitAnd: self classIndexMask bitInvert32) + + classIndex! Item was added: + ----- Method: Spur32BitMemoryManager>>setFormatOf:to: (in category 'header access') ----- + setFormatOf: objOop to: format + "0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 unused, reserved for exotic pointer objects? + 7 Forwarded Object, 1st field is pointer, rest of fields are ignored + 8 unused, reserved for exotic non-pointer objects? + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" + self assert: (format between: 0 and: self formatMask). + self flag: #endianness. + self longAt: objOop + put: ((self longAt: objOop) bitAnd: (self formatMask << self formatShift) bitInvert32) + + (format << self formatShift)! Item was added: + ----- Method: Spur32BitMemoryManager>>setHashBitsOf:to: (in category 'header access') ----- + setHashBitsOf: objOop to: hash + self flag: #endianness. + self assert: (hash between: 0 and: self identityHashHalfWordMask). + self longAt: objOop + 4 + put: ((self longAt: objOop + 4) bitClear: self identityHashHalfWordMask) + hash! Item was added: + ----- Method: Spur32BitMemoryManager>>setIsRememberedOf:to: (in category 'header access') ----- + setIsRememberedOf: objOop to: aBoolean + self flag: #endianness. + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self rememberedBitShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self rememberedBitShift) bitInvert32])! Item was removed: - ----- Method: Spur32BitMemoryManager>>storePointer:ofForwarder:withValue: (in category 'heap management') ----- - storePointer: fieldIndex ofForwarder: objOop withValue: valuePointer - - self assert: (self isForwarded: objOop). - self assert: (self isOopForwarded: valuePointer) not. - - (self isYoung: objOop) ifFalse: "most stores into young objects" - [((self isNonImmediate: valuePointer) and: [self isYoung: valuePointer]) ifTrue: - [self possibleRootStoreInto: objOop]]. - - ^self - longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: Spur32BitMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- - storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer - - self assert: (self isFreeObject: objOop). - - ^self - longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: Spur32BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- - storePointer: fieldIndex ofObject: objOop withValue: valuePointer - "Note must check here for stores of young objects into old ones." - self assert: (self isForwarded: objOop) not. - - (self isYoung: objOop) ifFalse: "most stores into young objects" - [(self isImmediate: valuePointer) ifFalse: - [(self isYoung: valuePointer) ifTrue: - [self possibleRootStoreInto: objOop]]]. - - ^self - longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: Spur32BitMemoryManager>>storePointerUnchecked:ofMaybeForwardedObject:withValue: (in category 'object access') ----- - storePointerUnchecked: fieldIndex ofMaybeForwardedObject: objOop withValue: valuePointer - ^self - longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: Spur32BitMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- - storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer - self assert: (self isForwarded: objOop) not. - ^self - longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was changed: ----- Method: Spur64BitMemoryManager>>addressAfter: (in category 'object enumeration') ----- addressAfter: objOop "Answer the address immediately following an object." | numSlots slotBytes | + numSlots := self numSlotsOfAny: objOop. - numSlots := self numSlotsOf: objOop. slotBytes := numSlots = 0 ifTrue: [self allocationUnit] ifFalse: [numSlots << self shiftForWord]. ^objOop + self baseHeaderSize + slotBytes! Item was removed: - ----- Method: Spur64BitMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- - adjustFieldsAndClassOf: oop by: offsetBytes - "Adjust all pointers in this object by the given offset." - | fieldAddr fieldOop | - <inline: true> - <asmLabel: false> - fieldAddr := oop + (self lastPointerOf: oop). - [self oop: fieldAddr isGreaterThan: oop] whileTrue: - [fieldOop := self longAt: fieldAddr. - (self isIntegerObject: fieldOop) ifFalse: - [self longLongAt: fieldAddr put: fieldOop + offsetBytes]. - fieldAddr := fieldAddr - BytesPerWord]! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | 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 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. - freeStart := freeStart + numBytes. ^newObj! Item was added: + ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- + allocateSlotsInOldSpace: numSlots 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." + | bytes chunk | + bytes := self objectBytesForSlots: numSlots. + chunk := self allocateOldSpaceChunkOfBytes: bytes. + 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 changed: ----- Method: Spur64BitMemoryManager>>bytesInObject: (in category 'object enumeration') ----- bytesInObject: objOop "Answer the total number of bytes in an object including header and possible overflow size header." + | header headerNumSlots numSlots | - | halfHeader headerNumSlots numSlots | self flag: #endianness. + header := self longAt: objOop. + headerNumSlots := header >> self numSlotsFullShift bitAnd: self numSlotsMask. - "numSlotsOf: should not be applied to free or forwarded objects." - self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun. - halfHeader := self longAt: objOop + 4. - headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. numSlots := headerNumSlots = self numSlotsMask + ifTrue: [header bitAnd: 16rFFFFFFFFFFFFFF] + ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]]. - ifTrue: [self longAt: objOop - self baseHeaderSize] - ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. ^numSlots << self shiftForWord + (headerNumSlots = self numSlotsMask ifTrue: [self baseHeaderSize + self baseHeaderSize] ifFalse: [self baseHeaderSize])! Item was removed: - ----- Method: Spur64BitMemoryManager>>classIndexOf: (in category 'header access') ----- - classIndexOf: objOop - ^(self longLongAt: objOop) bitAnd: self classIndexMask! Item was removed: - ----- Method: Spur64BitMemoryManager>>fetchPointer:ofObject: (in category 'object access') ----- - fetchPointer: fieldIndex ofObject: objOop - self assert: (self isForwarded: objOop) not. - ^self longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was removed: - ----- Method: Spur64BitMemoryManager>>formatOf: (in category 'object access') ----- - formatOf: objOop - "0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6 unused, reserved for exotic pointer objects? - 7 Forwarded Object, 1st field is pointer, rest of fields are ignored - 8 unused, reserved for exotic non-pointer objects? - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - ^(self longLongAt: objOop) >> self formatShift bitAnd: self formatMask! Item was changed: ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') ----- 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) ifTrue: [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. + 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" - self longLongAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; - longLongAt: 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 longAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" - self longLongAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" ^address! Item was removed: - ----- Method: Spur64BitMemoryManager>>longFormatForNumBytes: (in category 'header format') ----- - longFormatForNumBytes: numBytes - "Answer firstLongFormat with the odd bit set if numBytes is an odd number of 4-byte units." - ^self firstLongFormat + (numBytes >> 2 bitAnd: 1)! Item was added: + ----- Method: Spur64BitMemoryManager>>setClassIndexOf:to: (in category 'header access') ----- + setClassIndexOf: objOop to: classIndex + self assert: (classIndex between: 0 and: self classIndexMask). + self longAt: objOop + put: ((self longAt: objOop) bitAnd: self classIndexMask bitInvert64) + + classIndex! Item was added: + ----- Method: Spur64BitMemoryManager>>setFormatOf:to: (in category 'header access') ----- + setFormatOf: objOop to: format + "0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 unused, reserved for exotic pointer objects? + 7 Forwarded Object, 1st field is pointer, rest of fields are ignored + 8 unused, reserved for exotic non-pointer objects? + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" + self assert: (format between: 0 and: self formatMask). + objOop + put: ((self longAt: objOop) bitAnd: (self formatMask << self formatShift) bitInvert64) + + (format << self formatShift)! Item was added: + ----- Method: Spur64BitMemoryManager>>setHashBitsOf:to: (in category 'header access') ----- + setHashBitsOf: objOop to: hash + self assert: (hash between: 0 and: self identityHashFullWordMask). + self longAt: objOop + put: ((self longAt: objOop) bitClear: self identityHashFullWordMask) + hash! Item was added: + ----- Method: Spur64BitMemoryManager>>setIsRememberedOf:to: (in category 'header access') ----- + setIsRememberedOf: objOop to: aBoolean + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self rememberedBitShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self rememberedBitShift) bitInvert64])! Item was removed: - ----- Method: Spur64BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- - storePointer: fieldIndex ofObject: objOop withValue: valuePointer - "Note must check here for stores of young objects into old ones." - self assert: (self isForwarded: objOop) not. - - (self isYoung: objOop) ifFalse: "most stores into young objects" - [(self isImmediate: valuePointer) ifFalse: - [(self isYoung: valuePointer) ifTrue: - [self possibleRootStoreInto: objOop]]]. - - ^self - longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: Spur64BitMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- - storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer - self assert: (self isForwarded: objOop) not. - ^self - longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was changed: ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') ----- scavengeLoop "This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from the promoted. This loop continues until no more reachable objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as detecting closure. If this were not true, some pointers might get forwarded twice." | firstTime previousRememberedSetSize previousFutureSurvivorStart | self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start" firstTime := true. previousRememberedSetSize := 0. previousFutureSurvivorStart := futureSurvivorStart. [self scavengeRememberedSetStartingAt: previousRememberedSetSize. + firstTime ifTrue: + [coInterpreter mapInterpreterOops. + firstTime := false]. + "northing more copied and forwarded to scavenge so scavenge is done." previousFutureSurvivorStart = futureSurvivorStart ifTrue: [^self]. previousRememberedSetSize := rememberedSetSize. - firstTime ifTrue: - [coInterpreter mapInterpreterOops. - firstTime := false]. - self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart. + "no more roots created to scavenge, so scavenge is done." previousRememberedSetSize = rememberedSetSize ifTrue: [^self]. previousFutureSurvivorStart := futureSurvivorStart] repeat! Item was added: + SpurGenerationScavenger subclass: #SpurGenerationScavengerSimulator + instanceVariableNames: 'comeFroms' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-SpurMemoryManagerSimulation'! Item was added: + ----- Method: SpurGenerationScavengerSimulator>>copyAndForward: (in category 'scavenger') ----- + copyAndForward: survivor + | newLocation | + survivor = 16r19BC60 ifTrue: [self halt]. + newLocation := super copyAndForward: survivor. + comeFroms at: newLocation put: survivor. + ^newLocation! Item was added: + ----- Method: SpurGenerationScavengerSimulator>>scavenge (in category 'scavenger') ----- + scavenge + comeFroms := Dictionary new. + ^super scavenge! Item was changed: ----- Method: SpurMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- adjustFieldsAndClassOf: oop by: offsetBytes "Adjust all pointers in this object by the given offset." + | fieldAddr fieldOop | + <inline: true> + <asmLabel: false> + fieldAddr := oop + (self lastPointerOf: oop). + [self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue: + [fieldOop := self longAt: fieldAddr. + (self isNonImmediate: fieldOop) ifTrue: + [self longAt: fieldAddr put: fieldOop + offsetBytes]. + fieldAddr := fieldAddr - BytesPerOop]! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') ----- allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes "Intialize the receiver for bootsraping an image. Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold will be set to sane values." <doNotGenerate> self assert: (memoryBytes \\ self allocationUnit = 0 and: [newSpaceBytes \\ self allocationUnit = 0 and: [codeBytes \\ self allocationUnit = 0]]). memory := (self endianness == #little ifTrue: [LittleEndianBitmap] ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4. startOfMemory := codeBytes. endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes. "leave newSpace empty for the bootstrap" freeStart := newSpaceBytes + startOfMemory. newSpaceLimit := newSpaceBytes + startOfMemory. scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array" + scavenger := SpurGenerationScavengerSimulator new - scavenger := SpurGenerationScavenger new manager: self newSpaceStart: startOfMemory newSpaceBytes: newSpaceBytes edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if 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 chunk nextIndex nodeBytes parent child smaller larger | totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" index := chunkBytes / self allocationUnit. (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). ^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "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." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [nodeBytes := self bytesInObject: child. parent := child. nodeBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). + ^self startOfObject: chunk]. - ^chunk]. child := 0] "break out of loop to remove interior node" ifFalse:"walk down the tree" [child := self fetchPointer: (nodeBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: child]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "no list; remove an interior node" chunk := parent. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. "coInterpreter transcript ensureCr. coInterpreter print: 'new free tree root '. (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. coInterpreter cr." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S |" self halt. "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" self halt! Item was changed: ----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') ----- checkHeapIntegrity "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects has set a bit at each object's header. Scan all objects in the heap checking that every pointer points to a header. Scan the rootTable, remapBuffer and extraRootTable checking that every entry is a pointer to a header. Check that the number of roots is correct and that all rootTable entries have their rootBit set. Answer if all checks pass." + | prevObj prevPrevObj ok numRememberedRootsInHeap | + <inline: false> + ok := true. + numRememberedRootsInHeap := 0. + self allHeapEntitiesDo: + [:obj| | containsYoung fieldOop classIndex classOop | + (self isFreeObject: obj) ifFalse: + [containsYoung := false. + (self isRemembered: obj) ifTrue: + [numRememberedRootsInHeap := numRememberedRootsInHeap + 1. + (scavenger isInRememberedTable: obj) ifFalse: + [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr. + self eek. + ok := false]]. + (self isForwarded: obj) + ifTrue: + [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. + (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: + [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. + self eek. + ok := false]. + (self isYoung: fieldOop) ifTrue: + [containsYoung := true]] + ifFalse: + [classOop := self classAtIndex: (classIndex := self classIndexOf: obj). + (classOop isNil or: [classOop = nilObj]) ifTrue: + [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr. + self eek. + ok := false]. + self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do: + [:ptr| + fieldOop := self longAt: obj + ptr. + (self isNonImmediate: fieldOop) ifTrue: + [| fi | + fi := ptr - self baseHeaderSize / self wordSize. + (fieldOop bitAnd: self wordSize - 1) ~= 0 + ifTrue: + [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. + self eek. + ok := false] + ifFalse: + [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: + [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. + self eek. + ok := false]. + (self isYoung: fieldOop) ifTrue: + [containsYoung := true]]]]]. + (containsYoung and: [(self isYoung: obj) not]) ifTrue: + [(self isRemembered: obj) ifFalse: + [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr. + self eek. + ok := false]]]. + prevPrevObj := prevObj. + prevObj := obj]. + numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue: + [coInterpreter + print: 'root count mismatch. #heap roots '; + printNum: numRememberedRootsInHeap; + print: '; #roots '; + printNum: scavenger rememberedSetSize; + cr. + "But the system copes with overflow..." + self flag: 'no support for remembered set overflow yet'. + "ok := rootTableOverflowed and: [needGCFlag]"]. + scavenger rememberedSetWithIndexDo: + [:obj :i| + (obj bitAnd: self wordSize - 1) ~= 0 + ifTrue: + [coInterpreter print: 'misaligned oop in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr. + self eek. + ok := false] + ifFalse: + [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 + ifTrue: + [coInterpreter print: 'object leak in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr. + self eek. + ok := false] + ifFalse: + [(self isYoung: obj) ifTrue: + [coInterpreter print: 'non-root in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr. + self eek. + ok := false]]]]. + self flag: 'no support for remap buffer yet'. + "1 to: remapBufferCount do: + [:ri| + obj := remapBuffer at: ri. + (obj bitAnd: self wordSize - 1) ~= 0 + ifTrue: + [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr. + self eek. + ok := false] + ifFalse: + [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 + ifTrue: + [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr. + self eek. + ok := false]]]." + self flag: 'no support for extraRoots yet'. + "1 to: extraRootCount do: + [:ri| + obj := (extraRoots at: ri) at: 0. + (obj bitAnd: self wordSize - 1) ~= 0 + ifTrue: + [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr. + self eek. + ok := false] + ifFalse: + [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 + ifTrue: + [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr. + self eek. + ok := false]]]." + ^ok! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>classIndexOf: (in category 'header access') ----- classIndexOf: objOop + ^(self longAt: objOop) bitAnd: self classIndexMask! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') ----- fetchPointer: fieldIndex ofFreeChunk: objOop + ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>fetchPointer:ofMaybeForwardedObject: (in category 'heap management') ----- fetchPointer: fieldIndex ofMaybeForwardedObject: objOop + ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop + self assert: (self isForwarded: objOop) not. + ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>fillObj:numSlots:with: (in category 'allocation') ----- fillObj: objOop numSlots: numSlots with: fillValue + objOop + self baseHeaderSize + to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1 + by: self allocationUnit + do: [:p| + self assert: p < (self addressAfter: objOop). + self longAt: p put: fillValue; + longAt: p + 4 put: fillValue]! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>formatOf: (in category 'object access') ----- formatOf: objOop "0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 unused, reserved for exotic pointer objects? 7 Forwarded Object, 1st field is pointer, rest of fields are ignored 8 unused, reserved for exotic non-pointer objects? 9 (?) 64-bit indexable 10 - 11 32-bit indexable 12 - 15 16-bit indexable 16 - 23 byte indexable 24 - 31 compiled method" + ^(self longAt: objOop) >> self formatShift bitAnd: self formatMask! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>initSpaceForAllocationCheck: (in category 'allocation') ----- initSpaceForAllocationCheck: aNewSpace + CheckObjectOverwrite ifTrue: + [aNewSpace start + to: aNewSpace limit - 1 + by: self wordSize + do: [:p| self longAt: p put: p]]! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> + + endOfMemory > startOfFreeOldSpace ifTrue: + [totalFreeOldSpace := totalFreeOldSpace + (endOfMemory - startOfFreeOldSpace). + freeOldStart := startOfFreeOldSpace. + [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: + [freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart. + freeOldStart := freeOldStart + (2 raisedTo: 32). + self assert: freeOldStart = (self addressAfter: freeChunk)]. + freeOldStart < endOfMemory ifTrue: + [freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. + self assert: (self addressAfter: freeChunk) = endOfMemory]]. - freeOldStart := startOfFreeOldSpace. - [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: - [freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart. - freeOldStart := freeOldStart + (2 raisedTo: 32). - self assert: freeOldStart = (self addressAfter: freeChunk)]. - freeOldStart < endOfMemory ifTrue: - [freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. - self assert: (self addressAfter: freeChunk) = endOfMemory]. freeOldSpaceStart := endOfMemory. self assert: totalFreeOldSpace = self totalFreeListBytes! Item was changed: ----- Method: SpurMemoryManager>>isRemembered: (in category 'header access') ----- isRemembered: objOop - self flag: #endianness. ^((self longAt: objOop) >> self rememberedBitShift bitAnd: 1) ~= 0! Item was removed: - ----- Method: SpurMemoryManager>>longFormatForNumBytes: (in category 'header format') ----- - longFormatForNumBytes: numBytes - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>printMemoryFrom:to: (in category 'debug printing') ----- printMemoryFrom: start to: end + <doNotGenerate> + | address | + address := start bitAnd: (self wordSize - 1) bitInvert. + [address < end] whileTrue: + [coInterpreter printHex: address; printChar: $:; space; printHex: (self longAt: address); cr. + address := address + BytesPerWord]! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>setClassIndexOf:to: (in category 'header access') ----- setClassIndexOf: objOop to: classIndex + self subclassResponsibility! - self flag: #endianness. - self longAt: objOop - put: ((self longAt: objOop) bitAnd: self classIndexMask bitInvert32) - + classIndex! Item was changed: ----- Method: SpurMemoryManager>>setFormatOf:to: (in category 'header access') ----- setFormatOf: objOop to: format "0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 unused, reserved for exotic pointer objects? 7 Forwarded Object, 1st field is pointer, rest of fields are ignored 8 unused, reserved for exotic non-pointer objects? 9 (?) 64-bit indexable 10 - 11 32-bit indexable 12 - 15 16-bit indexable 16 - 23 byte indexable 24 - 31 compiled method" + self subclassResponsibility! - self flag: #endianness. - self longAt: objOop - put: ((self longAt: objOop) bitAnd: (self formatMask << self formatShift) bitInvert32) - + (format << self formatShift)! Item was changed: ----- Method: SpurMemoryManager>>setHashBitsOf:to: (in category 'header access') ----- setHashBitsOf: objOop to: hash + self subclassResponsibility! - self flag: #endianness. - self assert: (hash between: 0 and: self identityHashHalfWordMask). - self longAt: objOop + 4 - put: ((self longAt: objOop + 4) bitClear: self identityHashHalfWordMask) + hash! Item was changed: ----- Method: SpurMemoryManager>>setIsRememberedOf:to: (in category 'header access') ----- setIsRememberedOf: objOop to: aBoolean + self subclassResponsibility! - self flag: #endianness. - self longAt: objOop - put: (aBoolean - ifTrue: [(self longAt: objOop) bitOr: 1 << self rememberedBitShift] - ifFalse: [(self longAt: objOop) bitAnd: (1 << self rememberedBitShift) bitInvert32])! Item was added: + ----- Method: SpurMemoryManager>>shiftForWord (in category 'word size') ----- + shiftForWord + ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>storeByte:ofObject:withValue: (in category 'object access') ----- storeByte: byteIndex ofObject: oop withValue: valueByte + ^self byteAt: oop + self baseHeaderSize + byteIndex put: valueByte! - ^self byteAt: oop + BaseHeaderSize + byteIndex put: valueByte! Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofForwarder:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofForwarder: objOop withValue: valuePointer + self assert: (self isForwarded: objOop). + self assert: (self isOopForwarded: valuePointer) not. + + (self isYoung: objOop) ifFalse: "most stores into young objects" + [((self isNonImmediate: valuePointer) and: [self isYoung: valuePointer]) ifTrue: + [self possibleRootStoreInto: objOop]]. + + ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer + self assert: (self isFreeObject: objOop). + + ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- + storePointer: fieldIndex ofObject: objOop withValue: valuePointer - storePointer: fieldIndex ofObject: oop withValue: valuePointer "Note must check here for stores of young objects into old ones." + self assert: (self isForwarded: objOop) not. + + (self isYoung: objOop) ifFalse: "most stores into young objects" + [(self isImmediate: valuePointer) ifFalse: + [(self isYoung: valuePointer) ifTrue: + [self possibleRootStoreInto: objOop]]]. + + ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! - ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>storePointerUnchecked:ofMaybeForwardedObject:withValue: (in category 'object access') ----- + storePointerUnchecked: fieldIndex ofMaybeForwardedObject: objOop withValue: valuePointer + ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! Item was changed: ----- Method: SpurMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer + self assert: (self isForwarded: objOop) not. + ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! - ^self subclassResponsibility!

1 0

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

23 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.404.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.404 Author: eem Time: 23 September 2013, 9:04:39.698 am UUID: fae95a07-0615-4c4d-99d8-b515df1e9464 Ancestors: VMMaker.oscog-eem.403 Repair the SistaStackToRegisterMappingCogit. Major fix is to reimplement SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: after framelessness changes. Also make sure that ObjectMemory>>remapObj: is not <api>. Fix some slips (e.g. missing period in StackInterpreter>>snapshot:). Make sure that InterpreterPrimitives>>primitiveBehaviorHash cuts back the stack by argumentCount for use by Newspeak VM mirrors. Nuke unused longFormatForNumBytes: =============== Diff against VMMaker.oscog-eem.403 =============== Item was changed: ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') ----- addMethodFor: aClass selector: selector "Add the given method to the code base and answer its translation or nil if it shouldn't be translated." | method tmethod | method := aClass compiledMethodAt: selector. (method pragmaAt: #doNotGenerate) ifNotNil: [^nil]. "process optional methods by interpreting the argument to the option: pragma as either a Cogit class name or a class variable name or a variable name in VMBasicConstants." (method pragmaAt: #option:) ifNotNil: [:pragma| | key | key := pragma argumentAt: 1. ((Cogit withAllSubclasses anySatisfy: [:c| c name = key]) and: [VMClass getVMMaker cogitClassName ~= key]) ifTrue: [^nil]. (aClass bindingOf: key) ifNotNil: [:binding| + binding value == false ifTrue: [^nil]]. - binding value ifFalse: [^nil]]. (VMBasicConstants bindingOf: key) ifNotNil: [:binding| + binding value == false ifTrue: [^nil]]]. - binding value ifFalse: [^nil]]]. tmethod := self addMethod: (self compileToTMethodSelector: selector in: aClass). "If the method has a macro then add the macro. But keep the method for analysis purposes (e.g. its variable accesses)." (method pragmaAt: #cmacro:) ifNotNil: [:pragma| self addMacro: (pragma argumentAt: 1) for: selector. tmethod inline: false]. (method propertyValueAt: #cmacro:) ifNotNil: [:macro| self addMacro: macro for: selector. tmethod inline: false]. ^tmethod! Item was added: + ----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') ----- + followForwardingPointersInStackZone: becomeEffectsFlags + "Spur's become: is lazy, turning the becommed object into a forwarding object to the other. + The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe, + since notionally objects' internals are accessed only via sending messages to them (the exception + is primitives that access the internals of the non-receiver argument(s).. + To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods + in the stack zone and follow any forwarded ones. This is of course way cheaper than scanning all + of memory as in the old become." + | theIPPtr | + <inline: false> + <var: #thePage type: #'StackPage *'> + <var: #theSP type: #'char *'> + <var: #theFP type: #'char *'> + <var: #callerFP type: #'char *'> + <var: #theIPPtr type: #'char *'> + + (becomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue: + [(objectMemory isForwarded: method) ifTrue: + [theIPPtr := instructionPointer - method. + method := objectMemory followForwarded: method. + instructionPointer := method + theIPPtr]. + (objectMemory isForwarded: newMethod) ifTrue: + [newMethod := objectMemory followForwarded: newMethod]]. + + self assert: stackPage ~= 0. + 0 to: numStackPages - 1 do: + [:i| | thePage theSP theFP callerFP oop offset | + thePage := stackPages stackPageAt: i. + thePage isFree ifFalse: + [theSP := thePage headSP. + theFP := thePage headFP. + "Skip the instruction pointer on top of stack of inactive pages." + thePage = stackPage + ifTrue: [theIPPtr := 0] + ifFalse: + [theIPPtr := theSP. + theSP := theSP + BytesPerWord]. + [self assert: (thePage addressIsInPage: theFP). + self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]). + offset := theFP + (self frameStackedReceiverOffset: theFP). + oop := stackPages longAt: offset. + ((objectMemory isNonImmediate: oop) + and: [(objectMemory isForwarded: oop)]) ifTrue: + [stackPages + longAt: offset + put: (objectMemory followForwarded: oop)]. + ((self frameHasContext: theFP) + and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue: + [stackPages + longAt: theFP + FoxThisContext + put: (objectMemory followForwarded: (self frameContext: theFP))]. + (self isMachineCodeFrame: theFP) + ifTrue: + [oop := stackPages longAt: theFP + FoxIFReceiver. + ((objectMemory isNonImmediate: oop) + and: [(objectMemory isForwarded: oop)]) ifTrue: + [stackPages + longAt: theFP + FoxIFReceiver + put: (objectMemory followForwarded: oop)]. + self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not] + ifFalse: + [oop := stackPages longAt: theFP + FoxIFReceiver. + ((objectMemory isNonImmediate: oop) + and: [(objectMemory isForwarded: oop)]) ifTrue: + [stackPages + longAt: theFP + FoxIFReceiver + put: (objectMemory followForwarded: oop)]. + oop := self frameMethod: theFP. + (objectMemory isForwarded: oop) ifTrue: + [| delta | + delta := (objectMemory followForwarded: oop) - oop. + (theIPPtr ~= 0 + and: [(stackPages longAt: theIPPtr) > (self frameMethod: theFP)]) ifTrue: + [stackPages + longAt: theIPPtr + put: (stackPages longAt: theIPPtr) + delta]. + stackPages + longAt: theFP + FoxIFSavedIP + put: (stackPages longAt: theFP + FoxIFSavedIP) + delta. + stackPages + longAt: theFP + FoxMethod + put: (objectMemory followForwarded: oop)]]. + self followNecessaryForwardingInMethod: (self frameMethod: theFP). + (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: + [theIPPtr := theFP + FoxCallerSavedIP. + theFP := callerFP]]]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBehaviorHash (in category 'object access primitives') ----- primitiveBehaviorHash | hashOrError | self assert: ((objectMemory isNonImmediate: self stackTop) and: [self addressCouldBeClassObj: self stackTop]). hashOrError := objectMemory ensureBehaviorHash: self stackTop. hashOrError >= 0 + ifTrue: [self pop: argumentCount + 1 thenPushInteger: hashOrError] - ifTrue: [self pop: 1 thenPushInteger: hashOrError] ifFalse: [self primitiveFailFor: hashOrError negated]! Item was added: + ----- Method: ObjectMemory>>isIndexableFormat: (in category 'header access') ----- + isIndexableFormat: format + ^format >= self arrayFormat + and: [format <= self weakArrayFormat + or: [format >= self firstLongFormat]]! Item was removed: - ----- Method: ObjectMemory>>longFormatForNumBytes: (in category 'header access') ----- - longFormatForNumBytes: numBytes - "In ObjectMemory the odd bits for 32-bit indexable objects, needed in the 64-bit VM, is - not stored in the format field." - ^self firstLongFormat! Item was changed: ----- Method: ObjectMemory>>remapObj: (in category 'gc -- compaction') ----- remapObj: obj - <api> "Map the given oop to its new value during a compaction or become: operation." <inline: false> ^self remappedObj: obj! Item was changed: ----- Method: SistaStackToRegisterMappingCogit>>allocateCounters (in category 'initialization') ----- allocateCounters "Allocate the structures used to manage counting conditional branch compilation. This needs to be a macro since the structures are alloca'ed (stack allocated) to ensure their being freed when compilation is done." <cmacro: '() do { \ counters = numCounters ? alloca(sizeof(AbstractInstruction) * numCounters) : 0; \ } while (0)'> counters := CArrayAccessor on: ((1 to: numCounters) collect: + [:ign| backEnd class new])! - [:ign| CogAbstractInstruction new])! Item was changed: ----- Method: SistaStackToRegisterMappingCogit>>fillInCounters:atEndAddress: (in category 'generate machine code') ----- fillInCounters: nCounters atEndAddress: endAddress endAddress - (nCounters * CounterBytes) to: endAddress - CounterBytes + by: CounterBytes do: [:address| objectMemory long32At: address put: (initialCounterValue << 16 + initialCounterValue)]! Item was changed: ----- Method: SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') ----- mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg "Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol for each mcpc, bcpc pair in the map until the function returns non-zero, + answering that result, or 0 if it fails to. This works only for frameful methods." - answering that result, or 0 if it fails to. This works only for frameful methods. - - Override to add the descriptor as the first argument to function." <var: #cogMethod type: #'CogBlockMethod *'> <var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'> <var: #arg type: #'void *'> | isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result latestContinuation byte descriptor bsOffset nExts | <var: #descriptor type: #'BytecodeDescriptor *'> <var: #homeMethod type: #'CogMethod *'> self assert: cogMethod stackCheckOffset > 0. "In both CMMethod and CMBlock cases find the start of the map and skip forward to the bytecode pc map entry for the stack check." cogMethod cmType = CMMethod ifTrue: [isInBlock := false. homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'. self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader). map := self mapStartFor: homeMethod. self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]). latestContinuation := startbcpc. aMethodObj := homeMethod methodObject. endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1. bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader] ifFalse: [isInBlock := true. homeMethod := cogMethod cmHomeMethod. map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod) inMethod: homeMethod. self assert: map ~= 0. self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial" or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]). [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue: [map := map - 1]. map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header." aMethodObj := homeMethod methodObject. bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader). bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader. byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset. descriptor := self generatorAt: byte. endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj]. bcpc := startbcpc. mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset. nExts := 0. "as a hack for collecting counters, remember the prev mcpc in a static variable." prevMapAbsPCMcpc := 0. "The stack check maps to the start of the first bytecode, the first bytecode being effectively after frame build." result := self perform: functionSymbol with: nil with: (self cCoerceSimple: mcpc to: #'char *') with: startbcpc with: arg. result ~= 0 ifTrue: [^result]. "Now skip up through the bytecode pc map entry for the stack check." [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue: [map := map - 1]. map := map - 1. [(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc" [mapByte >= FirstAnnotation ifTrue: [| annotation nextBcpc | annotation := mapByte >> AnnotationShift. mcpc := mcpc + (mapByte bitAnd: DisplacementMask). (self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue: [[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset. descriptor := self generatorAt: byte. isInBlock ifTrue: [bcpc >= endbcpc ifTrue: [^0]] ifFalse: [(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0]. (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue: [| targetPC | targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj. latestContinuation := latestContinuation max: targetPC]]. nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj. descriptor isMapped or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse: [bcpc := nextBcpc. nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]. "All subsequent bytecodes except backward branches map to the following bytecode. Backward branches map to themselves other- wise mapping could cause premature breaking out of loops." result := self perform: functionSymbol with: descriptor with: (self cCoerceSimple: mcpc to: #'char *') + with: ((descriptor isBranch + and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj]) - with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj) ifTrue: [bcpc] ifFalse: [bcpc + descriptor numBytes]) with: arg. result ~= 0 ifTrue: [^result]. + bcpc := nextBcpc. + nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]. - bcpc := nextBcpc]. annotation = IsAbsPCReference ifTrue: [prevMapAbsPCMcpc := mcpc]] ifFalse: [mcpc := mcpc + (mapByte >= DisplacementX2N ifTrue: [mapByte - DisplacementX2N << AnnotationShift] ifFalse: [mapByte])]. map := map - 1]. ^0! Item was removed: - ----- Method: Spur32BitMemoryManager>>longFormatForNumBytes: (in category 'header format') ----- - longFormatForNumBytes: numBytes - ^self firstLongFormat! Item was changed: ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') ----- followForwardingPointersInStackZone: becomeEffectsFlags "Spur's become: is lazy, turning the becommed object into a forwarding object to the other. The read-barrier is minimised by arranging that forwarding pointers will fail a method cache probe, since notionally objects' internals are accessed only via sending messages to them (the exception is primitives that access the internals of the non-receiver argument(s).. To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and methods in the stack zone and follow any forwarded ones. This is of course way cheaper than scanning all of memory as in the old become." | theIPPtr | <inline: false> <var: #thePage type: #'StackPage *'> <var: #theSP type: #'char *'> <var: #theFP type: #'char *'> <var: #callerFP type: #'char *'> <var: #theIPPtr type: #'char *'> (becomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue: [(objectMemory isForwarded: method) ifTrue: [theIPPtr := instructionPointer - method. method := objectMemory followForwarded: method. instructionPointer := method + theIPPtr]. (objectMemory isForwarded: newMethod) ifTrue: [newMethod := objectMemory followForwarded: newMethod]]. self assert: stackPage ~= 0. 0 to: numStackPages - 1 do: [:i| | thePage theSP theFP callerFP theIP oop | thePage := stackPages stackPageAt: i. thePage isFree ifFalse: [theSP := thePage headSP. theFP := thePage headFP. "Skip the instruction pointer on top of stack of inactive pages." thePage = stackPage ifTrue: [theIPPtr := 0] ifFalse: [theIPPtr := theSP. theSP := theSP + BytesPerWord]. [self assert: (thePage addressIsInPage: theFP). self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]). oop := stackPages longAt: theFP + FoxReceiver. ((objectMemory isNonImmediate: oop) and: [(objectMemory isForwarded: oop)]) ifTrue: [stackPages longAt: theFP + FoxReceiver put: (objectMemory followForwarded: oop)]. theIP := theFP + (self frameStackedReceiverOffset: theFP). "reuse theIP; its just an offset here" oop := stackPages longAt: theIP. ((objectMemory isNonImmediate: oop) and: [(objectMemory isForwarded: oop)]) ifTrue: [stackPages longAt: theIP put: (objectMemory followForwarded: oop)]. ((self frameHasContext: theFP) and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue: [stackPages longAt: theFP + FoxThisContext put: (objectMemory followForwarded: (self frameContext: theFP))]. + oop := self frameMethod: theFP. + (objectMemory isForwarded: oop) ifTrue: + [| delta | + theIPPtr ~= 0 ifTrue: - (objectMemory isForwarded: (self frameMethod: theFP)) ifTrue: - [theIPPtr ~= 0 ifTrue: [self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP). + delta := (objectMemory followForwarded: oop) - oop. + stackPages + longAt: theIPPtr + put: (stackPages longAt: theIPPtr) + delta]. - theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)]. stackPages longAt: theFP + FoxMethod + put: (objectMemory followForwarded: oop)]. - put: (objectMemory followForwarded: (self frameMethod: theFP)). - theIPPtr ~= 0 ifTrue: - [stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]]. self followNecessaryForwardingInMethod: (self frameMethod: theFP). (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: [theIPPtr := theFP + FoxCallerSavedIP. theFP := callerFP]]]! Item was changed: ----- Method: StackInterpreter>>objCouldBeClassObj: (in category 'debug support') ----- objCouldBeClassObj: objOop "Answer if objOop looks like a class object. WIth Spur be lenient if the object doesn't yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers." <inline: false> + | fieldOop | - | field | ^(objectMemory isPointersNonImm: objOop) and: [(objectMemory numSlotsOf: objOop) >= (InstanceSpecificationIndex+1) + and: [fieldOop := objectMemory fetchPointer: SuperclassIndex ofObject: objOop. + ((objectMemory isPointers: fieldOop) - and: [field := objectMemory fetchPointer: SuperclassIndex ofObject: objOop. - ((objectMemory isPointers: field) or: [(objectMemory rawHashBitsOf: objOop) = 0 + and: [(objectMemory isOopForwarded: fieldOop) + and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]]) + and: [fieldOop := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop. + ((objectMemory isPointers: fieldOop) - and: [(objectMemory isOopForwarded: field) - and: [objectMemory isPointers: (objectMemory followForwarded: field)]]]) - and: [field := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop. - ((objectMemory isPointers: field) or: [(objectMemory rawHashBitsOf: objOop) = 0 + and: [(objectMemory isOopForwarded: fieldOop) + and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]]) - and: [(objectMemory isOopForwarded: field) - and: [objectMemory isPointers: (objectMemory followForwarded: field)]]]) and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]! Item was changed: ----- Method: StackInterpreter>>snapshot: (in category 'image save/restore') ----- snapshot: embedded "update state of active context" | activeContext activeProc dataSize rcvr setMacType stackIndex | <var: #setMacType type: 'void *'> + "For now the stack munging below doesn't deal with more than one argument. - "For nowe the stack munging below doesn't deal with more than omne argument. It can, and should." argumentCount ~= 0 ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs]. "Need to convert all frames into contexts since the snapshot file only holds objects." self push: instructionPointer. activeContext := self voidVMStateForSnapshot. "update state of active process" activeProc := self activeProcess. objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: activeContext. objectMemory pushRemappableOop: activeContext. "garbage collect, bereave contexts and flush external methods." self snapshotCleanUp. "Nothing moves from here on so it is safe to grab the activeContext again." activeContext := objectMemory popRemappableOop. dataSize := objectMemory freeStart - objectMemory startOfMemory. "Assume all objects are below the start of the free block" self successful ifTrue: ["Without contexts or stacks simulate + rcvr := self popStack. ''pop rcvr'' - rcvr := self popStack. - ''pop rcvr'' self push: trueObj. to arrange that the snapshot resumes with true. N.B. stackIndex is one-relative." stackIndex := self quickFetchInteger: StackPointerIndex ofObject: activeContext. rcvr := objectMemory fetchPointer: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext. objectMemory storePointerUnchecked: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext withValue: objectMemory trueObject. "now attempt to write the snapshot file" self writeImageFileIO: dataSize. (self successful and: [embedded not]) ifTrue: ["set Mac file type and creator; this is a noop on other platforms" setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'. setMacType = 0 ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']]. "Without contexts or stacks simulate self pop: 1" objectMemory storePointerUnchecked: StackPointerIndex ofObject: activeContext withValue: (objectMemory integerObjectOf: stackIndex - 1)]. self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext. self successful ifTrue: [self push: objectMemory falseObject] ifFalse: [self push: rcvr. self justActivateNewMethod]! Item was changed: ----- Method: StackInterpreter>>snapshotCleanUp (in category 'image save/restore') ----- snapshotCleanUp "Clean up right before saving an image, garbage collecting, sweeping memory and: * nilling out all fields of contexts above the stack pointer. * flushing external primitives * clearing the root bit of any object in the root table * bereaving widowed contexts. By ensuring that all contexts are single in a snapshot (i.e. that no married contexts exist) we can maintain the invariant that a married or widowed context's frame reference (in its sender field) must point into the stack pages since no married or widowed contexts are present from older runs of the system." objectMemory hasSpurMemoryManagerAPI ifTrue: [objectMemory flushNewSpace] + ifFalse: [objectMemory incrementalGC]. "compact memory and compute the size of the memory actually in use" - ifFalse: [objectMemory incrementalGC] "compact memory and compute the size of the memory actually in use" "maximimize space for forwarding table" objectMemory fullGC. objectMemory allObjectsDo: [:obj| | header fmt sz | header := self longAt: obj. fmt := objectMemory formatOfHeader: header. "Clean out context" (fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: header]) ifTrue: ["All contexts have been divorced. Bereave remaining widows." (self isMarriedOrWidowedContext: obj) ifTrue: [self markContextAsDead: obj]. "Fill slots beyond top of stack with nil" (self fetchStackPointerOf: obj) to: (objectMemory numSlotsOf: obj) do: [:i | objectMemory storePointerUnchecked: i + CtxtTempFrameStart ofObject: obj withValue: objectMemory nilObject]]. "Clean out external functions from compiled methods" fmt >= objectMemory firstCompiledMethodFormat ifTrue: ["Its primitiveExternalCall" (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue: [self flushExternalPrimitiveOf: obj]]]. objectMemory hasSpurMemoryManagerAPI ifFalse: [objectMemory clearRootsTable]! Item was changed: ----- Method: VMMaker class>>generateSqueakCogSistaVM (in category 'configurations') ----- generateSqueakCogSistaVM ^VMMaker + generate: CoInterpreter - generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]] - value: #(CoInterpreter CoInterpreterMT))) and: SistaStackToRegisterMappingCogit to: (FileDirectory default pathFromURI: 'oscogvm/sistasrc') platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])!

1 0

VM Maker: Cog-eem.99.mcz
by commits＠source.squeak.org 23 Sep '13

23 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.99.mcz ==================== Summary ==================== Name: Cog-eem.99 Author: eem Time: 22 September 2013, 9:38:48.819 pm UUID: 793a00a6-5411-447d-a231-afc41b4096d2 Ancestors: Cog-eem.98 SpurBootstrap: Reset the saved transfored image's stats =============== Diff against Cog-eem.98 =============== Item was changed: ----- Method: SpurBootstrap>>saveTransformedImage (in category 'development support') ----- saveTransformedImage ImageHeaderFlags := oldInterpreter getImageHeaderFlags. ImageName := oldInterpreter imageName. newHeap coInterpreter: nil. + (newHeap class allInstVarNames select: [:ivn| ivn beginsWith: 'stat']) do: + [:ivn| newHeap instVarNamed: ivn put: 0]. TransformedImage := newHeap veryDeepCopy!

1 0

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

22 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.403.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.403 Author: eem Time: 22 September 2013, 12:08:39.144 pm UUID: 1dd82aad-7f17-40d8-b728-2499d03969df Ancestors: VMMaker.oscog-eem.402 Flush new space on someInstance/someObject =============== Diff against VMMaker.oscog-eem.402 =============== Item was added: + ----- Method: SpurMemoryManager>>firstAccessibleObject (in category 'object enumeration') ----- + firstAccessibleObject + <inline: false> + self assert: nilObj = newSpaceLimit. + "flush newSpace to settle the enumeration." + self flushNewSpace. + ^nilObj! Item was changed: ----- Method: SpurMemoryManager>>flushNewSpace (in category 'generation scavenging') ----- flushNewSpace | savedTenuringThreshold | savedTenuringThreshold := scavenger getRawTenuringThreshold. scavenger setRawTenuringThreshold: newSpaceLimit. + self scavengingGC. - self sufficientSpaceAfterGC: 0. scavenger setRawTenuringThreshold: savedTenuringThreshold. self assert: scavenger rememberedSetSize = 0. self assert: pastSpaceStart = scavenger pastSpace start. self assert: freeStart = scavenger eden start! Item was changed: ----- Method: SpurMemoryManager>>initialInstanceOf: (in category 'object enumeration') ----- initialInstanceOf: classObj <inline: false> | classIndex | classIndex := self rawHashBitsOf: classObj. classIndex = 0 ifTrue: [^nil]. + "flush newSpace to settle the enumeration." + self flushNewSpace. self allObjectsDo: [:objOop| classIndex = (self classIndexOf: objOop) ifTrue: [^objOop]]. ^nil!

1 0

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

22 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.402.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.402 Author: eem Time: 22 September 2013, 9:12:45.57 am UUID: 1609c567-42bc-4442-8d9e-ab5df5c7d4ca Ancestors: VMMaker.oscog-eem.401 Implement low space handling and space queries to SpurMemMgr. Maintain totalFreeOldSpace in a variable. Rewrite primitiveIncrementalGC to interface to Spur. Fix assert in iframeInstructionPointerForIndex:method: BytesPerWord => BytesPerOop in initialPCForHeader:method: =============== Diff against VMMaker.oscog-eem.401 =============== Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | 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 (slot size 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" self assert: numBytes \\ self allocationUnit = 0. freeStart + numBytes > scavengeThreshold ifTrue: + [needGCFlag ifFalse: [self scheduleScavenge]. + freeStart + numBytes > scavenger eden limit ifTrue: + [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]]. - [freeStart + numBytes > scavenger eden limit ifTrue: - [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. - self scheduleScavenge]. 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>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | 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 format: formatField classIndex: classIndex]]. - [freeStart + numBytes > scavenger eden limit ifTrue: - [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. - self scheduleScavenge]. 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)]. freeStart := freeStart + numBytes. ^newObj! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if 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 chunk nextIndex nodeBytes parent child smaller larger | + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" index := chunkBytes / self allocationUnit. (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). ^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "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." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [nodeBytes := self bytesInObject: child. parent := child. nodeBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^chunk]. child := 0] "break out of loop to remove interior node" ifFalse:"walk down the tree" [child := self fetchPointer: (nodeBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: child]]. parent = 0 ifTrue: + [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" + self halt]. + - [self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "no list; remove an interior node" chunk := parent. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. "coInterpreter transcript ensureCr. coInterpreter print: 'new free tree root '. (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. coInterpreter cr." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S |" self halt. "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" self halt! Item was added: + ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') ----- + bytesInFreeTree: freeNode + | freeBytes bytesInObject next | + freeNode = 0 ifTrue: [^0]. + freeBytes := 0. + bytesInObject := self bytesInObject: freeNode. + self assert: bytesInObject / self allocationUnit >= NumFreeLists. + next := freeNode. + [next ~= 0] whileTrue: + [freeBytes := freeBytes + bytesInObject. + self assert: bytesInObject = (self bytesInObject: next). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next]. + ^freeBytes + + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: next)) + + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: next))! Item was added: + ----- Method: SpurMemoryManager>>bytesLeft: (in category 'free space') ----- + bytesLeft: includeSwapSpace + "Answer the amount of available free space. If includeSwapSpace is true, include + possibly available swap space. If includeSwapSpace is false, include possibly available + physical memory. For a report on the largest free block currently availabe within + Squeak memory but not counting extra memory use #primBytesLeft." + ^totalFreeOldSpace + + (scavenger eden limit - freeStart) + + (scavenger pastSpace limit - pastSpaceStart) + + (scavenger futureSpace limit - scavenger futureSpace limit)! Item was added: + ----- Method: SpurMemoryManager>>classMutex (in category 'plugin support') ----- + classMutex + ^self splObj: ClassMutex! Item was added: + ----- Method: SpurMemoryManager>>classSemaphore (in category 'plugin support') ----- + classSemaphore + ^self splObj: ClassSemaphore! Item was changed: ----- Method: SpurMemoryManager>>freeObject: (in category 'free space') ----- freeObject: objOop + | bytes | + bytes := self bytesInObject: objOop. + totalFreeOldSpace := totalFreeOldSpace + bytes. + ^self freeChunkWithBytes: bytes at: (self startOfObject: objOop)! - ^self freeChunkWithBytes: (self bytesInObject: objOop) at: (self startOfObject: objOop)! Item was changed: ----- Method: SpurMemoryManager>>freeSize (in category 'free space') ----- freeSize + ^totalFreeOldSpace! - self flag: #temporary. - ^0! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializatins that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0). remapBuffer := Array new: RemapBufferSize. remapBufferCount := 0. + freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. - freeListsMask := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. "We can also initialize here anything that is only for simulation." heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]! Item was changed: ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> freeOldStart := startOfFreeOldSpace. [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: [freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart. freeOldStart := freeOldStart + (2 raisedTo: 32). self assert: freeOldStart = (self addressAfter: freeChunk)]. freeOldStart < endOfMemory ifTrue: [freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. self assert: (self addressAfter: freeChunk) = endOfMemory]. + freeOldSpaceStart := endOfMemory. + self assert: totalFreeOldSpace = self totalFreeListBytes! - freeOldSpaceStart := endOfMemory! Item was added: + ----- Method: SpurMemoryManager>>lowSpaceThreshold: (in category 'free space') ----- + lowSpaceThreshold: threshold + lowSpaceThreshold := threshold. + totalFreeOldSpace < threshold ifTrue: + [self growOldSpaceByAtLeast: threshold - totalFreeOldSpace]. + self assert: totalFreeOldSpace >= lowSpaceThreshold! Item was added: + ----- Method: SpurMemoryManager>>scavengingGC (in category 'generation scavenging') ----- + scavengingGC + "Run the scavenger." + + self assert: remapBufferCount = 0. + self assert: self totalFreeListBytes = totalFreeOldSpace. + "coInterpreter printCallStackFP: coInterpreter framePointer" + + self runLeakCheckerForFullGC: false. + coInterpreter preGCAction: GCModeIncr. + needGCFlag := false. + + gcStartUsecs := coInterpreter ioUTCMicrosecondsNow. + + scavengeInProgress := true. + pastSpaceStart := scavenger scavenge. + self assert: (self + oop: pastSpaceStart + isGreaterThanOrEqualTo: scavenger pastSpace start + andLessThanOrEqualTo: scavenger pastSpace limit). + freeStart := scavenger eden start. + self initSpaceForAllocationCheck: scavenger eden. + scavengeInProgress := false. + + statScavenges := statScavenges + 1. + statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow. + statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs. + statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs. + + coInterpreter postGCAction. + self runLeakCheckerForFullGC: false. + + self assert: self totalFreeListBytes = totalFreeOldSpace! Item was changed: ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') ----- sufficientSpaceAfterGC: numBytes "This is ObjectMemory's funky entry-point into its incremental GC, which is a stop-the-world a young generation reclaimer. In Spur + we run the scavenger. Answer if space is not low." - we run the scavenger." - self assert: numBytes = 0. - self assert: remapBufferCount = 0. - "coInterpreter printCallStackFP: coInterpreter framePointer" + self assert: numBytes = 0. + self scavengingGC. + lowSpaceThreshold > totalFreeOldSpace ifTrue: "space is low" + [lowSpaceThreshold := 0. "avoid signalling low space twice" + ^false]. - self runLeakCheckerForFullGC: false. - coInterpreter preGCAction: GCModeIncr. - needGCFlag := false. - - gcStartUsecs := coInterpreter ioUTCMicrosecondsNow. - - scavengeInProgress := true. - pastSpaceStart := scavenger scavenge. - self assert: (self - oop: pastSpaceStart - isGreaterThanOrEqualTo: scavenger pastSpace start - andLessThanOrEqualTo: scavenger pastSpace limit). - freeStart := scavenger eden start. - self initSpaceForAllocationCheck: scavenger eden. - scavengeInProgress := false. - - statScavenges := statScavenges + 1. - statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow. - statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs. - statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs. - - coInterpreter postGCAction. - self runLeakCheckerForFullGC: false. - ^true! Item was added: + ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') ----- + totalFreeListBytes + | freeBytes bytesInObject obj | + freeBytes := 0. + 1 to: NumFreeLists - 1 do: + [:i| + bytesInObject := i * self allocationUnit. + obj := freeLists at: i. + [obj ~= 0] whileTrue: + [freeBytes := freeBytes + bytesInObject. + self assert: bytesInObject = (self bytesInObject: obj). + obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]]. + ^freeBytes + (self bytesInFreeTree: (freeLists at: 0))! Item was changed: ----- Method: StackInterpreter>>iframeInstructionPointerForIndex:method: (in category 'frame access') ----- iframeInstructionPointerForIndex: ip method: aMethod "Answer the instruction pointer for use in an interpreter frame (a pointer to a bytecode)." + self assert: (ip between: (((LiteralStart + (self literalCountOf: aMethod)) * BytesPerOop)) + 1 - self assert: (ip between: (objectMemory lastPointerOf: aMethod) - 1 and: (objectMemory lengthOf: aMethod)). ^aMethod + ip + objectMemory baseHeaderSize - 2! Item was changed: ----- Method: StackInterpreter>>initialPCForHeader:method: (in category 'compiled methods') ----- initialPCForHeader: methodHeader method: theMethod <api> + ^theMethod + + ((LiteralStart + (self literalCountOfHeader: methodHeader)) * BytesPerOop) + + objectMemory baseHeaderSize! - ^theMethod + ((LiteralStart + (self literalCountOfHeader: methodHeader)) * BytesPerWord) + BaseHeaderSize! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveIncrementalGC (in category 'memory space primitives') ----- primitiveIncrementalGC "Do a quick, incremental garbage collection and return the number of bytes immediately available. (Note: more space may be made available by doing a full garbage collection." self externalWriteBackHeadFramePointers. + objectMemory hasSpurMemoryManagerAPI + ifTrue: [objectMemory scavengingGC] + ifFalse: [objectMemory incrementalGC]. - objectMemory incrementalGC. self pop: 1 thenPushInteger: (objectMemory bytesLeft: false)! Item was changed: ----- Method: StackInterpreterSimulator>>primitiveIdentityHash (in category 'debugging traps') ----- primitiveIdentityHash + "| oop | - | oop | oop := self stackTop. ((objectMemory isBytes: oop) and: [(objectMemory lengthOf: oop) = 'smallSelect' size and: [(self stringOf: oop) = 'smallSelect']]) ifTrue: + [self halt]." - [self halt]. ^super primitiveIdentityHash!

1 0

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

21 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.401.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.401 Author: eem Time: 21 September 2013, 8:48:57.895 am UUID: d0d762fc-2668-4ebc-b4a3-047bb4899a53 Ancestors: VMMaker.oscog-eem.400 Fix stupid slip in SpurMemMgr>>hashBitsOf:, answer what's set!! Add size and nicer contents printing to longPrintOop: Skip separators in promptHex: =============== Diff against VMMaker.oscog-eem.400 =============== Item was changed: ----- Method: SpurMemoryManager>>hashBitsOf: (in category 'header access') ----- hashBitsOf: objOop | hash | hash := self rawHashBitsOf: objOop. hash = 0 ifTrue: ["would like to assert self assert: (coInterpreter addressCouldBeClassObj: objOop) not but instance-specific behaviors that are instances of themselves may fail this test." + hash := self newObjectHash bitAnd: self identityHashHalfWordMask. + self setHashBitsOf: objOop to: hash]. - hash := self newObjectHash. - self setHashBitsOf: objOop to: (hash bitAnd: self identityHashHalfWordMask)]. ^hash! Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <api> | class fmt lastIndex startIP bytecodesPerLine column | ((objectMemory isImmediate: oop) or: [(objectMemory addressCouldBeObj: oop) not or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 or: [(objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]]]]) ifTrue: [^self printOop: oop]. class := objectMemory fetchClassOfNonImm: oop. self printHex: oop; print: ': a(n) '; printNameOfClass: class count: 5; print: ' ('; printHex: class; print: ')'. fmt := objectMemory formatOf: oop. self print: ' format '; printHexnp: fmt. + fmt > objectMemory lastPointerFormat + ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)] + ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue: + [| len | + len := objectMemory lengthOf: oop. + self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]]. - fmt > objectMemory lastPointerFormat ifTrue: - [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]. objectMemory printHeaderTypeOf: oop. self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: [^self]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:i| | fieldOop | fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop. self space; printNum: i - 1; space; printHex: fieldOop; space. (i = 1 and: [objectMemory isCompiledMethod: oop]) ifTrue: [self printMethodHeaderOop: fieldOop] + ifFalse: [self cCode: [self printOopShort: fieldOop] + inSmalltalk: [self print: (self shortPrint: fieldOop)]]. - ifFalse: [self printOopShort: fieldOop]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * BytesPerWord + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)' inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", byte,byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was added: + ----- Method: StackInterpreterSimulator>>primitiveIdentityHash (in category 'debugging traps') ----- + primitiveIdentityHash + | oop | + oop := self stackTop. + ((objectMemory isBytes: oop) + and: [(objectMemory lengthOf: oop) = 'smallSelect' size + and: [(self stringOf: oop) = 'smallSelect']]) ifTrue: + [self halt]. + ^super primitiveIdentityHash! Item was changed: ----- Method: VMClass>>promptHex: (in category 'simulation support') ----- promptHex: string <doNotGenerate> | s | s := UIManager default request: string, ' (hex)'. + s := s withBlanksTrimmed. ^s notEmpty ifTrue: [(s includes: $r) ifTrue: [Number readFrom: s readStream] ifFalse: [(#('0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil: [:prefix| s := s allButFirst: prefix size. prefix first = $- ifTrue: [s := '-', s]]. Integer readFrom: s readStream base: 16]]!

1 0

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

21 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.400.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.400 Author: eem Time: 21 September 2013, 7:46:26.362 am UUID: 3481cf9c-80d0-47db-b5c4-07102f7ea255 Ancestors: VMMaker.oscog-eem.399 Make the Inflate/DeflatePlugin simulate. Simplify loadColorMapShiftOrMaskFrom: & others; isWords:, isBytes: et al check for immediates already. Add printHexnp: for unpadded hex printing & use in longPrintOop:. Add a print stack call stack to print less stack :) =============== Diff against VMMaker.oscog-eem.399 =============== Item was changed: ----- Method: BitBltSimulation>>loadColorMapShiftOrMaskFrom: (in category 'interpreter interface') ----- loadColorMapShiftOrMaskFrom: mapOop <returnTypeC:'void *'> mapOop = interpreterProxy nilObject ifTrue:[^nil]. - (interpreterProxy isIntegerObject: mapOop) - ifTrue:[interpreterProxy primitiveFail. ^nil]. ((interpreterProxy isWords: mapOop) and:[(interpreterProxy slotSizeOf: mapOop) = 4]) ifFalse:[interpreterProxy primitiveFail. ^nil]. ^interpreterProxy firstIndexableField: mapOop! Item was added: + ----- Method: InflatePlugin class>>simulatorClass (in category 'simulation') ----- + simulatorClass + "For running from Smalltalk - answer a class that can be used to simulate the receiver, + or nil if you want the primitives in this module to always fail, causing simulation to fall + through to the Smalltalk code. By default every non-TestInterpreterPlugin can simulate itself." + + ^DeflatePlugin! Item was changed: ----- Method: InflatePlugin>>primitiveInflateDecompressBlock (in category 'primitives') ----- primitiveInflateDecompressBlock "Primitive. Inflate a single block." | oop rcvr | <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. - interpreterProxy methodArgumentCount = 2 ifFalse:[^interpreterProxy primitiveFail]. "distance table" + oop := interpreterProxy stackValue: 0. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy stackObjectValue: 0. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isWords: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipDistTable := interpreterProxy firstIndexableField: oop. zipDistTableSize := interpreterProxy slotSizeOf: oop. "literal table" + oop := interpreterProxy stackValue: 1. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy stackObjectValue: 1. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isWords: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipLitTable := interpreterProxy firstIndexableField: oop. zipLitTableSize := interpreterProxy slotSizeOf: oop. "Receiver (InflateStream)" + rcvr := interpreterProxy stackValue: 2. + (interpreterProxy isPointers: rcvr) ifFalse: + [^interpreterProxy primitiveFail]. - rcvr := interpreterProxy stackObjectValue: 2. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isPointers: rcvr) - ifFalse:[^interpreterProxy primitiveFail]. (interpreterProxy slotSizeOf: rcvr) < 9 ifTrue:[^interpreterProxy primitiveFail]. "All the integer instvars" zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. zipState := interpreterProxy fetchInteger: 3 ofObject: rcvr. zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr. zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr. zipSourcePos := interpreterProxy fetchInteger: 7 ofObject: rcvr. zipSourceLimit := interpreterProxy fetchInteger: 8 ofObject: rcvr. interpreterProxy failed ifTrue:[^nil]. zipReadLimit := zipReadLimit - 1. zipSourcePos := zipSourcePos - 1. zipSourceLimit := zipSourceLimit - 1. "collection" oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop. "source" oop := interpreterProxy fetchPointer: 6 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipSource := interpreterProxy firstIndexableField: oop. "do the primitive" self zipDecompressBlock. + interpreterProxy failed ifFalse: "store modified values back" + [interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1. - interpreterProxy failed ifFalse:[ - "store modified values back" - interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1. interpreterProxy storeInteger: 3 ofObject: rcvr withValue: zipState. interpreterProxy storeInteger: 4 ofObject: rcvr withValue: zipBitBuf. interpreterProxy storeInteger: 5 ofObject: rcvr withValue: zipBitPos. interpreterProxy storeInteger: 7 ofObject: rcvr withValue: zipSourcePos + 1. + interpreterProxy pop: 2]! - interpreterProxy pop: 2. - ].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveIntegerAt (in category 'sound primitives') ----- primitiveIntegerAt "Return the 32bit signed integer contents of a words receiver" | index rcvr sz addr value intValue | <var: #intValue type: 'int'> index := self stackIntegerValue: 0. self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackValue: 1. + (objectMemory isWords: rcvr) ifFalse: - ((objectMemory isIntegerObject: rcvr) - or: [(objectMemory isWords: rcvr) not]) ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. sz := objectMemory lengthOf: rcvr. "number of fields" ((index >= 1) and: [index <= sz]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + "4 = 32 bits / 8" + addr := rcvr + objectMemory baseHeaderSize + (index - 1 * 4). "for zero indexing" + value := objectMemory intAt: addr. - addr := rcvr + BaseHeaderSize + (index - 1 * BytesPerWord). "for zero indexing" - value := self intAt: addr. self pop: 2. "pop rcvr, index" "push element value" (objectMemory isIntegerValue: value) ifTrue: [self pushInteger: value] ifFalse: [intValue := value. "32 bit int may have been stored in 32 or 64 bit sqInt" self push: (self signed32BitIntegerFor: intValue)] "intValue may be sign extended to 64 bit sqInt"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category 'sound primitives') ----- primitiveIntegerAtPut "Return the 32bit signed integer contents of a words receiver" | index rcvr sz addr value valueOop | <var: 'value' type: 'int'> valueOop := self stackValue: 0. index := self stackIntegerValue: 1. value := self signed32BitValueOf: valueOop. self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackValue: 2. + (objectMemory isWords: rcvr) ifFalse: - ((objectMemory isIntegerObject: rcvr) - or: [(objectMemory isWords: rcvr) not]) ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. sz := objectMemory lengthOf: rcvr. "number of fields" (index >= 1 and: [index <= sz]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + "4 = 32 bits / 8" + addr := rcvr + objectMemory baseHeaderSize + (index - 1 * 4). "for zero indexing" + value := objectMemory intAt: addr put: value. - addr := rcvr + BaseHeaderSize + (index - 1 * BytesPerWord). "for zero indexing" - value := self intAt: addr put: value. self pop: 3 thenPush: valueOop "pop all; return value" ! Item was added: + ----- Method: Spur32BitMMLESimulator>>intAt:put: (in category 'memory access') ----- + intAt: byteAddress put: a32BitValue + ^self longAt: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF)! Item was added: + ----- Method: Spur32BitMMLESimulator>>storeInteger:ofObject:withValue: (in category 'simulation only') ----- + storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." | sel | sel := thisContext sender method selector. (#( DoIt DoItIn: on:do: "from the debugger" makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: primitiveMakePoint primitiveAsCharacter primitiveInputSemaphore baseFrameReturn primitiveExternalCall primDigitCompare: isLiveContext: numPointerSlotsOf: fileValueOf: loadBitBltDestForm fetchIntOrFloat:ofObject:ifNil: fetchIntOrFloat:ofObject: loadBitBltSourceForm loadPoint:from: primDigitAdd: primDigitSubtract: + positive64BitValueOf: + digitBitLogic:with:opIndex: + signed32BitValueOf:) includes: sel) ifFalse: - positive64BitValueOf:) includes: sel) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <api> | class fmt lastIndex startIP bytecodesPerLine column | ((objectMemory isImmediate: oop) or: [(objectMemory addressCouldBeObj: oop) not or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 or: [(objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]]]]) ifTrue: [^self printOop: oop]. class := objectMemory fetchClassOfNonImm: oop. self printHex: oop; print: ': a(n) '; printNameOfClass: class count: 5; print: ' ('; printHex: class; print: ')'. fmt := objectMemory formatOf: oop. + self print: ' format '; printHexnp: fmt. - self print: ' format '; printHex: fmt. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]. objectMemory printHeaderTypeOf: oop. + self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop). - self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: [^self]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:i| | fieldOop | fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop. self space; printNum: i - 1; space; printHex: fieldOop; space. (i = 1 and: [objectMemory isCompiledMethod: oop]) ifTrue: [self printMethodHeaderOop: fieldOop] ifFalse: [self printOopShort: fieldOop]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * BytesPerWord + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)' inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", byte,byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was changed: ----- Method: StackInterpreter>>printCallStackOf: (in category 'debug printing') ----- + printCallStackOf: aContextOrProcessOrFrame - printCallStackOf: aContextOrProcess <api> | context | <inline: false> <var: #theFP type: #'char *'> + (stackPages couldBeFramePointer: aContextOrProcessOrFrame) ifTrue: + [^self printCallStackFP: (self cCoerceSimple: aContextOrProcessOrFrame to: #'char *')]. + ((objectMemory isContext: aContextOrProcessOrFrame) not + and: [(objectMemory lengthOf: aContextOrProcessOrFrame) > MyListIndex - ((objectMemory isContext: aContextOrProcess) not - and: [(objectMemory lengthOf: aContextOrProcess) > MyListIndex and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex + ofObject: aContextOrProcessOrFrame)]]) ifTrue: - ofObject: aContextOrProcess)]]) ifTrue: [^self printCallStackOf: (objectMemory fetchPointer: SuspendedContextIndex + ofObject: aContextOrProcessOrFrame)]. + context := aContextOrProcessOrFrame. - ofObject: aContextOrProcess)]. - context := aContextOrProcess. [context = objectMemory nilObject] whileFalse: [(self isMarriedOrWidowedContext: context) ifTrue: [(self checkIsStillMarriedContext: context currentFP: framePointer) ifFalse: [self shortPrintContext: context. ^nil]. context := self shortReversePrintFrameAndCallers: (self frameOfMarriedContext: context)] ifFalse: [context := self printContextCallStackOf: context]]! Item was added: + ----- Method: StackInterpreter>>printHexnp: (in category 'debug printing') ----- + printHexnp: n + "Print n in hex, in the form '0x1234', unpadded" + self print: '0x%x' f: n! Item was added: + ----- Method: StackInterpreter>>printStackCallStack (in category 'debug printing') ----- + printStackCallStack + <doNotGenerate> + | theFP context | + theFP := localFP. + [context := self shortReversePrintFrameAndCallers: theFP. + ((self isMarriedOrWidowedContext: context) + and: [self checkIsStillMarriedContext: context currentFP: localFP]) ifFalse: + [^nil]. + theFP := self frameOfMarriedContext: context] repeat! Item was added: + ----- Method: StackInterpreterSimulator>>printHexnp: (in category 'debug printing') ----- + printHexnp: anInteger + + traceOn ifTrue: + [transcript nextPutAll: (anInteger storeStringBase: 16)]! Item was changed: ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') ----- utilitiesMenu: aMenuMorph aMenuMorph add: 'toggle transcript' action: #toggleTranscript; addLine; add: 'print ext head frame' action: #printExternalHeadFrame; add: 'print int head frame' action: #printHeadFrame; add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer]; add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP]; add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer]; add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP]; add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]]; add: 'print call stack' action: #printCallStack; + add: 'print stack call stack' action: #printStackCallStack; add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]]; add: 'print all stacks' action: #printAllStacks; + add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP. + self writeBackHeadFramePointers]; addLine; add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]]; add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]]; addLine; add: 'inspect object memory' target: objectMemory action: #inspect; add: 'inspect cointerpreter' action: #inspect; addLine; add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'. s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]]; add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'. s notEmpty ifTrue: [self setBreakSelector: s]]; add: (printSends ifTrue: ['no print sends'] ifFalse: ['print sends']) action: [self ensureDebugAtEachStepBlock. printSends := printSends not]; "currently printReturns does nothing" "add: (printReturns ifTrue: ['no print returns'] ifFalse: ['print returns']) action: [self ensureDebugAtEachStepBlock. printReturns := printReturns not];" add: (printBytecodeAtEachStep ifTrue: ['no print bytecode each bytecode'] ifFalse: ['print bytecode each bytecode']) action: [self ensureDebugAtEachStepBlock. printBytecodeAtEachStep := printBytecodeAtEachStep not]; add: (printFrameAtEachStep ifTrue: ['no print frame each bytecode'] ifFalse: ['print frame each bytecode']) action: [self ensureDebugAtEachStepBlock. printFrameAtEachStep := printFrameAtEachStep not]. ^aMenuMorph!

1 0

← Newer
1
2
3
4
5
6
7
...
16
Older →

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