Vm-dev September 2013

vm-dev@lists.squeakfoundation.org

31 participants
155 discussions

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

18 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.390.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.390 Author: eem Time: 18 September 2013, 1:58:42.526 pm UUID: 9a457234-c19a-4674-a6cf-44c247cfa544 Ancestors: VMMaker.oscog-eem.389 Fix odd bits calculations in instantiation primitives. Fix class table page allocation (fill the puppy with nils). Split store/FetchPointer:ofForwardedOrFree: into store/FetchPointer:ofForwarded: etc. Use the freeListsMask (note rename) when allocating. Get singleStep to run the atEachStepBlock. =============== Diff against VMMaker.oscog-eem.389 =============== Item was changed: + ----- Method: Spur32BitMMLESimulator>>fetchFloatAt:into: (in category 'float primitives') ----- - ----- Method: Spur32BitMMLESimulator>>fetchFloatAt:into: (in category 'as yet unclassified') ----- fetchFloatAt: floatBitsAddress into: aFloat aFloat at: 2 put: (self long32At: floatBitsAddress). aFloat at: 1 put: (self long32At: floatBitsAddress+4)! Item was changed: + ----- Method: Spur32BitMMLESimulator>>storeFloatAt:from: (in category 'float primitives') ----- - ----- Method: Spur32BitMMLESimulator>>storeFloatAt:from: (in category 'as yet unclassified') ----- storeFloatAt: floatBitsAddress from: aFloat self long32At: floatBitsAddress put: (aFloat at: 2). self long32At: floatBitsAddress+4 put: (aFloat at: 1)! Item was changed: ----- 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." | ok numRememberedRootsInHeap | <inline: false> ok := true. numRememberedRootsInHeap := 0. self allObjectsDo: [: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. - [fieldOop := self fetchPointer: 0 ofForwardedOrFreeObject: 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]]]]. 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>>fetchPointer:ofForwardedOrFreeObject: (in category 'heap management') ----- - fetchPointer: fieldIndex ofForwardedOrFreeObject: objOop - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was added: + ----- Method: Spur32BitMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') ----- + fetchPointer: fieldIndex ofFreeChunk: objOop + ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was changed: ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') ----- instantiateClass: classObj indexableSize: nElements | instSpec classFormat numSlots classIndex newObj fillValue | classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. fillValue := 0. instSpec caseOf: { [self arrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self indexablePointersFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. fillValue := nilObj]. [self weakArrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self sixtyFourBitIndexableFormat] -> [numSlots := nElements * 2]. [self firstLongFormat] -> [numSlots := nElements]. [self firstShortFormat] -> [numSlots := nElements + 1 // 2. instSpec := instSpec + (nElements bitAnd: 1)]. [self firstByteFormat] -> [numSlots := nElements + 3 // 4. + instSpec := instSpec + (4 - nElements bitAnd: 3)]. - instSpec := instSpec + (nElements bitAnd: 3)]. [self firstCompiledMethodFormat] -> [numSlots := nElements + 3 // 4. + instSpec := instSpec + (4 - nElements bitAnd: 3)] } - instSpec := instSpec + (nElements bitAnd: 3)] } otherwise: [^nil]. "non-indexable" classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. ^nil]. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: fillValue]. ^newObj! Item was removed: - ----- Method: Spur32BitMemoryManager>>storePointer:ofForwardedOrFreeObject:withValue: (in category 'heap management') ----- - storePointer: fieldIndex ofForwardedOrFreeObject: objOop withValue: valuePointer - - (self isForwarded: objOop) ifTrue: - [(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 added: + ----- 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 added: + ----- 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 changed: ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') ----- instantiateClass: classObj indexableSize: nElements | instSpec classFormat numSlots classIndex newObj fillValue | classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. fillValue := 0. instSpec caseOf: { [self arrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self indexablePointersFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. fillValue := nilObj]. [self weakArrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self sixtyFourBitIndexableFormat] -> [numSlots := nElements]. [self firstLongFormat] -> [numSlots := nElements + 1 // 2. instSpec := instSpec + (nElements bitAnd: 1)]. [self firstShortFormat] -> [numSlots := nElements + 3 // 4. + instSpec := instSpec + (4 - nElements bitAnd: 3)]. - instSpec := instSpec + (nElements bitAnd: 3)]. [self firstByteFormat] -> [numSlots := nElements + 7 // 8. + instSpec := instSpec + (8 - nElements bitAnd: 7)]. - instSpec := instSpec + (nElements bitAnd: 7)]. [self firstCompiledMethodFormat] -> [numSlots := nElements + 7 // 8. + instSpec := instSpec + (8 - nElements bitAnd: 7)] } - instSpec := instSpec + (nElements bitAnd: 7)] } otherwise: [^nil]. "non-indexable" classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. ^nil]. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: fillValue]. ^newObj! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') ----- addToFreeList: freeChunk | chunkBytes childBytes parent child index | + coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk. chunkBytes := self bytesInObject: freeChunk. index := chunkBytes / self allocationUnit. index < NumFreeLists ifTrue: + [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index). - [self storePointer: self freeChunkNextIndex - ofForwardedOrFreeObject: freeChunk - withValue: (freeLists at: index). freeLists at: index put: freeChunk. + freeListsMask := freeListsMask bitOr: 1 << index. ^self]. + freeListsMask := freeListsMask bitOr: 1. self + storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0. - storePointer: self freeChunkNextIndex ofForwardedOrFreeObject: freeChunk withValue: 0; - storePointer: self freeChunkParentIndex ofForwardedOrFreeObject: freeChunk withValue: 0; - storePointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: freeChunk withValue: 0; - storePointer: self freeChunkLargerIndex ofForwardedOrFreeObject: freeChunk withValue: 0. "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; add to list at node." + [self storePointer: self freeChunkNextIndex + ofFreeChunk: freeChunk - [self storePointerUnchecked: self freeChunkNextIndex - ofObject: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); + storePointer: self freeChunkNextIndex + ofFreeChunk: child - storePointerUnchecked: self freeChunkNextIndex - ofObject: child withValue: freeChunk. ^self]. "walk down the tree" parent := child. child := self fetchPointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofObject: child]. parent = 0 ifTrue: [self assert: (freeLists at: 0) = 0. freeLists at: 0 put: freeChunk. ^self]. "insert in tree" + self storePointer: self freeChunkParentIndex + ofFreeChunk: freeChunk - self storePointerUnchecked: self freeChunkParentIndex - ofObject: freeChunk withValue: parent. + self storePointer: (childBytes > chunkBytes - self storePointerUnchecked: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent - ofObject: parent withValue: freeChunk! 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 | index := chunkBytes / self allocationUnit. + (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue: - index < NumFreeLists ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [^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: - [(nextIndex := nextIndex + index) < NumFreeLists] whileTrue: - [(chunk := freeLists at: index) ~= 0 ifTrue: [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfFreeChunk: 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 unlinkFreeChunk: chunk atIndex: index. + self assert: (self bytesInObject: chunk) = index * self allocationUnit. + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfFreeChunk: chunk) + chunkBytes. + ^chunk]. + freeListsMask := freeListsMask - (1 << index)]]]. - [(nextIndex := nextIndex + 1) < NumFreeLists] whileTrue: - [(chunk := freeLists at: index) ~= 0 ifTrue: - [self unlinkFreeChunk: chunk atIndex: index. - self assert: (self bytesInObject: chunk) = index * self allocationUnit. - self freeChunkWithBytes: index * self allocationUnit - chunkBytes - at: (self startOfFreeChunk: chunk) + chunkBytes. - ^chunk]]]. "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. - ofForwardedOrFreeObject: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex + ofFreeChunk: child - ofForwardedOrFreeObject: child withValue: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: chunk). - ofForwardedOrFreeObject: 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]]. - ofObject: child]]. parent = 0 ifTrue: [self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex + ofFreeChunk: parent. - ofForwardedOrFreeObject: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex + ofFreeChunk: parent - ofForwardedOrFreeObject: parent withValue: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: chunk). - ofForwardedOrFreeObject: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes]. ^chunk]. "no list; remove an interior node" chunk := parent. + parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. - parent := self fetchPointer: self freeChunkParentIndex ofForwardedOrFreeObject: 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 := self fetchPointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: chunk. - larger := self fetchPointer: self freeChunkLargerIndex ofForwardedOrFreeObject: 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 startOfFreeChunk: chunk) + chunkBytes]. ^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>>enterIntoClassTable: (in category 'class table') ----- enterIntoClassTable: aBehavior "Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code." | initialMajorIndex majorIndex minorIndex page | majorIndex := classTableIndex >> self classTableMajorIndexShift. initialMajorIndex := majorIndex. "classTableIndex should never index the first page; it's reserved for known classes" self assert: initialMajorIndex > 0. minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask. [page := self fetchPointer: majorIndex ofObject: classTableRootObj. page = nilObj ifTrue: [page := self allocateSlots: self classTablePageSize format: self arrayFormat classIndex: self arrayClassIndexPun. page ifNil: [^PrimErrNoMemory]. + self fillObj: page numSlots: self classTablePageSize with: nilObj. self storePointer: majorIndex ofObject: classTableRootObj withValue: page. minorIndex := 0]. minorIndex to: self classTablePageSize - 1 do: [:i| (self fetchPointer: i ofObject: page) = nilObj ifTrue: [classTableIndex := majorIndex << self classTableMajorIndexShift + i. self storePointer: i ofObject: page withValue: aBehavior. self setHashBitsOf: aBehavior to: classTableIndex. self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior. "now fault-in method lookup chain." self scanClassPostBecome: aBehavior effects: BecamePointerObjectFlag+BecameCompiledMethodFlag. ^0]]. majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1. majorIndex = initialMajorIndex ifTrue: "wrapped; table full" [^PrimErrLimitExceeded]] repeat! Item was added: + ----- Method: SpurMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') ----- + fetchPointer: fieldIndex ofFreeChunk: objOop + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>fetchPointer:ofMaybeForwardedObject: (in category 'heap management') ----- + fetchPointer: fieldIndex ofMaybeForwardedObject: objOop + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') ----- + fetchPointer: fieldIndex ofObject: objOop + ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') ----- followForwarded: objOop | referent | self assert: (self isForwarded: objOop). + referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop. - referent := self fetchPointer: 0 ofForwardedOrFreeObject: objOop. self assert: (self isForwarded: referent) not. ^referent! Item was changed: ----- Method: SpurMemoryManager>>forward:to: (in category 'become implementation') ----- forward: obj1 to: obj2 self setFormatOf: obj1 to: self forwardedFormat. self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun. + self storePointer: 0 ofForwarder: obj1 withValue: obj2! - self storePointer: 0 ofForwardedOrFreeObject: obj1 withValue: obj2! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0). + freeListsMask := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := false. becomeEffectsFlags := 0. heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. statScavenges := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0! Item was changed: ----- Method: SpurMemoryManager>>possibleRootStoreInto: (in category 'store check') ----- possibleRootStoreInto: destObj (#( storePointer:ofObject:withValue: + storePointer:ofForwarder:withValue: - storePointer:ofForwardedOrFreeObject:withValue: inPlaceBecome:and:copyHashFlag:) includes: thisContext sender method selector) ifFalse: [self halt]. (self isRemembered: destObj) ifFalse: [scavenger remember: destObj. self setIsRememberedOf: destObj to: true]! Item was changed: ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') ----- printFreeChunk: freeChunk <doNotGenerate> | numBytes | numBytes := self bytesInObject: freeChunk. coInterpreter print: 'freeChunk @ '; printHexPtr: freeChunk; print: ' bytes '; printNum: numBytes; print: ' next '; print: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: freeChunk) hex. - ofForwardedOrFreeObject: freeChunk) hex. numBytes / self allocationUnit > NumFreeLists ifTrue: [coInterpreter print: ' ^ '; print: (self fetchPointer: self freeChunkParentIndex + ofFreeChunk: freeChunk) hex; - ofForwardedOrFreeObject: freeChunk) hex; print: ' < '; print: (self fetchPointer: self freeChunkSmallerIndex + ofFreeChunk: freeChunk) hex; - ofForwardedOrFreeObject: freeChunk) hex; print: ' > '; print: (self fetchPointer: self freeChunkLargerIndex + ofFreeChunk: freeChunk) hex]. - ofForwardedOrFreeObject: freeChunk) hex]. coInterpreter cr! Item was changed: ----- Method: SpurMemoryManager>>printReferencesTo: (in category 'debug printing') ----- printReferencesTo: anOop "Scan the heap printing the oops of any and all objects that refer to anOop" <api> self allObjectsDo: [:obj| | i | ((self isPointersNonImm: obj) or: [self isCompiledMethod: obj]) ifTrue: [(self isCompiledMethod: obj) ifTrue: [i := (coInterpreter literalCountOf: obj) + LiteralStart] ifFalse: [(self isContextNonImm: obj) ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)] ifFalse: [i := self lengthOf: obj]]. [(i := i - 1) >= 0] whileTrue: [anOop = (self fetchPointer: i ofObject: obj) ifTrue: [coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr. i := 0]]] ifFalse: [((self isForwarded: obj) + and: [(self fetchPointer: 0 ofMaybeForwardedObject: obj) = anOop]) ifTrue: - and: [(self fetchPointer: 0 ofForwardedOrFreeObject: obj) = anOop]) ifTrue: [coInterpreter printHex: obj; print: ' => '; printHex: anOop; cr]]]! Item was added: + ----- Method: SpurMemoryManager>>storePointer:ofForwarder:withValue: (in category 'heap management') ----- + storePointer: fieldIndex ofForwarder: objOop withValue: valuePointer + + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- + storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer + + ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex: (in category 'free space') ----- unlinkFreeChunk: chunk atIndex: index <inline: true> self assert: ((self bytesInObject: chunk) = index * self allocationUnit and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"]). freeLists at: index put: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: chunk). - ofForwardedOrFreeObject: chunk). ^chunk! Item was added: + ----- Method: StackInterpreterSimulator>>framePointer (in category 'spur bootstrap') ----- + framePointer + ^framePointer! Item was changed: ----- Method: StackInterpreterSimulator>>singleStep (in category 'testing') ----- singleStep self assertValidExecutionPointers. + atEachStepBlock value. "N.B. may be nil" self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount!

1 0

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

18 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.90.mcz ==================== Summary ==================== Name: Cog-eem.90 Author: eem Time: 18 September 2013, 2:01:05.377 pm UUID: e329ae21-983a-4410-87ad-9559f7fc3cda Ancestors: Cog-eem.89 Make class table pages strong. Avoid sending size to Symbol. =============== Diff against Cog-eem.89 =============== Item was changed: ----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap image') ----- allocateClassTable "Allocate the root of the classTable plus enough pages to accomodate all classes in the classToIndex map. Don't fill in the entries yet; the classes have yet to be cloned." | tableRootSize tableRoot page maxSize numPages | tableRootSize := self classTableSize / newHeap classTablePageSize. tableRoot := newHeap allocateSlots: tableRootSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: tableRoot) = tableRootSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. newHeap nilFieldsOf: tableRoot. "first page is strong" page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. self assert: (newHeap objectAfter: tableRoot limit: newHeap freeStart) = page. lastClassTablePage := page. newHeap nilFieldsOf: page. newHeap storePointer: 0 ofObject: tableRoot withValue: page. newHeap classTableRootObj: tableRoot. maxSize := classToIndex inject: 0 into: [:a :b| a max: b]. numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated. 2 to: numPages do: [:i| page := newHeap allocateSlots: newHeap classTablePageSize + format: newHeap arrayFormat + classIndex: newHeap arrayClassIndexPun. - format: newHeap weakArrayFormat - classIndex: newHeap weakArrayClassIndexPun. self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. + self assert: (newHeap formatOf: page) = newHeap arrayFormat. + self assert: (newHeap classIndexOf: page) = newHeap arrayClassIndexPun. + newHeap fillObj: page numSlots: newHeap classTablePageSize with: newHeap nilObject. - self assert: (newHeap formatOf: page) = newHeap weakArrayFormat. - self assert: (newHeap classIndexOf: page) = newHeap weakArrayClassIndexPun. - newHeap nilFieldsOf: page. newHeap storePointer: i - 1 ofObject: tableRoot withValue: page. self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot) limit: newHeap freeStart) = page. lastClassTablePage := page]! Item was changed: ----- Method: SpurBootstrap>>fillInClassTable (in category 'bootstrap image') ----- fillInClassTable + | firstPage maxIndex | - | firstPage classWeakArray maxIndex | maxIndex := 0. classToIndex keysAndValuesDo: [:oldClass :index| | newClass page | maxIndex := maxIndex max: index. newClass := map at: oldClass. self assert: (newHeap isPointersNonImm: newClass). newHeap setHashBitsOf: newClass to: index. page := newHeap fetchPointer: index >> newHeap classTableMajorIndexShift ofObject: newHeap classTableRootObj. newHeap storePointer: (index bitAnd: newHeap classTableMinorIndexMask) ofObject: page withValue: newClass. self assert: (newHeap classAtIndex: index) = newClass]. firstPage := newHeap fetchPointer: 0 ofObject: newHeap classTableRootObj. - classWeakArray := classToIndex keys detect: - [:oldClass| - (oldHeap instSpecOfClass: oldClass) = 4 - and: [oldInterpreter classNameOf: oldClass Is: 'WeakArray']]. newHeap storePointer: 1 ofObject: firstPage withValue: (map at: oldHeap classSmallInteger); storePointer: 2 ofObject: firstPage withValue: (map at: oldHeap classCharacter); storePointer: 3 ofObject: firstPage withValue: (map at: oldHeap classSmallInteger); storePointer: newHeap arrayClassIndexPun ofObject: firstPage withValue: (map at: oldHeap classArray); + storePointer: newHeap arrayClassIndexPun - storePointer: newHeap weakArrayClassIndexPun ofObject: firstPage + withValue: (map at: oldHeap classArray). - withValue: (map at: classWeakArray). newHeap classTableIndex: maxIndex! Item was changed: ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') ----- rehashImage "Rehash all collections in newHeap. Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags. Enumerate all objects, rehashing those whose class has a bit set in rehashFlags." | n sim rehashFlags | sim := StackInterpreterSimulator onObjectMemory: newHeap. newHeap coInterpreter: sim. sim initializeInterpreter: 0. sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. newHeap setHashBitsOf: newHeap nilObject to: 1; setHashBitsOf: newHeap falseObject to: 2; setHashBitsOf: newHeap trueObject to: 3. rehashFlags := ByteArray new: newHeap classTableIndex + 7 // 8. n := 0. newHeap classTableObjectsDo: [:class| | classIndex | sim messageSelector: (map at: rehashSym). "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self." ((sim lookupMethodNoMNUEtcInClass: class) = 0 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue: [n := n + 1. classIndex := newHeap rawHashBitsOf: class. rehashFlags at: classIndex >> 3 + 1 put: ((rehashFlags at: classIndex >> 3 + 1) bitOr: (1 << (classIndex bitAnd: 7)))]]. Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush. n := 0. self withExecutableInterpreter: sim + do: [sim setBreakSelector: 'error:'. + "don't rehash twice (actually without limit), so don't rehash any new objects created." + newHeap allExistingOldSpaceObjectsDo: - do: "don't rehash twice (actually without limit), so don't rehash any new objects created." - [newHeap allExistingObjectsDo: [:o| | classIndex | classIndex := newHeap classIndexOf: o. ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue: [(n := n + 1) \\ 8 = 0 ifTrue: [Transcript nextPut: $.; flush]. "2845 = n ifTrue: [self halt]." + "Rehash an object if its size is > 0. + Symbol implements rehash, but doesn't understand size, so don't send size to classes. + Don't rehash empty collections; they may be large for a reason and rehashing will shrink them." + ((sim addressCouldBeClassObj: o) + or: [(self interpreter: sim - (self interpreter: sim object: o perform: (map at: sizeSym) + withArguments: #()) ~= (newHeap integerObjectOf: 0)]) ifTrue: - withArguments: #()) ~= (newHeap integerObjectOf: 0) ifTrue: [self interpreter: sim object: o perform: (map at: rehashSym) withArguments: #()]]]]! Item was changed: ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') ----- replacementForCharacterMethod: characterMethodOop "Answer a replacement method for the argument if it refers to Character's old inst var value. Otherwise answer nil." | proxy asIntegerProxy clone assembly newInsts newMethod | + "(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue: + [self halt]." - (oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue: - [self halt]. proxy := VMCompiledMethodProxy new for: characterMethodOop coInterpreter: oldInterpreter objectMemory: oldHeap. clone := self cloneMethodProxy: proxy. clone hasInstVarRef ifFalse: [^nil]. clone setSourcePointer: 0. asIntegerProxy := VMObjectProxy new for: (symbolMap at: #asInteger) coInterpreter: oldInterpreter objectMemory: oldHeap. assembly := BytecodeDisassembler new disassemble: clone. assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2). "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger" newInsts := (assembly instructions piecesCutWhere: [:msgOrLabelAssoc :nextInst| msgOrLabelAssoc isVariableBinding not and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold: [:a :b| a allButLast, { Message selector: #pushReceiver. Message selector: #send:super:numArgs: arguments: {asIntegerProxy. false. 0}}, b]. assembly instructions: newInsts. newMethod := assembly assemble. ^self installableMethodFor: newMethod selector: clone selector className: #Character isMeta: false!

1 0

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

18 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.89.mcz ==================== Summary ==================== Name: Cog-eem.89 Author: eem Time: 17 September 2013, 6:11:13.622 pm UUID: d56a6961-bf18-450f-9aaa-427cfb9e753d Ancestors: Cog-eem.88 Bring modifyCharacterMethods into withExecutableInterpreter: scope. Fix replacementForCharacterMethod: (was installing oop of asInteger selector as a SmallInteger, not the oop itself). Make sure interpreter:object:perform:withArguments: increments byteCount even if performed send is primitive. Needs VMMaker.oscog-eem.388. =============== Diff against Cog-eem.88 =============== Item was changed: ----- Method: SpurBootstrap>>installModifiedMethods (in category 'bootstrap methods') ----- installModifiedMethods "Install all the methods in the class-side method prototypes protocol in the relevant classes in the new image. First use the simulator to get the image to intern all symbols and add dummy methods under new selectors. With that done we can manually replace the relevant methods with the prototypes, mapping selectors and global variables as required." symbolMap := Dictionary new. methodClasses := Set new. installedPrototypes := Set new. self withExecutableInterpreter: oldInterpreter do: [self internAllSymbols. self addNewMethods. + self replaceMethods. + self modifyCharacterMethods]! - self replaceMethods]. - self modifyCharacterMethods! Item was changed: ----- Method: SpurBootstrap>>interpreter:object:perform:withArguments: (in category 'bootstrap methods') ----- interpreter: sim object: receiver perform: selector withArguments: arguments "Interpret an expression in oldHeap using oldInterpreter. Answer the result." + | fp savedpc savedsp result startByteCount | - | fp savedpc savedsp result | savedpc := sim localIP. savedsp := sim localSP. sim internalPush: receiver. arguments do: [:arg| sim internalPush: arg]. sim argumentCount: arguments size; messageSelector: selector. fp := sim localFP. + startByteCount := sim byteCount. + "sim byteCount = 66849 ifTrue: [self halt]." sim normalSend. + sim incrementByteCount. "otherwise, send is not counted" + ["sim byteCount = 66849 ifTrue: [self halt]." + "(sim byteCount > 7508930 and: [sim localFP = -16r27894]) ifTrue: + [self halt]." + fp = sim localFP] whileFalse: - [fp = sim localFP] whileFalse: [sim singleStep]. result := sim internalPopStack. self assert: savedsp = sim localSP. self assert: sim localIP - 1 = savedpc. sim localIP: savedpc. ^result! Item was changed: ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') ----- rehashImage "Rehash all collections in newHeap. Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags. Enumerate all objects, rehashing those whose class has a bit set in rehashFlags." | n sim rehashFlags | sim := StackInterpreterSimulator onObjectMemory: newHeap. newHeap coInterpreter: sim. sim initializeInterpreter: 0. sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. newHeap setHashBitsOf: newHeap nilObject to: 1; setHashBitsOf: newHeap falseObject to: 2; setHashBitsOf: newHeap trueObject to: 3. rehashFlags := ByteArray new: newHeap classTableIndex + 7 // 8. n := 0. newHeap classTableObjectsDo: [:class| | classIndex | sim messageSelector: (map at: rehashSym). "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self." ((sim lookupMethodNoMNUEtcInClass: class) = 0 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue: [n := n + 1. classIndex := newHeap rawHashBitsOf: class. rehashFlags at: classIndex >> 3 + 1 put: ((rehashFlags at: classIndex >> 3 + 1) bitOr: (1 << (classIndex bitAnd: 7)))]]. Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush. n := 0. self withExecutableInterpreter: sim do: "don't rehash twice (actually without limit), so don't rehash any new objects created." [newHeap allExistingObjectsDo: [:o| | classIndex | classIndex := newHeap classIndexOf: o. ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue: [(n := n + 1) \\ 8 = 0 ifTrue: [Transcript nextPut: $.; flush]. + "2845 = n ifTrue: [self halt]." (self interpreter: sim object: o perform: (map at: sizeSym) withArguments: #()) ~= (newHeap integerObjectOf: 0) ifTrue: [self interpreter: sim object: o perform: (map at: rehashSym) withArguments: #()]]]]! Item was changed: ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') ----- replacementForCharacterMethod: characterMethodOop "Answer a replacement method for the argument if it refers to Character's old inst var value. Otherwise answer nil." + | proxy asIntegerProxy clone assembly newInsts newMethod | + (oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue: + [self halt]. - | proxy clone assembly newInsts | proxy := VMCompiledMethodProxy new for: characterMethodOop coInterpreter: oldInterpreter objectMemory: oldHeap. clone := self cloneMethodProxy: proxy. - clone dropSourcePointer. clone hasInstVarRef ifFalse: [^nil]. + clone setSourcePointer: 0. + asIntegerProxy := VMObjectProxy new + for: (symbolMap at: #asInteger) + coInterpreter: oldInterpreter + objectMemory: oldHeap. assembly := BytecodeDisassembler new disassemble: clone. + assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2). - assembly literals: (assembly literals allButLast: 2), {symbolMap at: #asInteger}, (assembly literals last: 2). "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger" newInsts := (assembly instructions piecesCutWhere: [:msgOrLabelAssoc :nextInst| msgOrLabelAssoc isVariableBinding not and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold: [:a :b| a allButLast, { Message selector: #pushReceiver. Message selector: #send:super:numArgs: + arguments: {asIntegerProxy. false. 0}}, - arguments: {symbolMap at: #asInteger. false. 0}}, b]. assembly instructions: newInsts. + newMethod := assembly assemble. ^self + installableMethodFor: newMethod - installableMethodFor: assembly assemble selector: clone selector className: #Character isMeta: false!

1 0

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

18 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.389.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.389 Author: eem Time: 17 September 2013, 6:07:49.233 pm UUID: f512174f-1d31-4863-8ace-a710b4ae527a Ancestors: VMMaker.oscog-eem.388 Merge fix for http://bugs.squeak.org/view.php?id=7247 in VMMaker-tpr.325. Make objCouldBeClassObj: accespt classes not yet in classTable (they may contain forwarding pointers). Comment typo. =============== Diff against VMMaker.oscog-eem.388 =============== Item was changed: ----- Method: BitBltSimulation>>alphaSourceBlendBits8 (in category 'inner loop') ----- alphaSourceBlendBits8 "This version assumes combinationRule = 34 sourcePixSize = 32 destPixSize = 8 sourceForm ~= destForm. Note: This is not real blending since we don't have the source colors available. " | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY srcY dstY dstMask srcShift adjust mappingTable mapperFlags | <inline: false> <var: #mappingTable type:'unsigned int *'> mappingTable := self default8To32Table. mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32. deltaY := bbH + 1. "So we can pre-decrement" srcY := sy. dstY := dy. mask1 := ((dx bitAnd: 3) * 8). destMSB ifTrue:[mask1 := 24 - mask1]. mask2 := AllOnes bitXor:(16rFF << mask1). (dx bitAnd: 1) = 0 ifTrue:[adjust := 0] ifFalse:[adjust := 16r1F1F1F1F]. (dy bitAnd: 1) = 0 ifTrue:[adjust := adjust bitXor: 16r1F1F1F1F]. "This is the outer loop" [(deltaY := deltaY - 1) ~= 0] whileTrue:[ adjust := adjust bitXor: 16r1F1F1F1F. srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4). dstIndex := destBits + (dstY * destPitch) + (dx // 4 * 4). deltaX := bbW + 1. "So we can pre-decrement" srcShift := mask1. dstMask := mask2. "This is the inner loop" [(deltaX := deltaX - 1) ~= 0] whileTrue:[ sourceWord := ((self srcLongAt: srcIndex) bitAnd: (adjust bitInvert32)) + adjust. srcAlpha := sourceWord >> 24. srcAlpha > 31 ifTrue:["Everything below 31 is transparent" srcAlpha < 224 ifTrue:["Everything above 224 is opaque" destWord := self dstLongAt: dstIndex. destWord := destWord bitAnd: dstMask bitInvert32. destWord := destWord >> srcShift. destWord := mappingTable at: destWord. sourceWord := self alphaBlendScaled: sourceWord with: destWord. ]. sourceWord := self mapPixel: sourceWord flags: mapperFlags. sourceWord := sourceWord << srcShift. "Store back" self dstLongAt: dstIndex put: sourceWord mask: dstMask. ]. srcIndex := srcIndex + 4. destMSB ifTrue:[ srcShift = 0 ifTrue:[dstIndex := dstIndex + 4. srcShift := 24. dstMask := 16r00FFFFFF] ifFalse:[srcShift := srcShift - 8. dstMask := (dstMask >> 8) bitOr: 16rFF000000]. ] ifFalse:[ + srcShift = 24 - srcShift = 32 ifTrue:[dstIndex := dstIndex + 4. srcShift := 0. dstMask := 16rFFFFFF00] ifFalse:[srcShift := srcShift + 8. dstMask := dstMask << 8 bitOr: 255]. ]. adjust := adjust bitXor: 16r1F1F1F1F. ]. srcY := srcY + 1. dstY := dstY + 1. ].! 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." - no valid header. The caler *must* fill in the header correctly." | index chunk nextIndex nodeBytes parent child smaller larger | index := chunkBytes / self allocationUnit. index < NumFreeLists ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. [(nextIndex := nextIndex + index) < NumFreeLists] whileTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [(nextIndex := nextIndex + 1) < NumFreeLists] whileTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes. ^chunk]]]. "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 ofForwardedOrFreeObject: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofForwardedOrFreeObject: child withValue: (self fetchPointer: self freeChunkNextIndex ofForwardedOrFreeObject: 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]) ofObject: child]]. parent = 0 ifTrue: [self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofForwardedOrFreeObject: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofForwardedOrFreeObject: parent withValue: (self fetchPointer: self freeChunkNextIndex ofForwardedOrFreeObject: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes]. ^chunk]. "no list; remove an interior node" chunk := parent. parent := self fetchPointer: self freeChunkParentIndex ofForwardedOrFreeObject: chunk. "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: [smaller := self fetchPointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofForwardedOrFreeObject: chunk. smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes]. ^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: 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." - "Answer if objOop looks like a class object" <inline: false> + | field | ^(objectMemory isPointersNonImm: objOop) and: [(objectMemory numSlotsOf: objOop) >= (InstanceSpecificationIndex+1) + and: [field := objectMemory fetchPointer: SuperclassIndex ofObject: objOop. + ((objectMemory isPointers: field) + or: [(objectMemory rawHashBitsOf: objOop) = 0 + 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: field) + and: [objectMemory isPointers: (objectMemory followForwarded: field)]]]) - and: [(objectMemory isPointers: (objectMemory fetchPointer: SuperclassIndex ofObject: objOop)) - and: [(objectMemory isPointers: (objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop)) and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]!

1 0

VM Maker: VMMaker-tpr.325.mcz
by commits＠source.squeak.org 18 Sep '13

18 Sep '13

tim Rowledge uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-tpr.325.mcz ==================== Summary ==================== Name: VMMaker-tpr.325 Author: tpr Time: 17 September 2013, 5:24:10.53 pm UUID: 98b93ca5-c360-48e2-8fda-fc64fb165085 Ancestors: VMMaker-dtl.324 (probable) fix for Mantis http://bugs.squeak.org/view.php?id=7247 BitBlt Bug in alphaSourceBlendBits8 =============== Diff against VMMaker-dtl.324 =============== Item was changed: ----- Method: BitBltSimulation>>alphaSourceBlendBits8 (in category 'inner loop') ----- alphaSourceBlendBits8 "This version assumes combinationRule = 34 sourcePixSize = 32 destPixSize = 8 sourceForm ~= destForm. Note: This is not real blending since we don't have the source colors available. " | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY srcY dstY dstMask srcShift adjust mappingTable mapperFlags | <inline: false> <var: #mappingTable type:'unsigned int *'> mappingTable := self default8To32Table. mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32. deltaY := bbH + 1. "So we can pre-decrement" srcY := sy. dstY := dy. mask1 := ((dx bitAnd: 3) * 8). destMSB ifTrue:[mask1 := 24 - mask1]. mask2 := AllOnes bitXor:(16rFF << mask1). (dx bitAnd: 1) = 0 ifTrue:[adjust := 0] ifFalse:[adjust := 16r1F1F1F1F]. (dy bitAnd: 1) = 0 ifTrue:[adjust := adjust bitXor: 16r1F1F1F1F]. "This is the outer loop" [(deltaY := deltaY - 1) ~= 0] whileTrue:[ adjust := adjust bitXor: 16r1F1F1F1F. srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4). dstIndex := destBits + (dstY * destPitch) + (dx // 4 * 4). deltaX := bbW + 1. "So we can pre-decrement" srcShift := mask1. dstMask := mask2. "This is the inner loop" [(deltaX := deltaX - 1) ~= 0] whileTrue:[ sourceWord := ((self srcLongAt: srcIndex) bitAnd: (adjust bitInvert32)) + adjust. srcAlpha := sourceWord >> 24. srcAlpha > 31 ifTrue:["Everything below 31 is transparent" srcAlpha < 224 ifTrue:["Everything above 224 is opaque" destWord := self dstLongAt: dstIndex. destWord := destWord bitAnd: dstMask bitInvert32. destWord := destWord >> srcShift. destWord := mappingTable at: destWord. sourceWord := self alphaBlendScaled: sourceWord with: destWord. ]. sourceWord := self mapPixel: sourceWord flags: mapperFlags. sourceWord := sourceWord << srcShift. "Store back" self dstLongAt: dstIndex put: sourceWord mask: dstMask. ]. srcIndex := srcIndex + 4. destMSB ifTrue:[ srcShift = 0 ifTrue:[dstIndex := dstIndex + 4. srcShift := 24. dstMask := 16r00FFFFFF] ifFalse:[srcShift := srcShift - 8. dstMask := (dstMask >> 8) bitOr: 16rFF000000]. ] ifFalse:[ + srcShift = 24 - srcShift = 32 ifTrue:[dstIndex := dstIndex + 4. srcShift := 0. dstMask := 16rFFFFFF00] ifFalse:[srcShift := srcShift + 8. dstMask := dstMask << 8 bitOr: 255]. ]. adjust := adjust bitXor: 16r1F1F1F1F. ]. srcY := srcY + 1. dstY := dstY + 1. ].!

1 0

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

18 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.388.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.388 Author: eem Time: 17 September 2013, 4:54:38.785 pm UUID: 92fbeee7-a269-41b1-bb01-9a970c4a50fa Ancestors: VMMaker.oscog-eem.387 Move the zeroing of stackPage to zeroStackPage to provide a debugging hook. Fix Spur??BitMemoryManager>>instantiateClass:indexableSize: for missing weakArrayFormat. Fix shortPrint: for immediate characters. =============== Diff against VMMaker.oscog-eem.387 =============== Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveVoidVMStateForMethod (in category 'system control primitives') ----- primitiveVoidVMStateForMethod "The receiver is a compiledMethod. Clear all VM state associated with the method, including any machine code, or machine code pcs in context objects." <var: #theFrame type: #'char *'> <var: #thePage type: #'StackPage *'> super primitiveFlushCacheByMethod. (self methodHasCogMethod: self stackTop) ifTrue: [| activeContext methodObj theFrame thePage | methodObj := self stackTop. self push: instructionPointer. self externalWriteBackHeadFramePointers. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. self divorceMachineCodeFramesWithMethod: methodObj. self ensureAllContextsWithMethodHaveBytecodePCs: methodObj. cogit unlinkSendsTo: methodObj andFreeIf: true. (self isStillMarriedContext: activeContext) ifTrue: [theFrame := self frameOfMarriedContext: activeContext. thePage := stackPages stackPageFor: theFrame. self assert: thePage headFP = theFrame. self setStackPageAndLimit: thePage. stackPointer := thePage headSP. framePointer := thePage headFP. instructionPointer := self popStack. self assert: methodObj = self stackTop] ifFalse: + [self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:" - [stackPage := 0. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:" self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext. self popStack. "pop bogus machine-code instructionPointer" self assert: methodObj = self stackTop. self siglong: reenterInterpreter jmp: ReturnToInterpreter]] ! Item was changed: ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') ----- instantiateClass: classObj indexableSize: nElements | instSpec classFormat numSlots classIndex newObj fillValue | classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. fillValue := 0. instSpec caseOf: { [self arrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self indexablePointersFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. fillValue := nilObj]. + [self weakArrayFormat] -> + [numSlots := nElements. + fillValue := nilObj]. [self sixtyFourBitIndexableFormat] -> [numSlots := nElements * 2]. [self firstLongFormat] -> [numSlots := nElements]. [self firstShortFormat] -> [numSlots := nElements + 1 // 2. instSpec := instSpec + (nElements bitAnd: 1)]. [self firstByteFormat] -> [numSlots := nElements + 3 // 4. instSpec := instSpec + (nElements bitAnd: 3)]. [self firstCompiledMethodFormat] -> [numSlots := nElements + 3 // 4. instSpec := instSpec + (nElements bitAnd: 3)] } otherwise: [^nil]. "non-indexable" classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. ^nil]. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: fillValue]. ^newObj! Item was changed: ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') ----- instantiateClass: classObj indexableSize: nElements | instSpec classFormat numSlots classIndex newObj fillValue | classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. fillValue := 0. instSpec caseOf: { [self arrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self indexablePointersFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. fillValue := nilObj]. + [self weakArrayFormat] -> + [numSlots := nElements. + fillValue := nilObj]. [self sixtyFourBitIndexableFormat] -> [numSlots := nElements]. [self firstLongFormat] -> [numSlots := nElements + 1 // 2. instSpec := instSpec + (nElements bitAnd: 1)]. [self firstShortFormat] -> [numSlots := nElements + 3 // 4. instSpec := instSpec + (nElements bitAnd: 3)]. [self firstByteFormat] -> [numSlots := nElements + 7 // 8. instSpec := instSpec + (nElements bitAnd: 7)]. [self firstCompiledMethodFormat] -> [numSlots := nElements + 7 // 8. instSpec := instSpec + (nElements bitAnd: 7)] } otherwise: [^nil]. "non-indexable" classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. ^nil]. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: fillValue]. ^newObj! Item was changed: ----- Method: StackInterpreter>>divorceAllFrames (in category 'frame access') ----- divorceAllFrames | activeContext | <inline: false> <var: #aPage type: #'StackPage *'> self externalWriteBackHeadFramePointers. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. 0 to: numStackPages - 1 do: [:i| | aPage | aPage := stackPages stackPageAt: i. (stackPages isFree: aPage) ifFalse: [self divorceFramesIn: aPage]]. + self zeroStackPage. - stackPage := 0. ^activeContext! Item was changed: ----- Method: StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: (in category 'debug printing') ----- printActivationNameFor: aMethod receiver: anObject isBlock: isBlock firstTemporary: maybeMessage | methClass methodSel classObj | <inline: false> isBlock ifTrue: [self print: '[] in ']. methClass := self findClassOfMethod: aMethod forReceiver: anObject. methodSel := self findSelectorOfMethod: aMethod. ((objectMemory addressCouldBeOop: anObject) + and: [(objectMemory isOopForwarded: anObject) not - and: [(objectMemory isForwarded: anObject) not and: [self addressCouldBeClassObj: (classObj := objectMemory fetchClassOf: anObject)]]) ifTrue: [classObj = methClass ifTrue: [self printNameOfClass: methClass count: 5] ifFalse: [self printNameOfClass: classObj count: 5. self print: '('. self printNameOfClass: methClass count: 5. self print: ')']] ifFalse: [self cCode: '' inSmalltalk: [self halt]. self print: 'INVALID RECEIVER']. self print: '>'. (objectMemory addressCouldBeOop: methodSel) ifTrue: [methodSel = objectMemory nilObject ifTrue: [self print: '?'] ifFalse: [self printStringOf: methodSel]] ifFalse: [self print: 'INVALID SELECTOR']. (methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) and: [(objectMemory addressCouldBeObj: maybeMessage) and: [(objectMemory fetchClassOf: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue: ["print arg message selector" methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage. self print: ' '. self printStringOf: methodSel]! Item was changed: ----- Method: StackInterpreter>>setStackPageAndLimit: (in category 'stack pages') ----- setStackPageAndLimit: thePage "Set stackPage to a different page. Set stackLimit unless it has been smashed. Make the stackPage the most recently used" <inline: true> <asmLabel: false> <var: #thePage type: #'StackPage *'> + self assert: thePage ~= 0. stackPage := thePage. stackLimit ~= (self cCoerceSimple: -1 signedIntToLong to: #'char *') ifTrue: [stackLimit := stackPage stackLimit]. stackPages markStackPageMostRecentlyUsed: thePage! Item was added: + ----- Method: StackInterpreter>>zeroStackPage (in category 'stack pages') ----- + zeroStackPage + "In its own method as a debugging hook." + <inline: true> + stackPage := 0! Item was changed: ----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') ----- shortPrint: oop | name classOop | (objectMemory isImmediate: oop) ifTrue: + [(objectMemory isImmediateCharacter: oop) ifTrue: + [^ '=$' , (objectMemory characterValueOf: oop) printString , + ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']. + (objectMemory isIntegerObject: oop) ifTrue: + [^ '=' , (objectMemory integerValueOf: oop) printString , - [(objectMemory isImmediateCharacter: oop) ifTrue: [^ '=$' , (objectMemory integerValueOf: oop) printString , - ' (' , (String with: (Character value: (objectMemory integerValueOf: oop))) , ')']. - (objectMemory isIntegerObject: oop) ifTrue: [^ '=' , (objectMemory integerValueOf: oop) printString , ' (' , (objectMemory integerValueOf: oop) hex , ')']. ^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')']. (objectMemory addressCouldBeObj: oop) ifFalse: [^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [' is not on the heap']]. (objectMemory isFreeObject: oop) ifTrue: [^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString]. (objectMemory isForwarded: oop) ifTrue: [^' is a forwarded object to ', (objectMemory followForwarded: oop) hex, ' of slot size ', (objectMemory numSlotsOfAny: oop) printString]. classOop := objectMemory fetchClassOfNonImm: oop. (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue: [^'class ' , (self nameOfClass: oop)]. name := self nameOfClass: classOop. name size = 0 ifTrue: [name := '??']. name = 'String' ifTrue: [^ (self stringOf: oop) printString]. name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString]. name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)]. name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)]. name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not" [^ '=' , (Character value: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))) printString]. name = 'UndefinedObject' ifTrue: [^ 'nil']. name = 'False' ifTrue: [^ 'false']. name = 'True' ifTrue: [^ 'true']. name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString]. name = 'Association' ifTrue: [^ '(' , (self shortPrint: (self longAt: oop + BaseHeaderSize)) , ' -> ' , (self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')']. ('AEIOU' includes: name first) ifTrue: [^ 'an ' , name] ifFalse: [^ 'a ' , name]! Item was added: + ----- Method: StackInterpreterSimulator>>stackPage (in category 'spur bootstrap') ----- + stackPage + ^stackPage!

1 0

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

17 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.387.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.387 Author: eem Time: 17 September 2013, 1:58:49.997 pm UUID: d2d5432c-1689-4794-b72f-e92dd1ff9e6e Ancestors: VMMaker.oscog-eem.386 Fix Slang inlining snafu in lengthOfMaybeImmediate: in VMMaker.oscog-eem.385. =============== Diff against VMMaker.oscog-eem.386 =============== Item was changed: ----- Method: ObjectMemory>>lengthOfMaybeImmediate: (in category 'debug support') ----- lengthOfMaybeImmediate: oop "for the message send breakpoint; selectors can be immediates." <inline: false> + (self isImmediate: oop) ifTrue: [^0]. + ^self lengthOf: oop! - ^(self isImmediate: oop) - ifTrue: [oop] - ifFalse: [self lengthOf: oop]! Item was changed: ----- Method: SpurMemoryManager>>lengthOfMaybeImmediate: (in category 'debug support') ----- lengthOfMaybeImmediate: oop "for the message send breakpoint; selectors can be immediates." <inline: false> + (self isImmediate: oop) ifTrue: [^0]. + ^self lengthOf: oop! - ^(self isImmediate: oop) - ifTrue: [oop] - ifFalse: [self lengthOf: oop]!

1 0

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

17 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.386.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.386 Author: eem Time: 17 September 2013, 1:51:38.98 pm UUID: baeb0345-a41a-4c3a-823e-24de21382feb Ancestors: VMMaker.oscog-eem.385 Implement SpurGenerationScavenger>>copyToOldSpace:. Add searching the oldSpace free tree (incomplete) to allocate space. Fix bug that assumed start of free chunk was same as free chunk oop. Correctly initialize freeOldSpaceStart and correct allOldSpaceObjectsDo:. Implement objectBefore: & objectAfter: Fix comment speeling roers =============== Diff against VMMaker.oscog-eem.385 =============== Item was added: + ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- + allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex + | bytes freeChunk chunk | + bytes := self objectBytesForSlots: numSlots. + freeChunk := self allocateOldSpaceChunkOfBytes: bytes. + freeChunk ifNil: + [^nil]. + chunk := self startOfFreeChunk: freeChunk. + numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: chunk put: numSlots. + self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: chunk + self baseHeaderSize + put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). + ^chunk + self baseHeaderSize]. + self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). + ^chunk! Item was removed: - ----- 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 added: + ----- 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 + (numSlots bitAnd: 1) << self shiftForWord + + (numSlots >= self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was removed: - ----- 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 + 4. - ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ifTrue: [followingWordAddress + self baseHeaderSize] - ifFalse: [followingWordAddress]! Item was added: + ----- 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 << self shiftForWord + + (numSlots >= self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was changed: ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') ----- copyAndForward: survivor "copyAndForward: survivor copies a survivor object either to futureSurvivorSpace or, if it is to be promoted, to oldSpace. It leaves a forwarding pointer behind." <inline: true> | bytesInObject newLocation | bytesInObject := manager bytesInObject: survivor. newLocation := ((self shouldBeTenured: survivor) or: [futureSurvivorStart + bytesInObject > futureSpace limit]) + ifTrue: [self copyToOldSpace: survivor] - ifTrue: [self copyToOldSpace: survivor bytes: bytesInObject] ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObject]. manager forward: survivor to: newLocation. ^newLocation! Item was added: + ----- Method: SpurGenerationScavenger>>copyToOldSpace: (in category 'scavenger') ----- + copyToOldSpace: survivor + "Copy survivor to oldSpace. Answer the new oop of the object." + <inline: true> + | numSlots newOop | + self flag: 'why not just pass header??'. + numSlots := manager numSlotsOf: survivor. + newOop := manager + allocateSlotsInOldSpace: numSlots + format: (manager formatOf: survivor) + classIndex: (manager classIndexOf: survivor). + newOop ifNil: + [self error: 'out of memory']. + manager + mem: newOop + manager baseHeaderSize + cp: survivor + manager baseHeaderSize + y: numSlots * manager wordSize. + self remember: newOop. + manager setIsRememberedOf: newOop to: true. + ^newOop! Item was changed: ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') ----- addToFreeList: freeChunk | chunkBytes childBytes parent child index | chunkBytes := self bytesInObject: freeChunk. + index := chunkBytes / self allocationUnit. - index := chunkBytes / self wordSize. index < NumFreeLists ifTrue: + [self storePointer: self freeChunkNextIndex + ofForwardedOrFreeObject: freeChunk + withValue: (freeLists at: index). - [self storePointer: 0 ofForwardedOrFreeObject: freeChunk withValue: (freeLists at: index). freeLists at: index put: freeChunk. ^self]. self storePointer: self freeChunkNextIndex ofForwardedOrFreeObject: freeChunk withValue: 0; storePointer: self freeChunkParentIndex ofForwardedOrFreeObject: freeChunk withValue: 0; storePointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: freeChunk withValue: 0; storePointer: self freeChunkLargerIndex ofForwardedOrFreeObject: freeChunk withValue: 0. "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; add to list at node." [self storePointerUnchecked: self freeChunkNextIndex ofObject: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); storePointerUnchecked: self freeChunkNextIndex ofObject: child withValue: freeChunk. ^self]. "walk down the tree" parent := child. child := self fetchPointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofObject: child]. parent = 0 ifTrue: [self assert: (freeLists at: 0) = 0. freeLists at: 0 put: freeChunk. ^self]. "insert in tree" self storePointerUnchecked: self freeChunkParentIndex ofObject: freeChunk withValue: parent. self storePointerUnchecked: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofObject: parent withValue: freeChunk! 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. - endOfMemory := 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 := 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 added: + ----- 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 caler *must* fill in the header correctly." + | index chunk nextIndex nodeBytes parent child smaller larger | + index := chunkBytes / self allocationUnit. + index < NumFreeLists ifTrue: + [(chunk := freeLists at: index) ~= 0 ifTrue: + [^self unlinkFreeChunk: chunk atIndex: index]. + "first search for free chunks of a multiple of chunkBytes in size" + nextIndex := index. + [(nextIndex := nextIndex + index) < NumFreeLists] whileTrue: + [(chunk := freeLists at: index) ~= 0 ifTrue: + [self unlinkFreeChunk: chunk atIndex: index. + self assert: (self bytesInObject: chunk) = index * self allocationUnit. + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfFreeChunk: chunk) + chunkBytes. + ^chunk]]. + "now get desperate and use the first that'll fit" + nextIndex := index. + [(nextIndex := nextIndex + 1) < NumFreeLists] whileTrue: + [(chunk := freeLists at: index) ~= 0 ifTrue: + [self unlinkFreeChunk: chunk atIndex: index. + self assert: (self bytesInObject: chunk) = index * self allocationUnit. + self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfFreeChunk: chunk) + chunkBytes. + ^chunk]]]. + + "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 + ofForwardedOrFreeObject: child. + chunk ~= 0 ifTrue: + [self storePointer: self freeChunkNextIndex + ofForwardedOrFreeObject: child + withValue: (self fetchPointer: self freeChunkNextIndex + ofForwardedOrFreeObject: 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]) + ofObject: child]]. + parent = 0 ifTrue: + [self halt]. + "self printFreeChunk: parent" + self assert: (self bytesInObject: parent) = nodeBytes. + "attempt to remove from list" + chunk := self fetchPointer: self freeChunkNextIndex + ofForwardedOrFreeObject: parent. + chunk ~= 0 ifTrue: + [self storePointer: self freeChunkNextIndex + ofForwardedOrFreeObject: parent + withValue: (self fetchPointer: self freeChunkNextIndex + ofForwardedOrFreeObject: chunk). + chunkBytes ~= nodeBytes ifTrue: + [self freeChunkWithBytes: nodeBytes - chunkBytes + at: (self startOfFreeChunk: chunk) + chunkBytes]. + ^chunk]. + "no list; remove an interior node" + chunk := parent. + parent := self fetchPointer: self freeChunkParentIndex ofForwardedOrFreeObject: chunk. + "no parent; stitch the subnodes back into the root" + parent = 0 ifTrue: + [smaller := self fetchPointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: chunk. + larger := self fetchPointer: self freeChunkLargerIndex ofForwardedOrFreeObject: chunk. + smaller = 0 + ifTrue: [freeLists at: 0 put: larger] + ifFalse: + [freeLists at: 0 put: smaller. + larger ~= 0 ifTrue: + [self addFreeSubTree: larger]]. + chunkBytes ~= nodeBytes ifTrue: + [self freeChunkWithBytes: nodeBytes - chunkBytes + at: (self startOfFreeChunk: chunk) + chunkBytes]. + ^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>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- + allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex + self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>byteLengthOf: (in category 'object access') ----- byteLengthOf: objOop "Answer the number of indexable bytes in the given object. + Does not adjust contexts by stackPointer." - Does not adjuect contexts by stackPointer." | fmt numBytes | <inline: true> <asmLabel: false> fmt := self formatOf: objOop. numBytes := (self numSlotsOf: objOop) << self shiftForWord. fmt <= self sixtyFourBitIndexableFormat ifTrue: [^numBytes]. fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod" [^numBytes - (fmt bitAnd: 7)]. fmt >= self firstShortFormat ifTrue: [^numBytes - ((fmt bitAnd: 3) << 1)]. "fmt >= self firstLongFormat" ^numBytes - ((fmt bitAnd: 1) << 2)! Item was added: + ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') ----- + freeChunkWithBytes: bytes at: address + <inline: true> + | freeChunk | + freeChunk := self initFreeChunkWithBytes: bytes at: address. + self addToFreeList: freeChunk.! Item was changed: ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> 0 to: NumFreeLists - 1 do: [:i| freeLists at: i put: 0]. freeOldStart := startOfFreeOldSpace. [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: [freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart. self addToFreeList: freeChunk. freeOldStart := self addressAfter: freeChunk]. freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. self addToFreeList: freeChunk. + self assert: (self addressAfter: freeChunk) = endOfMemory. + freeOldSpaceStart := endOfMemory! - self assert: (self addressAfter: freeChunk) = endOfMemory! Item was changed: ----- Method: SpurMemoryManager>>initializePostBootstrap (in category 'simulation') ----- initializePostBootstrap + "The heap has just been bootstrapped into a modified newSpace occupying all of memory + above newSpace (and the codeZone). Put things back to some kind of normalcy." - "The heap has just been bootstrapped into a modified newSpace occupying all of memory above newSPace (and the codeZone). - Put things back to some kind of normalicy." freeOldSpaceStart := freeStart. freeStart := scavenger eden start. pastSpaceStart := scavenger pastSpace start. scavengeThreshold := scavenger eden limit - (scavenger edenBytes / 64)! Item was changed: ----- Method: SpurMemoryManager>>objectAfter: (in category 'object enumeration') ----- objectAfter: objOop "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 slotSize. If the word following an object doesn't have a saturated size field it must be a single-header object. If the word following does have a saturated slotSize it must be the overflow size word." + objOop < newSpaceLimit ifTrue: + [(self isInEden: objOop) ifTrue: + [^self objectAfter: objOop limit: freeStart]. + (self isInSurvivorSpace: objOop) ifTrue: + [^self objectAfter: objOop limit: pastSpaceStart]. + ^self objectAfter: objOop limit: scavenger futureSurvivorStart]. + ^self objectAfter: objOop limit: freeOldSpaceStart! - ^self subclassResponsibility! Item was added: + ----- 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." + | 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 added: + ----- Method: SpurMemoryManager>>objectBefore: (in category 'object enumeration') ----- + objectBefore: objOop + | prev | + prev := nil. + objOop < newSpaceLimit ifTrue: + [self allNewSpaceObjectsDo: + [:o| + o >= objOop ifTrue: + [^prev]. + prev := o]. + ^prev]. + self allOldSpaceObjectsDo: + [:o| + o >= objOop ifTrue: + [^prev]. + prev := o]. + ^prev! Item was added: + ----- Method: SpurMemoryManager>>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." + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') ----- + printFreeChunk: freeChunk + <doNotGenerate> + | numBytes | + numBytes := self bytesInObject: freeChunk. + coInterpreter + print: 'freeChunk @ '; printHexPtr: freeChunk; + print: ' bytes '; printNum: numBytes; + print: ' next '; print: (self fetchPointer: self freeChunkNextIndex + ofForwardedOrFreeObject: freeChunk) hex. + numBytes / self allocationUnit > NumFreeLists ifTrue: + [coInterpreter + print: ' ^ '; print: (self fetchPointer: self freeChunkParentIndex + ofForwardedOrFreeObject: freeChunk) hex; + print: ' < '; print: (self fetchPointer: self freeChunkSmallerIndex + ofForwardedOrFreeObject: freeChunk) hex; + print: ' > '; print: (self fetchPointer: self freeChunkLargerIndex + ofForwardedOrFreeObject: freeChunk) hex]. + coInterpreter cr! Item was added: + ----- Method: SpurMemoryManager>>startOfFreeChunk: (in category 'free space') ----- + startOfFreeChunk: freeChunk + ^freeChunk - self baseHeaderSize! 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." self halt. self assert: numBytes = 0. 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). - andLessThan: 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>>unlinkFreeChunk:atIndex: (in category 'free space') ----- + unlinkFreeChunk: chunk atIndex: index + <inline: true> + self assert: ((self bytesInObject: chunk) = index * self allocationUnit + and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"]). + freeLists + at: index + put: (self + fetchPointer: self freeChunkNextIndex + ofForwardedOrFreeObject: chunk). + ^chunk! Item was added: + ----- Method: VMClass>>oop:isGreaterThanOrEqualTo:andLessThanOrEqualTo: (in category 'oop comparison') ----- + oop: anOop isGreaterThanOrEqualTo: baseOop andLessThanOrEqualTo: limitOop + "Compare two oop values, treating them as object memory locations. + Use #cCoerce:to: to ensure comparison of unsigned magnitudes. This + method will be inlined during C translation." + <inline: true> + ^(self cCoerce: anOop to: #usqInt) >= (self cCoerce: baseOop to: #usqInt) + and: [(self cCoerce: anOop to: #usqInt) <= (self cCoerce: limitOop to: #usqInt)]!

1 0

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

17 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.385.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.385 Author: eem Time: 17 September 2013, 1:37:16.964 pm UUID: b410257e-4d71-461d-b00a-e244c049477c Ancestors: VMMaker.oscog-eem.384 Streamline the sendBreak:point:receiver: monstrosity and make it accept immediate selectors. =============== Diff against VMMaker.oscog-eem.384 =============== Item was changed: ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') ----- ceDynamicSuperSend: selector to: rcvr numArgs: numArgs "Entry-point for an unlinked dynamic super send in a CogMethod. Smalltalk stack looks like receiver args head sp -> sender return pc If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and may choose to allocate a closed PIC with a fast MNU dispatch for this send. Otherwise attempt to link the send site as efficiently as possible. All link attempts may fail; e.g. because we're out of code memory. Continue execution via either executeMethod or interpretMethodFromMachineCode: depending on whether the target method is cogged or not." <api> <option: #NewspeakVM> | class classTag canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication | <inline: false> <var: #cogMethod type: #'CogMethod *'> <var: #newCogMethod type: #'CogMethod *'> "self printExternalHeadFrame" "self printStringOf: selector" cogit assertCStackWellAligned. self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]). + self sendBreakpoint: selector receiver: rcvr. - self sendBreak: selector + BaseHeaderSize - point: (objectMemory lengthOf: selector) - receiver: rcvr. mClassMixin := self mMethodClass. mixinApplication := self findApplicationOfTargetMixin: mClassMixin startingAtBehavior: (objectMemory fetchClassOf: rcvr). self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1). classTag := self classTagForClass: (self superclassOf: mixinApplication). class := objectMemory fetchClassOf: rcvr. "what about the read barrier??" canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses]. argumentCount := numArgs. (self lookupInMethodCacheSel: selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: selector] ifFalse: [messageSelector := selector. (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue: [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag). self assert: false "NOTREACHED"]]. "Method found and has a cog method. Attempt to link to it." (self maybeMethodHasCogMethod: newMethod) ifTrue: [cogMethod := self cogMethodOf: newMethod. cogMethod selector = objectMemory nilObject ifTrue: [cogit setSelectorOf: cogMethod to: selector] ifFalse: ["Deal with anonymous accessors, e.g. in Newspeak. The cogMethod may not have the correct selector. If not, try and compile a new method with the correct selector." cogMethod selector ~= selector ifTrue: [(cogit cog: newMethod selector: selector) ifNotNil: [:newCogMethod| cogMethod := newCogMethod]]]. (cogMethod selector = selector and: [canLinkCacheTag]) ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: cogit dynSuperEntryOffset receiver: rcvr]. instructionPointer := self popStack. self executeNewMethod. self assert: false "NOTREACHED"]. instructionPointer := self popStack. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') ----- ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs "Entry-point for an unlinked send in a CogMethod. Smalltalk stack looks like receiver args head sp -> sender return pc If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and may choose to allocate a closed PIC with a fast MNU dispatch for this send. Otherwise attempt to link the send site as efficiently as possible. All link attempts may fail; e.g. because we're out of code memory. Continue execution via either executeMethod or interpretMethodFromMachineCode: depending on whether the target method is cogged or not." <api> | classTag canLinkCacheTag errSelIdx cogMethod | <inline: false> <var: #cogMethod type: #'CogMethod *'> <var: #newCogMethod type: #'CogMethod *'> "self printExternalHeadFrame" "self printStringOf: selector" cogit assertCStackWellAligned. self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]). + self sendBreakpoint: selector receiver: rcvr. - self sendBreak: selector + BaseHeaderSize - point: (objectMemory lengthOf: selector) - receiver: rcvr. superNormalBar = 0 ifTrue: [classTag := objectMemory fetchClassTagOf: rcvr] ifFalse: [classTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer)))]. canLinkCacheTag := objectMemory hasSpurMemoryManagerAPI or: [(objectMemory isYoungObject: classTag) not or: [cogit canLinkToYoungClasses]]. argumentCount := numArgs. (self lookupInMethodCacheSel: selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: selector] ifFalse: [messageSelector := selector. (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue: [(canLinkCacheTag and: [errSelIdx = SelectorDoesNotUnderstand and: [(cogMethod := cogit cogMNUPICSelector: messageSelector methodOperand: (self mnuMethodOrNilFor: rcvr) numArgs: argumentCount) asUnsignedInteger > cogit minCogMethodAddress]]) ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: (superNormalBar = 0 ifTrue: [cogit entryOffset] ifFalse: [cogit noCheckEntryOffset]) receiver: rcvr]. self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag). self assert: false "NOTREACHED"]]. "Method found and has a cog method. Attempt to link to it. The receiver's class may be young. If the Cogit can't store young classes in inline caches we can link to an open PIC instead." (self maybeMethodHasCogMethod: newMethod) ifTrue: [cogMethod := self cogMethodOf: newMethod. cogMethod selector = objectMemory nilObject ifTrue: [cogit setSelectorOf: cogMethod to: selector] ifFalse: ["Deal with anonymous accessors, e.g. in Newspeak. The cogMethod may not have the correct selector. If not, try and compile a new method with the correct selector." cogMethod selector ~= selector ifTrue: [(cogit cog: newMethod selector: selector) ifNotNil: [:newCogMethod| cogMethod := newCogMethod]]]. (cogMethod selector = selector and: [canLinkCacheTag]) ifTrue: [cogit linkSendAt: (stackPages longAt: stackPointer) in: (self mframeHomeMethod: framePointer) to: cogMethod offset: (superNormalBar = 0 ifTrue: [cogit entryOffset] ifFalse: [cogit noCheckEntryOffset]) receiver: rcvr] ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory" [cogit patchToOpenPICFor: selector numArgs: numArgs receiver: rcvr]. instructionPointer := self popStack. self executeNewMethod. self assert: false "NOTREACHED"]. instructionPointer := self popStack. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>ceSendAbort:to:numArgs: (in category 'trampolines') ----- ceSendAbort: selector to: rcvr numArgs: numArgs "Entry-point for an abort send in a CogMethod (aboutToReturn:through:, cannotReturn: et al). Try and dispatch the send, but the send may turn into an MNU in which case defer to handleMNUInMachineCodeTo:... which will dispatch the MNU. Continue execution via either executeMethod or interpretMethodFromMachineCode: depending on whether the target method is cogged or not." <api> | classTag errSelIdx | <inline: false> "self printExternalHeadFrame" "self printStringOf: selector" cogit assertCStackWellAligned. self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]). + self sendBreakpoint: selector receiver: rcvr. - self sendBreak: selector + BaseHeaderSize - point: (objectMemory lengthOf: selector) - receiver: rcvr. argumentCount := numArgs. classTag := objectMemory fetchClassTagOf: rcvr. (self lookupInMethodCacheSel: selector classTag: classTag) ifTrue:"check for coggability because method is in the cache" [self ifAppropriateCompileToNativeCode: newMethod selector: selector] ifFalse: [messageSelector := selector. (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue: [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag). "NOTREACHED" self assert: false]]. instructionPointer := self popStack. (self maybeMethodHasCogMethod: newMethod) ifTrue: [self executeNewMethod. self assert: false "NOTREACHED"]. ^self interpretMethodFromMachineCode "NOTREACHED"! Item was changed: ----- Method: CoInterpreter>>ceTraceLinkedSend: (in category 'debug support') ----- ceTraceLinkedSend: theReceiver | cogMethod | <api> <var: #cogMethod type: #'CogMethod *'> cogMethod := self cCoerceSimple: (self stackTop - cogit traceLinkedSendOffset) to: #'CogMethod *'. "cogit recordSendTrace ifTrue: is implicit; wouldn't compile the call otherwise." self recordTrace: (objectMemory fetchClassOf: theReceiver) thing: cogMethod selector source: TraceIsFromMachineCode. cogit printOnTrace ifTrue: [self printActivationNameFor: cogMethod methodObject receiver: theReceiver isBlock: false firstTemporary: nil; cr]. + self sendBreakpoint: cogMethod selector receiver: theReceiver! - self sendBreak: cogMethod selector + BaseHeaderSize - point: (objectMemory lengthOf: cogMethod selector) - receiver: theReceiver! Item was changed: ----- Method: CoInterpreter>>commonSend (in category 'message sending') ----- commonSend "Send a message, starting lookup with the receiver's class." "Assume: messageSelector and argumentCount have been set, and that the receiver and arguments have been pushed onto the stack," "Note: This method is inlined into the interpreter dispatch loop." <sharedCodeNamed: 'commonSend' inCase: #singleExtendedSendBytecode> + self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount). - self sendBreak: messageSelector + BaseHeaderSize - point: (objectMemory lengthOf: messageSelector) - receiver: (self internalStackValue: argumentCount). cogit recordSendTrace ifTrue: [self recordTrace: lkupClass thing: messageSelector source: TraceIsFromInterpreter. cogit printOnTrace ifTrue: [self printActivationNameForSelector: messageSelector startClass: lkupClass; cr]]. self internalFindNewMethod. self internalExecuteNewMethod. self fetchNextBytecode! Item was changed: ----- Method: CoInterpreter>>implicitReceiverFor:mixin:implementing: (in category 'newspeak bytecode support') ----- implicitReceiverFor: rcvr mixin: mixin implementing: selector "This is used to implement the innards of the pushImplicitReceiverBytecode, used for implicit receiver sends in NS2/NS3. Find the nearest lexically-enclosing implementation of selector by searching up the static chain of anObject, starting at mixin's application. This is an iterative implementation derived from <ContextPart> implicitReceiverFor: obj <Object> withMixin: mixin <Mixin> implementing: selector <Symbol> ^<Object>" <api> <option: #NewspeakVM> cogit breakOnImplicitReceiver ifTrue: + [self sendBreakpoint: selector receiver: nil]. - [self sendBreak: selector + BaseHeaderSize - point: (objectMemory lengthOf: selector) - receiver: nil]. ^super implicitReceiverFor: rcvr mixin: mixin implementing: selector! Item was changed: ----- Method: CogVMSimulator>>primitivePerform (in category 'debugging traps') ----- primitivePerform | selector | selector := self stackValue: argumentCount - 1. + self sendBreakpoint: selector receiver: (self stackValue: argumentCount). - self sendBreak: selector + BaseHeaderSize - point: (objectMemory lengthOf: selector) - receiver: (self stackValue: argumentCount). (self filterPerformOf: selector to: (self stackValue: argumentCount)) ifTrue: [^self pop: argumentCount]. ^super primitivePerform! Item was changed: ----- Method: NewspeakInterpreter>>commonSend (in category 'message sending') ----- commonSend "Send a message, starting lookup with the receiver's class." "Assume: messageSelector and argumentCount have been set, and that the receiver and arguments have been pushed onto the stack," "Note: This method is inlined into the interpreter dispatch loop." <sharedCodeNamed: 'commonSend' inCase: #singleExtendedSendBytecode> self fastLogSend: messageSelector. + self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount). - self sendBreak: messageSelector + BaseHeaderSize - point: (self lengthOf: messageSelector) - receiver: (self internalStackValue: argumentCount). self internalFindNewMethod. self internalExecuteNewMethod. self fetchNextBytecode! Item was changed: ----- Method: NewspeakInterpreter>>lookupMethodInClass: (in category 'message sending') ----- lookupMethodInClass: class | currentClass dictionary found rclass | <inline: false> currentClass := class. [currentClass ~= nilObj] whileTrue: [dictionary := self fetchPointer: MessageDictionaryIndex ofObject: currentClass. dictionary = nilObj ifTrue: ["MethodDict pointer is nil (hopefully due a swapped out stub) -- raise exception #cannotInterpret:." self pushRemappableOop: currentClass. "may cause GC!!" self createActualMessageTo: class. currentClass := self popRemappableOop. messageSelector := self splObj: SelectorCannotInterpret. self fastLogSend: messageSelector. + self sendBreakpoint: messageSelector receiver: nil. - self sendBreak: messageSelector + BaseHeaderSize - point: (self lengthOf: messageSelector) - receiver: nil. ^ self lookupMethodInClass: (self superclassOf: currentClass)]. found := self lookupMethodInDictionary: dictionary. found ifTrue: [^currentClass]. currentClass := self superclassOf: currentClass]. "Could not find #doesNotUnderstand: -- unrecoverable error." messageSelector = (self splObj: SelectorDoesNotUnderstand) ifTrue: [self error: 'Recursive not understood error encountered']. "Cound not find a normal message -- raise exception #doesNotUnderstand:" self pushRemappableOop: class. "may cause GC!!" self createActualMessageTo: class. rclass := self popRemappableOop. messageSelector := self splObj: SelectorDoesNotUnderstand. RecordSendTrace ifTrue: [self fastLogSend: messageSelector]. self sendBreak: messageSelector + BaseHeaderSize point: (self lengthOf: messageSelector) receiver: nil. ^ self lookupMethodInClass: rclass! Item was changed: ----- Method: NewspeakInterpreter>>primitivePerform (in category 'control primitives') ----- primitivePerform | performSelector newReceiver selectorIndex lookupClass performMethod | performSelector := messageSelector. performMethod := newMethod. messageSelector := self stackValue: argumentCount - 1. newReceiver := self stackValue: argumentCount. "NOTE: the following lookup may fail and be converted to #doesNotUnderstand:, so we must adjust argumentCount and slide args now, so that would work." "Slide arguments down over selector" argumentCount := argumentCount - 1. selectorIndex := self stackPointerIndex - argumentCount. self transfer: argumentCount fromIndex: selectorIndex + 1 ofObject: activeContext toIndex: selectorIndex ofObject: activeContext. self pop: 1. lookupClass := self fetchClassOf: newReceiver. + self sendBreakpoint: messageSelector receiver: newReceiver. - self sendBreak: messageSelector + BaseHeaderSize - point: (self lengthOf: messageSelector) - receiver: newReceiver. self findNewMethodInClass: lookupClass. "Only test CompiledMethods for argument count - other objects will have to take their chances" (self isCompiledMethod: newMethod) ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount]. self successful ifTrue: [self executeNewMethod. "Recursive xeq affects successFlag" self initPrimCall] ifFalse: ["Slide the args back up (sigh) and re-insert the selector. " 1 to: argumentCount do: [:i | self storePointer: argumentCount - i + 1 + selectorIndex ofObject: activeContext withValue: (self fetchPointer: argumentCount - i + selectorIndex ofObject: activeContext)]. self unPop: 1. self storePointer: selectorIndex ofObject: activeContext withValue: messageSelector. argumentCount := argumentCount + 1. newMethod := performMethod. messageSelector := performSelector]! Item was changed: ----- Method: NewspeakInterpreter>>primitivePerformAt: (in category 'control primitives') ----- primitivePerformAt: lookupClass "Common routine used by perform:withArgs: and perform:withArgs:inSuperclass:" "NOTE: The case of doesNotUnderstand: is not a failure to perform. The only failures are arg types and consistency of argumentCount." | performSelector argumentArray arraySize index cntxSize performMethod performArgCount | argumentArray := self stackTop. (self isArray: argumentArray) ifFalse:[^self primitiveFail]. self successful ifTrue: ["Check for enough space in thisContext to push all args" arraySize := self fetchWordLengthOf: argumentArray. cntxSize := self fetchWordLengthOf: activeContext. self success: (self stackPointerIndex + arraySize) < cntxSize]. self successful ifFalse: [^nil]. performSelector := messageSelector. performMethod := newMethod. performArgCount := argumentCount. "pop the arg array and the selector, then push the args out of the array, as if they were on the stack" self popStack. messageSelector := self popStack. "Copy the arguments to the stack, and execute" index := 1. [index <= arraySize] whileTrue: [self push: (self fetchPointer: index - 1 ofObject: argumentArray). index := index + 1]. argumentCount := arraySize. self fastLogSend: messageSelector. + self sendBreakpoint: messageSelector receiver: receiver. - self sendBreak: messageSelector + BaseHeaderSize - point: (self lengthOf: messageSelector) - receiver: receiver. self findNewMethodInClass: lookupClass. "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances" (self isCompiledMethod: newMethod) ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount]. self successful ifTrue: [self executeNewMethod. "Recursive xeq affects successFlag" self initPrimCall] ifFalse: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail" self pop: argumentCount. self push: messageSelector. self push: argumentArray. messageSelector := performSelector. newMethod := performMethod. argumentCount := performArgCount] ! Item was added: + ----- Method: ObjectMemory>>firstFixedFieldOfMaybeImmediate: (in category 'debug support') ----- + firstFixedFieldOfMaybeImmediate: oop + "for the message send breakpoint; selectors can be immediates." + <inline: false> + ^(self isImmediate: oop) + ifTrue: [oop] + ifFalse: [self firstFixedField: oop]! Item was added: + ----- Method: ObjectMemory>>lengthOfMaybeImmediate: (in category 'debug support') ----- + lengthOfMaybeImmediate: oop + "for the message send breakpoint; selectors can be immediates." + <inline: false> + ^(self isImmediate: oop) + ifTrue: [oop] + ifFalse: [self lengthOf: oop]! Item was added: + ----- Method: SpurMemoryManager>>firstFixedFieldOfMaybeImmediate: (in category 'debug support') ----- + firstFixedFieldOfMaybeImmediate: oop + "for the message send breakpoint; selectors can be immediates." + <inline: false> + ^(self isImmediate: oop) + ifTrue: [oop] + ifFalse: [self firstFixedField: oop]! Item was added: + ----- Method: SpurMemoryManager>>lengthOfMaybeImmediate: (in category 'debug support') ----- + lengthOfMaybeImmediate: oop + "for the message send breakpoint; selectors can be immediates." + <inline: false> + ^(self isImmediate: oop) + ifTrue: [oop] + ifFalse: [self lengthOf: oop]! Item was changed: ----- Method: StackInterpreter>>commonSend (in category 'send bytecodes') ----- commonSend "Send a message, starting lookup with the receiver's class." "Assume: messageSelector and argumentCount have been set, and that the receiver and arguments have been pushed onto the stack," "Note: This method is inlined into the interpreter dispatch loop." <sharedCodeNamed: 'commonSend' inCase: #singleExtendedSendBytecode> + self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount). - self sendBreak: messageSelector + BaseHeaderSize - point: (objectMemory lengthOf: messageSelector) - receiver: (self internalStackValue: argumentCount). self printSends ifTrue: [self printActivationNameForSelector: messageSelector startClass: lkupClass; cr]. self internalFindNewMethod. self internalExecuteNewMethod. self fetchNextBytecode! Item was changed: ----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') ----- lookupMethodInClass: class | currentClass dictionary found | <inline: false> self assert: class ~= objectMemory nilObject. currentClass := class. [currentClass ~= objectMemory nilObject] whileTrue: [dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currentClass. dictionary = objectMemory nilObject ifTrue: ["MethodDict pointer is nil (hopefully due a swapped out stub) -- raise exception #cannotInterpret:." self createActualMessageTo: class. messageSelector := objectMemory splObj: SelectorCannotInterpret. + self sendBreakpoint: messageSelector receiver: nil. - self sendBreak: messageSelector + BaseHeaderSize - point: (objectMemory lengthOf: messageSelector) - receiver: nil. ^self lookupMethodInClass: (self superclassOf: currentClass)]. found := self lookupMethodInDictionary: dictionary. found ifTrue: [^currentClass]. currentClass := self superclassOf: currentClass]. "Could not find #doesNotUnderstand: -- unrecoverable error." messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self error: 'Recursive not understood error encountered']. "Cound not find a normal message -- raise exception #doesNotUnderstand:" self createActualMessageTo: class. messageSelector := objectMemory splObj: SelectorDoesNotUnderstand. self sendBreak: messageSelector + BaseHeaderSize point: (objectMemory lengthOf: messageSelector) receiver: nil. ^self lookupMethodInClass: class! Item was changed: ----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') ----- primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass "Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:, object:perform:withArgs:inClass: et al. Answer nil on success. NOTE: The case of doesNotUnderstand: is not a failure to perform. The only failures are arg types and consistency of argumentCount. Since we're in the stack VM we can assume there is space to push the arguments provided they are within limits (max argument count is 15). We can therefore deal with the arbitrary amount of state to remove from the stack (lookup class, selector, mirror receiver) and arbitrary argument orders by deferring popping anything until we know whether the send has succeeded. So on failure we merely have to remove the actual receiver and arguments pushed, and on success we have to slide the actual receiver and arguments down to replace the original ones." | arraySize performArgCount delta | (objectMemory isArray: argumentArray) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. "Check if number of arguments is reasonable; MaxNumArgs isn't available so just use LargeContextSize" arraySize := objectMemory fetchWordLengthOf: argumentArray. arraySize > LargeContextSlots ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs]. performArgCount := argumentCount. "Push newMethod to save it in case of failure, then push the actual receiver and args out of the array." self push: newMethod. self push: actualReceiver. "Copy the arguments to the stack, and execute" 1 to: arraySize do: [:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)]. argumentCount := arraySize. messageSelector := selector. + self sendBreakpoint: messageSelector receiver: actualReceiver. - self sendBreak: messageSelector + BaseHeaderSize - point: (objectMemory lengthOf: messageSelector) - receiver: actualReceiver. self printSends ifTrue: [self printActivationNameForSelector: messageSelector startClass: lookupClass; cr]. self findNewMethodInClassTag: (objectMemory classTagForClass: lookupClass). "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances" ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail" self pop: arraySize + 1. newMethod := self popStack. ^self primitiveFailFor: PrimErrBadNumArgs]. "Cannot fail this primitive from here-on. Slide the actual receiver and arguments down to replace the perform arguments and saved newMethod and then execute the new method. Use argumentCount not arraySize because an MNU may have changed it." delta := BytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod" argumentCount * BytesPerWord to: 0 by: BytesPerWord negated do: [:offset| stackPages longAt: stackPointer + offset + delta put: (stackPages longAt: stackPointer + offset)]. self pop: performArgCount + 2. self executeNewMethod. self initPrimCall. "Recursive xeq affects primErrorCode" ^nil! Item was added: + ----- Method: StackInterpreter>>sendBreakpoint:receiver: (in category 'debug support') ----- + sendBreakpoint: selector receiver: receiver + <inline: true> + self sendBreak: (objectMemory firstFixedFieldOfMaybeImmediate: selector) + point: (objectMemory lengthOfMaybeImmediate: selector) + receiver: receiver! Item was changed: ----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') ----- primitivePerform <returnTypeC: #void> | newReceiver lookupClassTag performMethod | performMethod := newMethod. messageSelector := self stackValue: argumentCount - 1. newReceiver := self stackValue: argumentCount. "NOTE: the following lookup may fail and be converted to #doesNotUnderstand:, so we must adjust argumentCount and slide args now, so that will work." "Slide arguments down over selector" argumentCount := argumentCount - 1. argumentCount to: 1 by: -1 do: [:i| stackPages longAt: stackPointer + (i * BytesPerWord) put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))]. self pop: 1. lookupClassTag := objectMemory fetchClassTagOf: newReceiver. + self sendBreakpoint: messageSelector receiver: newReceiver. - self sendBreak: messageSelector + BaseHeaderSize - point: (objectMemory lengthOf: messageSelector) - receiver: newReceiver. self printSends ifTrue: [self printActivationNameForSelector: messageSelector startClass: (objectMemory classForClassTag: lookupClassTag); cr]. self findNewMethodInClassTag: lookupClassTag. "Only test CompiledMethods for argument count - other objects will have to take their chances" ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse: ["Slide the args back up (sigh) and re-insert the selector." self unPop: 1. 1 to: argumentCount by: 1 do: [:i | stackPages longAt: stackPointer + ((i - 1) * BytesPerWord) put: (stackPages longAt: stackPointer + (i * BytesPerWord))]. stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector. argumentCount := argumentCount + 1. newMethod := performMethod. ^self primitiveFail]. self executeNewMethod. "Recursive xeq affects primErrorCode" self initPrimCall!

1 0

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

17 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.384.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.384 Author: eem Time: 16 September 2013, 11:20:50.955 pm UUID: f038e5ef-a20a-41e7-9ac6-7881b5fd4ad8 Ancestors: VMMaker.oscog-eem.383 Fix store check in inPlaceBecome:and:copyHashFlag:. Bootstrap now gets as far as wanting to tenure obejcts during scavenge, 2801 rehashes in. Fix lastPointerOf: enumeration and checking for remembering in SMM>>checkHeapIntegrity. Refactor possibleRootStoreInto:[value:] to lose unused param. Make fetchClassofNonImm: more lenient so class table pages can be printed. =============== Diff against VMMaker.oscog-eem.383 =============== Item was changed: ----- 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." | ok numRememberedRootsInHeap | <inline: false> ok := true. numRememberedRootsInHeap := 0. self allObjectsDo: + [:obj| | containsYoung fieldOop classIndex classOop | - [:obj| | 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 isRemembered: obj) ifTrue: - [numRememberedRootsInHeap := numRememberedRootsInHeap + 1]. (self isForwarded: obj) ifTrue: [fieldOop := self fetchPointer: 0 ofForwardedOrFreeObject: 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]] - ok := false]] 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: - 0 to: (self lastPointerOf: obj) by: BytesPerOop do: [:ptr| + fieldOop := self longAt: obj + ptr. - fieldOop := self longAt: ptr. (self isNonImmediate: fieldOop) ifTrue: [| fi | + fi := ptr - self baseHeaderSize / self wordSize. - fi := ptr - (obj + self baseHeaderSize). (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]]]]. - ok := false]]]]]]]. 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 changed: ----- Method: Spur32BitMemoryManager>>storePointer:ofForwardedOrFreeObject:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofForwardedOrFreeObject: objOop withValue: valuePointer (self isForwarded: objOop) ifTrue: [(self isYoung: objOop) ifFalse: "most stores into young objects" [((self isNonImmediate: valuePointer) and: [self isYoung: valuePointer]) ifTrue: + [self possibleRootStoreInto: objOop]]]. - [self possibleRootStoreInto: objOop value: valuePointer]]]. ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: ----- 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 possibleRootStoreInto: objOop value: valuePointer]]]. ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: ----- 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 possibleRootStoreInto: objOop value: valuePointer]]]. ^self longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was added: + ----- Method: SpurGenerationScavenger>>isInRememberedTable: (in category 'store check') ----- + isInRememberedTable: objOop + 0 to: rememberedSetSize - 1 do: + [:i| + (rememberedSet at: i) = objOop ifTrue: + [^true]]. + ^false! Item was changed: ----- Method: SpurMemoryManager>>fetchClassOfNonImm: (in category 'object access') ----- fetchClassOfNonImm: objOop | classIndex | classIndex := self classIndexOf: objOop. classIndex = self classIsItselfClassIndexPun ifTrue: [^objOop]. + self assert: classIndex >= self arrayClassIndexPun. - self assert: classIndex >= FirstValidClassIndex. ^self classAtIndex: classIndex! Item was changed: ----- Method: SpurMemoryManager>>inPlaceBecome:and:copyHashFlag: (in category 'become implementation') ----- inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag + "Do become in place by swapping object contents." + | headerTemp temp1 temp2 o1HasYoung o2HasYoung | - | headerTemp temp | <var: 'headerTemp' type: #usqLong> self assert: (self numSlotsOf: obj1) = (self numSlotsOf: obj2). + "swap headers, but swapping headers swaps remembered bits; + these need to be unswapped." + temp1 := self isRemembered: obj1. + temp2 := self isRemembered: obj2. - (self isRemembered: obj1) - ifTrue: - [(self isRemembered: obj1) ifFalse: - [scavenger - replace: obj1 - inRememberedTableWith: obj2]] - ifFalse: - [(self isRemembered: obj2) ifTrue: - [scavenger - replace: obj2 - inRememberedTableWith: obj1]]. headerTemp := self longLongAt: obj1. self longLongAt: obj1 put: (self longLongAt: obj2). self longLongAt: obj2 put: headerTemp. + self setIsRememberedOf: obj1 to: temp1. + self setIsRememberedOf: obj2 to: temp2. + "swapping headers swaps hash; if !!copyHashFlagundo hash copy" + copyHashFlag ifFalse: + [temp1 := self rawHashBitsOf: obj1. - copyHashFlag ifFalse: "undo hash copy" - [temp := self rawHashBitsOf: obj1. self setHashBitsOf: obj1 to: (self rawHashBitsOf: obj2). + self setHashBitsOf: obj2 to: temp1]. + o1HasYoung := o2HasYoung := false. - self setHashBitsOf: obj2 to: temp]. 0 to: (self numSlotsOf: obj1) - 1 do: [:i| + temp1 := self fetchPointer: i ofObject: obj1. + temp2 := self fetchPointer: i ofObject: obj2. - temp := self fetchPointer: i ofObject: obj1. self storePointerUnchecked: i ofObject: obj1 + withValue: temp2. - withValue: (self fetchPointer: i ofObject: obj2). self storePointerUnchecked: i ofObject: obj2 + withValue: temp1. + ((self isNonImmediate: temp2) and: [self isYoung: temp2]) ifTrue: + [o1HasYoung := true]. + ((self isNonImmediate: temp1) and: [self isYoung: temp1]) ifTrue: + [o2HasYoung := true]]. + (self isYoung: obj1) ifFalse: + [o1HasYoung ifTrue: + [self possibleRootStoreInto: obj1]]. + (self isYoung: obj2) ifFalse: + [o2HasYoung ifTrue: + [self possibleRootStoreInto: obj2]]! - withValue: temp]! Item was added: + ----- Method: SpurMemoryManager>>possibleRootStoreInto: (in category 'store check') ----- + possibleRootStoreInto: destObj + (#( storePointer:ofObject:withValue: + storePointer:ofForwardedOrFreeObject:withValue: + inPlaceBecome:and:copyHashFlag:) includes: thisContext sender method selector) ifFalse: + [self halt]. + (self isRemembered: destObj) ifFalse: + [scavenger remember: destObj. + self setIsRememberedOf: destObj to: true]! Item was removed: - ----- Method: SpurMemoryManager>>possibleRootStoreInto:value: (in category 'store check') ----- - possibleRootStoreInto: destObj value: valueOop - (#( storePointer:ofObject:withValue: - storePointer:ofForwardedOrFreeObject:withValue:) includes: thisContext sender method selector) ifFalse: - [self halt]. - (self isRemembered: destObj) ifFalse: - [scavenger remember: destObj. - self setIsRememberedOf: destObj to: true]! Item was changed: ----- Method: StackInterpreter>>findClassContainingMethod:startingAt: (in category 'debug support') ----- findClassContainingMethod: meth startingAt: classObj | currClass classDict classDictSize methodArray i | currClass := classObj. + [self assert: (objectMemory isForwarded: currClass) not. + classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. + self assert: (objectMemory isForwarded: classDict) not. - [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. classDictSize := objectMemory fetchWordLengthOf: classDict. methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. + self assert: (objectMemory isForwarded: methodArray) not. i := 0. [i < (classDictSize - SelectorStart)] whileTrue: [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [^currClass]. i := i + 1]. currClass := self superclassOf: currClass. currClass = objectMemory nilObject] whileFalse. ^currClass "method not found in superclass chain"!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
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