Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.557.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.557 Author: eem Time: 11 December 2013, 1:43:49.106 pm UUID: 5837253f-a896-43ac-bcc6-816e923030e7 Ancestors: VMMaker.oscog-eem.556
Spur: Fix bug in swizzleObjStackAt: that was stopping a snapshot starting.
More assert checks in free tree enumeration.
Fix new space enumeration assert for image bootstrap.
Fix bug in freeChunk print method & add a free list printing method.
=============== Diff against VMMaker.oscog-eem.556 ===============
Item was changed: ----- Method: Spur32BitMMLESimulator>>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: bytesOrInt:growTo: primitiveNewMethod isCogMethodReference: functionForPrimitiveExternalCall: genSpecialSelectorArithmetic genSpecialSelectorComparison ensureContextHasBytecodePC: instVar:ofContext: ceBaseFrameReturn: inlineCacheTagForInstance: primitiveObjectAtPut commonVariable:at:put:cacheIndex: primDigitBitShiftMagnitude: externalInstVar:ofContext: primitiveGrowMemoryByAtLeast + primitiveFileSetPosition + bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:) includes: sel) ifFalse: - primitiveFileSetPosition) includes: sel) ifFalse: [self halt]. ^super isIntegerObject: oop!
Item was changed: ----- Method: SpurMemoryManager>>allNewSpaceEntitiesDo: (in category 'object enumeration') ----- allNewSpaceEntitiesDo: aBlock "Enumerate all new space objects, including free objects." <inline: true> | prevObj prevPrevObj objOop limit | prevPrevObj := prevObj := nil. "After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are in pastSpace. Objects are allocated in eden. So enumerate only pastSpace and eden." + self assert: (self bootstrapping or: [scavenger pastSpace start < scavenger eden start]). - self assert: scavenger pastSpace start < scavenger eden start. objOop := self objectStartingAt: scavenger pastSpace start. limit := pastSpaceStart. [self oop: objOop isLessThan: limit] whileTrue: [aBlock value: objOop. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: limit]. objOop := self objectStartingAt: scavenger eden start. [self oop: objOop isLessThan: freeStart] whileTrue: [aBlock value: objOop. prevPrevObj := prevObj. prevObj := objOop. objOop := self objectAfter: objOop limit: freeStart]. self touch: prevPrevObj. self touch: prevObj!
Item was changed: ----- Method: SpurMemoryManager>>freeTreeNodesDo: (in category 'free space') ----- freeTreeNodesDo: aBlock "Enumerate all nodes in the free tree (in order, smaller to larger), but *not* including the next nodes of the same size off each tree node. This is an iterative version so that the block argument can be inlined by Slang. The trick to an iterative binary tree application is to apply the function on the way back up when returning from a particular direction, in this case up from the larger child.
N.B For the convenience of rebuildFreeTreeFromSortedFreeChunks aBlock *MUST* answer the freeTreeNode it was invoked with, or its replacement if it was replaced by aBlock." <inline: true> | treeNode cameFrom | treeNode := freeLists at: 0. treeNode = 0 ifTrue: [^self]. cameFrom := -1. [| smallChild largeChild | smallChild := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode. largeChild := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode. + self assert: (smallChild = 0 or: [treeNode = (self fetchPointer: self freeChunkParentIndex ofFreeChunk: smallChild)]). + self assert: (largeChild = 0 or: [treeNode = (self fetchPointer: self freeChunkParentIndex ofFreeChunk: largeChild)]). "apply if the node has no children, or it has no large children and we're returning from the small child, or we're returning from the large child." ((smallChild = 0 and: [largeChild = 0]) or: [largeChild = 0 ifTrue: [cameFrom = smallChild] ifFalse: [cameFrom = largeChild]]) ifTrue: [treeNode := aBlock value: treeNode. "and since we've applied we must move on up" cameFrom := treeNode. treeNode := self fetchPointer: self freeChunkParentIndex ofFreeChunk: treeNode] ifFalse: [(smallChild ~= 0 and: [cameFrom ~= smallChild]) ifTrue: [treeNode := smallChild] ifFalse: [self assert: largeChild ~= 0. treeNode := largeChild]. cameFrom := -1]. treeNode ~= 0] whileTrue!
Item was changed: ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') ----- printFreeChunk: freeChunk <api> | numBytes | numBytes := self bytesInObject: freeChunk. coInterpreter print: 'freeChunk '; printHexPtrnp: freeChunk; print: ' bytes '; printNum: numBytes; print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk). + numBytes / self allocationUnit >= self numFreeLists ifTrue: - numBytes / self allocationUnit > self numFreeLists ifTrue: [coInterpreter print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex ofFreeChunk: freeChunk); print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk); print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeChunk)]. coInterpreter cr!
Item was added: + ----- Method: SpurMemoryManager>>printFreeList: (in category 'debug printing') ----- + printFreeList: chunkOrIndex + <api> + | freeChunk | + (chunkOrIndex >= 0 and: [chunkOrIndex < self numFreeLists]) ifTrue: + [^self printFreeList: (freeLists at: chunkOrIndex)]. + freeChunk := chunkOrIndex. + [freeChunk ~= 0] whileTrue: + [self printFreeChunk: freeChunk. + freeChunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk]!
Item was changed: ----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') ----- swizzleObjStackAt: objStackRootIndex "On load, swizzle the pointers in an obj stack. Answer the obj stack's oop." | firstPage stackOrNil index field | firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj. stackOrNil = nilObj ifTrue: [^stackOrNil]. [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots. self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex. "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4. Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx" index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx. "swizzle fields including ObjStackNextx and leave field containing the next link." [field := self fetchPointer: index ofObject: stackOrNil. + (field = 0 or: [self isImmediate: field]) ifFalse: - (self isImmediate: field) ifFalse: [field := segmentManager swizzleObj: field. self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field]. + (index := index - 1) > ObjStackMyx] whileTrue. - (index := index - 1) > ObjStackTopx] whileTrue. (stackOrNil := field) ~= 0] whileTrue. [stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage. stackOrNil ~= 0] whileTrue: [field := segmentManager swizzleObj: stackOrNil. self storePointer: ObjStackFreex ofObjStack: firstPage withValue: field. firstPage := stackOrNil]. self assert: (self isValidObjStackAt: objStackRootIndex). ^self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj!
vm-dev@lists.squeakfoundation.org