Vm-dev October 2013

vm-dev@lists.squeakfoundation.org

30 participants
145 discussions

VM Maker: VMMaker.oscog-eem.461.mcz
by commits＠source.squeak.org 16 Oct '13

16 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.461.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.461 Author: eem Time: 15 October 2013, 5:05:16.314 pm UUID: b9156f41-92ae-4136-9d68-6ca927322513 Ancestors: VMMaker.oscog-eem.460 Update class table entries post two-way become. class table entries must correspond to class identityHashes, so swapping is needed if not copyHashFlag. Rename ...become:with:... to ...become:and:. Simulator successfully implements e.g. Morph addInstVarName: 'foo' =============== Diff against VMMaker.oscog-eem.460 =============== Item was changed: ----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in category 'become api') ----- become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag "All references to each object in array1 are swapped with all references to the corresponding object in array2. That is, all pointers to one object are replaced with with pointers to the other. The arguments must be arrays of the same length. Answers PrimNoErr if the primitive succeeds, otherwise a relevant error code." "Implementation: Uses lazy forwarding to defer updating references until message send." | ec | self assert: becomeEffectsFlags = 0. self leakCheckBecome ifTrue: [self runLeakCheckerForFullGC: true]. (self isArray: array1) ifFalse: [^PrimErrBadReceiver]. ((self isArray: array2) and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse: [^PrimErrBadArgument]. (twoWayFlag or: [copyHashFlag]) ifTrue: [ec := self containsOnlyValidBecomeObjects: array1 and: array2] ifFalse: [self followForwardedObjectFields: array2 toDepth: 0. ec := self containsOnlyValidBecomeObjects: array1]. ec ~= 0 ifTrue: [^ec]. coInterpreter preBecomeAction. twoWayFlag ifTrue: + [self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag] - [self innerBecomeObjectsIn: array1 with: array2 copyHash: copyHashFlag] ifFalse: [self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag]. self postBecomeScanClassTable. coInterpreter postBecomeAction: becomeEffectsFlags. becomeEffectsFlags := 0. self leakCheckBecome ifTrue: [self runLeakCheckerForFullGC: true]. ^PrimNoErr "success"! Item was added: + ----- Method: SpurMemoryManager>>classAtIndex:put: (in category 'class table') ----- + classAtIndex: classIndex put: objOop + "for become & GC of classes" + | classTablePage | + self assert: (classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun]). + self assert: (objOop = nilObj or: [(self rawHashBitsOf: objOop) = classIndex]). + classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift + ofObject: classTableRootObj. + classTablePage = nilObj ifTrue: + [self error: 'attempt to add class to empty page']. + ^self + storePointer: (classIndex bitAnd: self classTableMinorIndexMask) + ofObject: classTablePage + withValue: objOop! Item was added: + ----- Method: SpurMemoryManager>>doBecome:and:copyHash: (in category 'become implementation') ----- + doBecome: obj1 and: obj2 copyHash: copyHashFlag + "Inner dispatch for two-way become" + <returnTypeC: #void> + | o1ClassIndex o2ClassIndex | + copyHashFlag ifFalse: + ["in-lined + clasIndex := (self isInClassTable: obj) ifTrue: [self rawHashBitsOf: obj] ifFalse: [0] + for speed." + o1ClassIndex := self rawHashBitsOf: obj1. + (o1ClassIndex ~= 0 and: [(self classAtIndex: o1ClassIndex) ~= obj1]) ifTrue: + [o1ClassIndex := 0]. + o2ClassIndex := self rawHashBitsOf: obj2. + (o2ClassIndex ~= 0 and: [(self classAtIndex: o2ClassIndex) ~= obj2]) ifTrue: + [o2ClassIndex := 0]]. + (self numSlotsOf: obj1) = (self numSlotsOf: obj2) + ifTrue: + [self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag] + ifFalse: + [self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]. + "if copyHashFlag then nothing changes, since hashes were also swapped." + copyHashFlag ifTrue: + [^self]. + "if copyHash is false then the classTable entries must be updated." + o1ClassIndex ~= 0 + ifTrue: + [o2ClassIndex ~= 0 + ifTrue: "both were in the table; just swap entries" + [| tmp | + tmp := self classAtIndex: o1ClassIndex. + self classAtIndex: o1ClassIndex put: obj2. + self classAtIndex: o2ClassIndex put: tmp] + ifFalse: "o2 wasn't in the table; put it there" + [| newObj2 | + newObj2 := self followForwarded: obj2. + self assert: (self rawHashBitsOf: newObj2) = 0. + self setHashBitsOf: newObj2 to: o1ClassIndex. + self classAtIndex: o1ClassIndex put: newObj2]] + ifFalse: + [o2ClassIndex ~= 0 ifTrue: + [| newObj1 | + newObj1 := self followForwarded: obj1. + self assert: (self rawHashBitsOf: newObj1) = 0. + self setHashBitsOf: newObj1 to: o2ClassIndex. + self classAtIndex: o2ClassIndex put: newObj1]]! Item was removed: - ----- Method: SpurMemoryManager>>doBecome:with:copyHash: (in category 'become implementation') ----- - doBecome: obj1 with: obj2 copyHash: copyHashFlag - ((self isInClassTable: obj1) - or: [self isInClassTable: obj1]) ifTrue: - [self halt]. - (self numSlotsOf: obj1) = (self numSlotsOf: obj2) - ifTrue: - [self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag] - ifFalse: - [self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]! 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 | <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. 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 !!copyHashFlag undo hash copy" - "swapping headers swaps hash; if !!copyHashFlagundo hash copy" copyHashFlag ifFalse: [temp1 := self rawHashBitsOf: obj1. self setHashBitsOf: obj1 to: (self rawHashBitsOf: obj2). self setHashBitsOf: obj2 to: temp1]. o1HasYoung := o2HasYoung := false. 0 to: (self numSlotsOf: obj1) - 1 do: [:i| temp1 := self fetchPointer: i ofObject: obj1. temp2 := self fetchPointer: i ofObject: obj2. self storePointerUnchecked: i ofObject: obj1 withValue: temp2. 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]]! Item was added: + ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:and:copyHash: (in category 'become implementation') ----- + innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag + "Inner loop of two-way become." + 0 to: (self numSlotsOf: array1) - 1 do: + [:i| | obj1 obj2 | + obj1 := self fetchPointer: i ofObject: array1. + obj2 := self fetchPointer: i ofObject: array2. + self doBecome: obj1 and: obj2 copyHash: copyHashFlag. + (self isForwarded: obj1) ifTrue: + [obj1 := self followForwarded: obj1. + self storePointer: i ofObject: array1 withValue: obj1]. + (self isForwarded: obj2) ifTrue: + [obj2 := self followForwarded: obj2. + self storePointer: i ofObject: array2 withValue: obj2]]! Item was removed: - ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:with:copyHash: (in category 'become implementation') ----- - innerBecomeObjectsIn: array1 with: array2 copyHash: copyHashFlag - "Inner loop of two-way become." - 0 to: (self numSlotsOf: array1) - 1 do: - [:i| | obj1 obj2 | - obj1 := self fetchPointer: i ofObject: array1. - obj2 := self fetchPointer: i ofObject: array2. - self doBecome: obj1 with: obj2 copyHash: copyHashFlag. - (self isForwarded: obj1) ifTrue: - [obj1 := self followForwarded: obj1. - self storePointer: i ofObject: array1 withValue: obj1]. - (self isForwarded: obj2) ifTrue: - [obj2 := self followForwarded: obj2. - self storePointer: i ofObject: array2 withValue: obj2]]! Item was changed: + ----- Method: SpurMemoryManager>>isInClassTable: (in category 'class table') ----- - ----- Method: SpurMemoryManager>>isInClassTable: (in category 'become implementation') ----- isInClassTable: objOop | hash | hash := self rawHashBitsOf: objOop. hash = 0 ifTrue: [false]. ^(self classAtIndex: hash) = objOop!

1 0

VM Maker: VMMaker.oscog-eem.460.mcz
by commits＠source.squeak.org 16 Oct '13

16 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.460.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.460 Author: eem Time: 15 October 2013, 4:16:39.921 pm UUID: 8deb49e7-9138-443d-9650-a99a3daf0963 Ancestors: VMMaker.oscog-eem.459 Add classTableBitmap and numClassTablePages to SpurMemMgr. classaTableBitmap used to expunge duplicate entries from class table, and eventually to GC classes. Enter used class indices into bitmap when swizzling and expunge duplicate entries there-after. Make primitiveForceTenure a SqueakV3ObjectMemory option (for now). Nuke unused isImmediateObject:. Update SpurMemMgr's class cmment with more accurate design info, as well as adding new inst var descriptions. Rename isClassInClassTable: to isInClassTable:. Fix SpurMemMgr>>initialize to init the right part of extraRoots. =============== Diff against VMMaker.oscog-eem.459 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveForceTenure (in category 'I/O primitives') ----- primitiveForceTenure "Set force tenure flag to true, this forces a tenure operation on the next incremental GC" <export: true> + <option: #SqueakV3ObjectMemory> objectMemory forceTenureFlag: 1! Item was removed: - ----- Method: ObjectMemory>>isImmediateObject: (in category 'interpreter access') ----- - isImmediateObject: objectPointer - - ^(objectPointer bitAnd: 1) > 0! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was added: + ----- Method: SpurMemoryManager class>>classTableBitmapBytes (in category 'accessing') ----- + classTableBitmapBytes + "Max size of the classTableBitmap. A liottle too large to contemplate allocating statically." + ^1 << (self basicNew classIndexFieldWidth - (BitsPerByte log: 2) asInteger)! Item was changed: ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator + self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart + lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks) - self declareCAsOop: #(memory freeStart scavengeThreshold newSpaceLimit lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks) in: aCCodeGenerator. self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']) in: aCCodeGenerator. - aCCodeGenerator var: #freeLists declareC: #'sqInt *freeLists'. aCCodeGenerator + var: #freeLists type: #'sqInt *'; + var: #classTableBitmap type: #'unsigned char *'. + aCCodeGenerator var: #remapBuffer declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'. aCCodeGenerator var: #extraRoots + declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.! - declareC: 'sqInt* extraRoots[ExtraRootSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.! Item was changed: ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') ----- initialize + BitsPerByte := 8. + + "SpurMemoryManager initialize" - "CogObjectMemory initialize" CheckObjectOverwrite := true. "The remap buffer support is for compatibility; Spur doesn't GC during allocation. Eventually this should die." RemapBufferSize := 25. "Extra roots are for plugin support." ExtraRootsSize := 2048 "max. # of external roots"! Item was changed: ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') ----- adjustAllOopsBy: bytesToShift "Adjust all oop references by the given number of bytes. This is done just after reading in an image when the new base address of the object heap is different from the base address in the image, + or when loading multiple segments that have been coallesced. Also + set bits in the classTableBitmap corresponding to used classes." - or when loading multiple segments that have been coallesced." | obj | + self countNumClassPagesPreSwizzle: bytesToShift; + ensureAdequateClassTableBitmap. (bytesToShift ~= 0 + or: [segmentManager numSegments > 1]) + ifTrue: + [self assert: self newSpaceIsEmpty. + obj := self objectStartingAt: newSpaceLimit. + [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: + [(self isFreeObject: obj) + ifTrue: [self swizzleFieldsOfFreeChunk: obj] + ifFalse: + [self inClassTableBitmapSet: (self classIndexOf: obj). + self swizzleFieldsOfObject: obj]. + obj := self objectAfter: obj]] + ifFalse: + [self assert: self newSpaceIsEmpty. + obj := self objectStartingAt: newSpaceLimit. + [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: + [(self isFreeObject: obj) ifFalse: + [self inClassTableBitmapSet: (self classIndexOf: obj)]. + obj := self objectAfter: obj]]! - or: [segmentManager numSegments > 1]) ifTrue: - [self assert: self newSpaceIsEmpty. - obj := self objectStartingAt: newSpaceLimit. - [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: - [(self isFreeObject: obj) - ifTrue: [self swizzleFieldsOfFreeChunk: obj] - ifFalse: [self swizzleFieldsOfObject: obj]. - obj := self objectAfter: obj]]! 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. Break up a larger chunk if one of the exact size does not exist. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | initialIndex chunk index nodeBytes parent child smaller larger | "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" initialIndex := chunkBytes / self allocationUnit. (initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: [(freeListsMask anyMask: 1 << initialIndex) ifTrue: [(chunk := freeLists at: initialIndex) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self assert: (self isValidFreeObject: chunk). ^self unlinkFreeChunk: chunk atIndex: initialIndex]. freeListsMask := freeListsMask - (1 << initialIndex)]. "first search for free chunks of a multiple of chunkBytes in size" index := initialIndex. [(index := index + index) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self assert: (self isValidFreeObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = (index * self allocationUnit). self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit. Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence start at initialIndex + 2." index := initialIndex + 1. [(index := index + 1) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self assert: (self isValidFreeObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = (index * self allocationUnit). self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the smallest chunk at least as large as chunkBytes, or 0 if none." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [| childBytes | self assert: (self isValidFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self assert: (self isValidFreeObject: chunk). self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^self startOfObject: chunk]. child := 0] "break out of loop to remove interior node" ifFalse: ["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger." childBytes <= (chunkBytes + self allocationUnit) ifTrue: "node too small; walk down the larger size of the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [parent := child. "parent will be smallest node >= chunkBytes + allocationUnit" nodeBytes := childBytes. child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" - self halt. ^nil]. "self printFreeChunk: parent" self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]). self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]). self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "no list; remove an interior node; 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 | 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 |" chunk := parent. smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. parent = 0 ifTrue: "no parent; stitch the subnodes back into the root" [smaller = 0 ifTrue: [self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0. freeLists at: 0 put: larger] ifFalse: [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0. freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]] ifFalse: "parent; stitch back into appropriate side of parent." [smaller = 0 ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: larger. self storePointer: self freeChunkParentIndex ofObject: larger withValue: parent] ifFalse: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: smaller. self storePointer: self freeChunkParentIndex ofObject: smaller withValue: parent. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]]. "if there's space left over, add the fragment back." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk! Item was changed: + ----- Method: SpurMemoryManager>>classTableRootObj: (in category 'class table') ----- - ----- Method: SpurMemoryManager>>classTableRootObj: (in category 'accessing') ----- classTableRootObj: anOop classTableRootObj := anOop. classTableFirstPage := self fetchPointer: 0 ofObject: classTableRootObj. + self assert: (self numSlotsOf: classTableRootObj) = self classTableRootSlots. - self assert: (self numSlotsOf: classTableRootObj) = (1 << (self classIndexFieldWidth - self classTableMajorIndexShift)). self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask. + "Set classTableIndex to the start of the last used page (excepting first page). + Set numClassTablePages to the number of used pages." + numClassTablePages := self numSlotsOf: classTableRootObj. + 2 to: numClassTablePages - 1 do: - "set classTableIndex to the start of the last used page" - 2 to: (self numSlotsOf: classTableRootObj) - 1 do: [:i| (self fetchPointer: i ofObject: classTableRootObj) = nilObj ifTrue: + [numClassTablePages := i. + classTableIndex := (numClassTablePages - 1 max: 1) << self classTableMajorIndexShift. - [classTableIndex := i << self classTableMajorIndexShift. ^self]]. "no unused pages; set it to the start of the second page." classTableIndex := 1 << self classTableMajorIndexShift! Item was added: + ----- Method: SpurMemoryManager>>classTableRootSlots (in category 'class table') ----- + classTableRootSlots + "Answer the number of slots in the root of the class table." + ^1 << (self classIndexFieldWidth - self classTableMajorIndexShift)! Item was added: + ----- Method: SpurMemoryManager>>countNumClassPagesPreSwizzle: (in category 'class table') ----- + countNumClassPagesPreSwizzle: bytesToShift + "Compute the used size of the class table before swizzling. Needed to + initialize the classTableBitmap which is populated during adjustAllOopsBy:" + <returnTypeC: #void> + | firstObj classTableRoot nilObjPreSwizzle | + firstObj := self objectStartingAt: newSpaceLimit. "a.k.a. nilObj" + "first five objects are nilObj, falseObj, trueObj, freeListsObj, classTableRootObj" + classTableRoot := self objectAfter: + (self objectAfter: + (self objectAfter: + (self objectAfter: firstObj + limit: freeOldSpaceStart) + limit: freeOldSpaceStart) + limit: freeOldSpaceStart) + limit: freeOldSpaceStart. + nilObjPreSwizzle := newSpaceLimit - bytesToShift. + numClassTablePages := self numSlotsOf: classTableRoot. + self assert: numClassTablePages = self classTableRootSlots. + 2 to: numClassTablePages - 1 do: + [:i| + (self fetchPointer: i ofObject: classTableRoot) = nilObjPreSwizzle ifTrue: + [numClassTablePages := i. + ^self]] + ! Item was changed: ----- Method: SpurMemoryManager>>doBecome:with:copyHash: (in category 'become implementation') ----- doBecome: obj1 with: obj2 copyHash: copyHashFlag + ((self isInClassTable: obj1) + or: [self isInClassTable: obj1]) ifTrue: - ((self isClassInClassTable: obj1) - or: [self isClassInClassTable: obj1]) ifTrue: [self halt]. (self numSlotsOf: obj1) = (self numSlotsOf: obj2) ifTrue: [self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag] ifFalse: [self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]! Item was added: + ----- Method: SpurMemoryManager>>ensureAdequateClassTableBitmap (in category 'class table') ----- + ensureAdequateClassTableBitmap + "The classTableBitmap is used to reclaim unused and/or duplicate entries + in the classTable. As such it is notionally 2^(22 - 3) bytes big, or 512k, + a little too large to be comfortable allocating statically (especially on small + machines). So make it big enough for the max classTableIndex's base 2 ceiling." + <inline: false> + | requiredSize | + requiredSize := (1 << numClassTablePages highBit) + * (self classTablePageSize / BitsPerByte). + self cCode: + [classTableBitmap ifNotNil: + [self free: classTableBitmap]. + classTableBitmap := self malloc: requiredSize. + classTableBitmap ifNil: + [self error: 'could not allocate classTableBitmap']. + self me: classTableBitmap ms: 0 et: requiredSize] + inSmalltalk: + [classTableBitmap := CArrayAccessor on: (ByteArray new: requiredSize)]! 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." <inline: false> | 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 allocateSlotsInOldSpace: 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. + numClassTablePages := numClassTablePages + 1. 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. + self ensureAdequateClassTableBitmap. ^0]]. majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1. majorIndex = initialMajorIndex ifTrue: "wrapped; table full" [^PrimErrLimitExceeded]] repeat! Item was added: + ----- Method: SpurMemoryManager>>expungeDuplicateClasses (in category 'class table') ----- + expungeDuplicateClasses + "Bits have been set in the classTableBitmap corresponding to + used classes. Any class in the class table that does not have a + bit set has no instances with that class index. However, becomeForward: + can create duplicate entries, and these duplicate entries + a) won't have a bit set on load (because there are no forwarders on load), + b) wont match their identityHash. + So expunge duplicates by eliminating unmarked entries that don't occur at + their identityHash." + 1 to: numClassTablePages - 1 do: + [:i| | classTablePage | + "optimize scan by only scanning bitmap in regions that have pages." + classTablePage := self fetchPointer: i ofObject: classTableRootObj. + classTablePage ~= nilObj ifTrue: + [i << self classTableMajorIndexShift + to: i << self classTableMajorIndexShift + self classTableMinorIndexMask + by: 8 + do: [:majorBitIndex| | byteIndex byte classIndex classOrNil | + "optimize scan by scanning a byte of indices (8 indices) at a time" + byteIndex := majorBitIndex / BitsPerByte. + byte := classTableBitmap at: byteIndex. + byte ~= 255 ifTrue: + [0 to: 7 do: + [:minorBitIndex| + (byte noMask: 1 << minorBitIndex) ifTrue: + [classIndex := majorBitIndex + minorBitIndex. + classOrNil := self fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask) + ofObject: classTablePage. + self assert: (self classAtIndex: classIndex) = classOrNil. + "only remove a class if it is at a duplicate entry" + (classOrNil ~= nilObj + and: [(self rawHashBitsOf: classOrNil) ~= classIndex]) ifTrue: + [self storePointerUnchecked: (classIndex bitAnd: self classTableMinorIndexMask) + ofObject: classTablePage + withValue: nilObj. + "but it should still be in the table at its correct index." + self assert: ((self classAtIndex: (self rawHashBitsOf: classOrNil)) = classOrNil)]]]]]]]! Item was added: + ----- Method: SpurMemoryManager>>expungeFromClassTable: (in category 'class table') ----- + expungeFromClassTable: aBehavior + "Remove aBehavior from the class table." + <inline: false> + | classIndex majorIndex minorIndex classTablePage | + self assert: (self isInClassTable: aBehavior). + classIndex := self rawHashBitsOf: aBehavior. + majorIndex := classIndex >> self classTableMajorIndexShift. + minorIndex := classIndex bitAnd: self classTableMinorIndexMask. + classTablePage := self fetchPointer: majorIndex ofObject: classTableRootObj. + self assert: classTablePage ~= classTableFirstPage. + self assert: (self numSlotsOf: classTablePage) = self classTablePageSize. + self assert: (self fetchPointer: minorIndex ofObject: classTablePage) = aBehavior. + self storePointerUnchecked: minorIndex ofObject: classTablePage withValue: nilObj. + "If the removed class is before the classTableIndex, set the + classTableIndex to point to the empty slot so as to reuse it asap." + classIndex < classTableIndex ifTrue: + [classTableIndex := classIndex]! Item was changed: ----- Method: SpurMemoryManager>>formatOf: (in category 'object access') ----- formatOf: objOop "0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 unused, reserved for exotic pointer objects? 7 Forwarded Object, 1st field is pointer, rest of fields are ignored 8 unused, reserved for exotic non-pointer objects? 9 (?) 64-bit indexable + 10 - 11 32-bit indexable (11 unused in 32 bits) + 12 - 15 16-bit indexable (14 & 15 unused in 32-bits) + 16 - 23 byte indexable (20-23 unused in 32-bits) + 24 - 31 compiled method (28-21 unused in 32-bits)" - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" ^(self longAt: objOop) >> self formatShift bitAnd: self formatMask! Item was added: + ----- Method: SpurMemoryManager>>inClassTableBitmapSet: (in category 'class table') ----- + inClassTableBitmapSet: classIndex + | bit majorIndex | + self assert: (classIndex >= 0 and: [classIndex <= self classIndexMask]). + majorIndex := classIndex // BitsPerByte. + bit := 1 << (classIndex bitAnd: BitsPerByte - 1). + classTableBitmap + at: majorIndex + put: ((classTableBitmap at: majorIndex) bitOr: bit)! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. + remapBufferCount := extraRootCount := 0. "see below" - remapBufferCount := extraRoots := 0. "see below" freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0. statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0. self flag: #temporary. shrinkThreshold := 16r10000000. "something huge for now" "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. "N.B. We *don't* initialize extraRoots because we don't simulate it."! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory memoryLimit specialObjectsOop lastHash " <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: BaseHeaderSize = self baseHeaderSize. segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. segmentManager numSegments > 0 "false if Spur image bootstrap" ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop] ifFalse: [self assert: bytesToShift = 0]. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = newSpaceLimit. self assert: falseObj = (self objectAfter: nilObj). self assert: trueObj = (self objectAfter: falseObj). freeListObj := self objectAfter: trueObj. + self reInitializeClassTablePostLoad: (self objectAfter: freeListObj). - self classTableRootObj: (self objectAfter: freeListObj). self initializeFreeSpacePostLoad: freeListObj. segmentManager collapseSegmentsPostSwizzle. self initializeNewSpaceVariables. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart" "lowSpaceThreshold := 0. signalLowSpace := false. remapBufferCount := 0. tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold"" growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing"" shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking"" ""garbage collection statistics"" statFullGCs := 0. statFullGCUsecs := 0. statIncrGCs := 0. statIncrGCUsecs := 0. statTenures := 0. statRootTableOverflows := 0. statGrowMemory := 0. statShrinkMemory := 0. forceTenureFlag := 0. gcBiasToGrow := 0. gcBiasToGrowGCLimit := 0. extraRootCount := 0."! Item was removed: - ----- Method: SpurMemoryManager>>isClassInClassTable: (in category 'become implementation') ----- - isClassInClassTable: objOop - | hash | - hash := self rawHashBitsOf: objOop. - hash = 0 ifTrue: - [false]. - ^(self classAtIndex: hash) = objOop! Item was added: + ----- Method: SpurMemoryManager>>isInClassTable: (in category 'become implementation') ----- + isInClassTable: objOop + | hash | + hash := self rawHashBitsOf: objOop. + hash = 0 ifTrue: + [false]. + ^(self classAtIndex: hash) = objOop! Item was changed: ----- Method: SpurMemoryManager>>lastPointerOfWhileSwizzling: (in category 'snapshot') ----- lastPointerOfWhileSwizzling: objOop "Answer the byte offset of the last pointer field of the given object. Works with CompiledMethods, as well as ordinary objects. Does not examine the stack pointer of contexts to be sure to swizzle + the nils that fill contexts on snapshot. + It is invariant that on image load no object contains a forwarding pointer, + and the image contains no forwarders (see class comment)." - the nils that fill contexts on snapshot." <api> <inline: true> <asmLabel: false> | fmt numLiterals | fmt := self formatOf: objOop. self assert: fmt ~= self forwardedFormat. fmt <= self lastPointerFormat ifTrue: [^(self numSlotsOf: objOop) - 1 * BytesPerOop + self baseHeaderSize "all pointers"]. fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" "CompiledMethod: contains both pointers and bytes" numLiterals := coInterpreter literalCountOf: objOop. ^numLiterals + LiteralStart - 1 * BytesPerOop + self baseHeaderSize! Item was changed: ----- Method: SpurMemoryManager>>mapExtraRoots (in category 'garbage collection') ----- mapExtraRoots self assert: remapBufferCount = 0. 1 to: extraRootCount do: [:i | | oop | oop := (extraRoots at: i) at: 0. + ((self isImmediate: oop) or: [self isFreeObject: oop]) ifFalse: - ((self isImmediateObject: oop) or: [self isFreeObject: oop]) ifFalse: [(self shouldRemapObj: oop) ifTrue: [(extraRoots at: i) at: 0 put: (self remapObj: oop)]]]! Item was changed: ----- Method: SpurMemoryManager>>postBecomeScanClassTable (in category 'become implementation') ----- postBecomeScanClassTable + "Scan the class table post-become (iff a pointer object or compiled method was becommed). + Note that one-way become can cause duplications in the class table. + When can these be eliminated? We use the classtableBitmap to mark classTable entries + (not the classes themselves, since marking a class doesn't help in knowing if its index is used). + On image load, and during incrememtal scan-mark and full GC, classIndices are marked. + We can somehow avoid following classes from the classTable until after this mark phase." - "Scan the class table post-become (iff a pointer object or compiled method was becommed)" (becomeEffectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self]. 0 to: (self numSlotsOf: classTableRootObj) - 1 do: [:i| | page | page := self fetchPointer: i ofObject: classTableRootObj. 0 to: (self numSlotsOf: page) - 1 do: [:j| | classOrNil | classOrNil := self fetchPointer: j ofObject: page. classOrNil ~= nilObj ifTrue: [(self isForwarded: classOrNil) ifTrue: [classOrNil := self followForwarded: classOrNil. self storePointer: j ofObject: page withValue: classOrNil]. self scanClassPostBecome: classOrNil effects: becomeEffectsFlags]]]! Item was added: + ----- Method: SpurMemoryManager>>reInitializeClassTablePostLoad: (in category 'class table') ----- + reInitializeClassTablePostLoad: classTableRoot + self classTableRootObj: classTableRoot. + self expungeDuplicateClasses! Item was added: + ----- Method: SpurMemoryManager>>tenuringIncrementalGC (in category 'plugin support') ----- + tenuringIncrementalGC + "Do an incremental GC that tenures all surviving young objects to old space." + <api> + self flushNewSpace! Item was changed: ----- Method: SpurMemoryManager>>vmEndianness (in category 'memory access') ----- vmEndianness + <api> - <cmacro: '() VMBIGENDIAN'> "1 = big, 0 = little" + ^self cCode: [VMBIGENDIAN] inSmalltalk: [self subclassResponsibility]! - ^self subclassResponsibility!

1 0

[commit][2790] add ioExitWithErrorCode implementation to RISC OS; other platforms also need implementation
by commits＠squeakvm.org 15 Oct '13

15 Oct '13

Revision: 2790 Author: rowledge Date: 2013-10-15 10:55:16 -0700 (Tue, 15 Oct 2013) Log Message: ----------- add ioExitWithErrorCode implementation to RISC OS; other platforms also need implementation Modified Paths: -------------- trunk/platforms/RiscOS/vm/sqRPCMain.c Modified: trunk/platforms/RiscOS/vm/sqRPCMain.c =================================================================== --- trunk/platforms/RiscOS/vm/sqRPCMain.c 2013-10-15 17:54:41 UTC (rev 2789) +++ trunk/platforms/RiscOS/vm/sqRPCMain.c 2013-10-15 17:55:16 UTC (rev 2790) @@ -321,10 +321,14 @@ } sqInt ioExit(void) { - exit(1); - return 1; + ioExitWithErrorCode(1); } +sqInt ioExitWithErrorCode(int ec) { + exit(ec); + return ec; +} + int ioAssertion(void) { return 1; }

1 0

[commit][2789] add decl for ioExitWithErrorCode to Cross
by commits＠squeakvm.org 15 Oct '13

15 Oct '13

Revision: 2789 Author: rowledge Date: 2013-10-15 10:54:41 -0700 (Tue, 15 Oct 2013) Log Message: ----------- add decl for ioExitWithErrorCode to Cross Modified Paths: -------------- trunk/platforms/Cross/vm/sq.h Modified: trunk/platforms/Cross/vm/sq.h =================================================================== --- trunk/platforms/Cross/vm/sq.h 2013-10-08 01:37:43 UTC (rev 2788) +++ trunk/platforms/Cross/vm/sq.h 2013-10-15 17:54:41 UTC (rev 2789) @@ -167,6 +167,7 @@ sqInt ioBeep(void); sqInt ioExit(void); +sqInt ioExitWithErrorCode(int); sqInt ioForceDisplayUpdate(void); sqInt ioFormPrint(sqInt bitsAddr, sqInt width, sqInt height, sqInt depth, double hScale, double vScale, sqInt landscapeFlag);

1 0

VM Maker: VMMaker.oscog-eem.459.mcz
by commits＠source.squeak.org 15 Oct '13

15 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.459.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.459 Author: eem Time: 15 October 2013, 10:01:56.071 am UUID: d2ffc89b-e4ff-4404-902d-bc687cf089b6 Ancestors: VMMaker.oscog-eem.458 Add extraRoots and implement doBecome:to:copyHash:. =============== Diff against VMMaker.oscog-eem.458 =============== Item was changed: ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') ----- scavengeLoop "This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from the promoted. This loop continues until no more reachable objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as detecting closure. If this were not true, some pointers might get forwarded twice. An extension of the algorithm presented in David's original paper is to handle weak arrays and ephemerons. Weak arrays should not have their weak referents scavenged unless there are strong references to them. Ephemerons should fire if their key is not reachable other than from ephemerons and weak arrays. Handle this by maintaining a list for weak arrays and a list for ephemerons, which allow scavenging these objects once all other objects in new space have been scavenged, hence allowing the scavenger to detect which referents in new space of weak arrays are dead and of ephemeron keys are only live due to ephemerons. Read the class comment for a more in-depth description of the algorithm." | previousFutureSurvivorStart firstTime | self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start" weakList := ephemeronList := nil. numRememberedEphemerons := 0. firstTime := true. previousRememberedSetSize := 0. previousFutureSurvivorStart := futureSurvivorStart. [self scavengeRememberedSetStartingAt: previousRememberedSetSize. previousRememberedSetSize := rememberedSetSize. firstTime ifTrue: [coInterpreter mapInterpreterOops. + manager mapExtraRoots. firstTime := false]. "if nothing more copied and forwarded (or remembered by mapInterpreterOops) to scavenge, and no ephemerons to process, scavenge is done." (previousRememberedSetSize = rememberedSetSize and: [previousFutureSurvivorStart = futureSurvivorStart and: [numRememberedEphemerons = 0 and: [ephemeronList isNil]]]) ifTrue: [^self]. self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart. previousFutureSurvivorStart := futureSurvivorStart. "no more roots created to scavenge..." previousRememberedSetSize = rememberedSetSize ifTrue: [(numRememberedEphemerons = 0 and: [ephemeronList isNil]) ifTrue: [^self]. "no ephemerons to process, scavenge is done." "all reachable objects in this cycle have been promoted to futureSpace. ephemerons can now be processed." self processEphemerons]] repeat! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator self declareCAsOop: #(memory freeStart scavengeThreshold newSpaceLimit lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks) in: aCCodeGenerator. self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']) in: aCCodeGenerator. aCCodeGenerator var: #freeLists declareC: #'sqInt *freeLists'. aCCodeGenerator var: #remapBuffer + declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'. + aCCodeGenerator + var: #extraRoots + declareC: 'sqInt* extraRoots[ExtraRootSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.! - declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'! Item was changed: ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') ----- initialize "CogObjectMemory initialize" CheckObjectOverwrite := true. "The remap buffer support is for compatibility; Spur doesn't GC during allocation. Eventually this should die." + RemapBufferSize := 25. + + "Extra roots are for plugin support." + ExtraRootsSize := 2048 "max. # of external roots"! - RemapBufferSize := 25! Item was added: + ----- Method: SpurMemoryManager>>addGCRoot: (in category 'plugin support') ----- + addGCRoot: varLoc + "Add the given variable location to the extra roots table." + <api> + <var: #varLoc type: #'sqInt *'> + extraRootCount >= ExtraRootsSize ifTrue: [^false]. "out of space" + extraRoots at: (extraRootCount := extraRootCount + 1) put: varLoc. + ^true! Item was changed: ----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') ----- checkHeapIntegrity "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects has set a bit at each object's header. Scan all objects in the heap checking that every pointer points to a header. Scan the rootTable, remapBuffer and extraRootTable checking that every entry is a pointer to a header. Check that the number of roots is correct and that all rootTable entries have their rootBit set. Answer if all checks pass." | prevObj prevPrevObj ok numRememberedRootsInHeap | <inline: false> ok := true. numRememberedRootsInHeap := 0. self allHeapEntitiesDo: [:obj| | containsYoung fieldOop classIndex classOop | (self isFreeObject: obj) ifFalse: [containsYoung := false. (self isRemembered: obj) ifTrue: [numRememberedRootsInHeap := numRememberedRootsInHeap + 1. (scavenger isInRememberedSet: obj) ifFalse: [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr. self eek. ok := false]]. (self isForwarded: obj) ifTrue: [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. self eek. ok := false]. (self isYoung: fieldOop) ifTrue: [containsYoung := true]] ifFalse: [classOop := self classAtIndex: (classIndex := self classIndexOf: obj). ((classOop isNil or: [classOop = nilObj]) and: [obj ~= self freeListsObject]) ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr. self eek. ok := false]. self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do: [:ptr| fieldOop := self longAt: obj + ptr. (self isNonImmediate: fieldOop) ifTrue: [| fi | fi := ptr - self baseHeaderSize / self wordSize. (fieldOop bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false]. "don't be misled by CogMethods; they appear to be young, but they're not" ((self isYoung: fieldOop) and: [fieldOop >= startOfMemory]) ifTrue: [containsYoung := true]]]]]. (containsYoung and: [(self isYoung: obj) not]) ifTrue: [(self isRemembered: obj) ifFalse: [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr. self eek. ok := false]]]. prevPrevObj := prevObj. prevObj := obj]. numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue: [coInterpreter print: 'root count mismatch. #heap roots '; printNum: numRememberedRootsInHeap; print: '; #roots '; printNum: scavenger rememberedSetSize; cr. self eek. "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 remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. - [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 remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(self isYoung: obj) ifTrue: [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false]]]]. + 1 to: remapBufferCount do: + [:ri| | obj | - 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]]]. + 1 to: extraRootCount do: + [:ri| | obj | - [(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]]]. - [(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 added: + ----- Method: SpurMemoryManager>>doBecome:to:copyHash: (in category 'become implementation') ----- + doBecome: obj1 to: obj2 copyHash: copyHashFlag + | hashBits | + self forward: obj1 to: obj2. + copyHashFlag ifTrue: + [hashBits := self rawHashBitsOf: obj2. + "silently refuse to change the hash of classes; this shouldn't happen anyway." + (self classAtIndex: hashBits) ~= obj2 ifTrue: + [hashBits := self rawHashBitsOf: obj1. + self setHashBitsOf: obj2 to: hashBits]]! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. + remapBufferCount := extraRoots := 0. "see below" - remapBufferCount := 0. freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0. statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0. self flag: #temporary. shrinkThreshold := 16r10000000. "something huge for now" "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. "We can also initialize here anything that is only for simulation." + heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. + + "N.B. We *don't* initialize extraRoots because we don't simulate it."! - heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]! Item was added: + ----- Method: SpurMemoryManager>>mapExtraRoots (in category 'garbage collection') ----- + mapExtraRoots + self assert: remapBufferCount = 0. + 1 to: extraRootCount do: + [:i | | oop | + oop := (extraRoots at: i) at: 0. + ((self isImmediateObject: oop) or: [self isFreeObject: oop]) ifFalse: + [(self shouldRemapObj: oop) ifTrue: + [(extraRoots at: i) at: 0 put: (self remapObj: oop)]]]! Item was added: + ----- Method: SpurMemoryManager>>removeGCRoot: (in category 'plugin support') ----- + removeGCRoot: varLoc + "Remove the given variable location to the extra roots table." + <api> + <var: #varLoc type: #'sqInt *'> + 1 to: extraRootCount do: + [:i| + varLoc = (extraRoots at: i) ifTrue: "swap varLoc with last entry" + [extraRoots at: i put: (extraRoots at: extraRootCount). + extraRootCount := extraRootCount - 1. + ^true]]. + ^false "not found"!

1 0

VM Maker: VMMaker.oscog-eem.458.mcz
by commits＠source.squeak.org 15 Oct '13

15 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.458.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.458 Author: eem Time: 15 October 2013, 9:28:28.547 am UUID: fa66f078-056e-4da5-8926-9c2bf3f64282 Ancestors: VMMaker.oscog-eem.457 Define isGrey:,isImmutable:,isMarked: bits. Define newSpaceRefCountMask. Rename isInRememberedTable: to isInRememberedSet:. Implement [check]OkayOop: (with addressCouldBeObjWhileScavenging: for support). More missing protocol. =============== Diff against VMMaker.oscog-eem.457 =============== Item was added: + ----- Method: Spur32BitMemoryManager>>isMarked: (in category 'header access') ----- + isMarked: objOop + self flag: #endianness. + ^((self longAt: objOop + 4) >> self markedBitHalfShift bitAnd: 1) ~= 0! Item was changed: + ----- Method: Spur32BitMemoryManager>>isWordsNonImm: (in category 'object testing') ----- - ----- Method: Spur32BitMemoryManager>>isWordsNonImm: (in category 'header access') ----- isWordsNonImm: objOop "Answer if the argument contains only indexable words (no oops). See comment in formatOf:" ^(self formatOf: objOop) = self firstLongFormat! Item was added: + ----- Method: Spur32BitMemoryManager>>setIsGreyOf:to: (in category 'header access') ----- + setIsGreyOf: objOop to: aBoolean + self flag: #endianness. + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self greyBitShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self greyBitShift) bitInvert32])! Item was added: + ----- Method: Spur32BitMemoryManager>>setIsImmutableOf:to: (in category 'header access') ----- + setIsImmutableOf: objOop to: aBoolean + self flag: #endianness. + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self immutableBitShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self immutableBitShift) bitInvert32])! Item was added: + ----- Method: Spur32BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') ----- + setIsMarkedOf: objOop to: aBoolean + self flag: #endianness. + self longAt: objOop + 4 + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitHalfShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitHalfShift) bitInvert32])! Item was added: + ----- Method: Spur64BitMemoryManager>>isMarked: (in category 'header access') ----- + isMarked: objOop + ^((self longAt: objOop) >> self markedBitFullShift bitAnd: 1) ~= 0! Item was changed: + ----- Method: Spur64BitMemoryManager>>isWordsNonImm: (in category 'object testing') ----- - ----- Method: Spur64BitMemoryManager>>isWordsNonImm: (in category 'header access') ----- isWordsNonImm: objOop "Answer if the argument contains only indexable words (no oops). See comment in formatOf:" ^(self formatOf: objOop) between: self firstLongFormat and: self firstLongFormat + 1! Item was added: + ----- Method: Spur64BitMemoryManager>>setIsGreyOf:to: (in category 'header access') ----- + setIsGreyOf: objOop to: aBoolean + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self greyBitShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self greyBitShift) bitInvert64])! Item was added: + ----- Method: Spur64BitMemoryManager>>setIsImmutableOf:to: (in category 'header access') ----- + setIsImmutableOf: objOop to: aBoolean + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self immutableBitShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self immutableBitShift) bitInvert64])! Item was added: + ----- Method: Spur64BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') ----- + setIsMarkedOf: objOop to: aBoolean + self longAt: objOop + put: (aBoolean + ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitFullShift] + ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitFullShift) bitInvert64])! Item was added: + ----- Method: SpurGenerationScavenger>>isInRememberedSet: (in category 'store check') ----- + isInRememberedSet: objOop + 0 to: rememberedSetSize - 1 do: + [:i| + (rememberedSet at: i) = objOop ifTrue: + [^true]]. + ^false! Item was removed: - ----- Method: SpurGenerationScavenger>>isInRememberedTable: (in category 'store check') ----- - isInRememberedTable: objOop - 0 to: rememberedSetSize - 1 do: - [:i| - (rememberedSet at: i) = objOop ifTrue: - [^true]]. - ^false! Item was added: + ----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') ----- + addFreeSubTree: freeTree + "Add a freeChunk sub tree back into the large free chunk tree. + This is for allocateOldSpaceChunkOf[Exactly]Bytes:." + <returnTypeC: #void> + | slotsInArg treeNode slotsInNode subNode | + slotsInArg := self numSlotsOfAny: freeTree. + self assert: slotsInArg / (self allocationUnit / self wordSize) >= self numFreeLists. + treeNode := freeLists at: 0. + self assert: treeNode ~= 0. + [slotsInNode := self numSlotsOfAny: treeNode. + self assert: slotsInArg ~= slotsInNode. + slotsInNode > slotsInArg + ifTrue: + [subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode. + subNode = 0 ifTrue: + [self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree. + ^self]] + ifFalse: + [subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode. + subNode = 0 ifTrue: + [self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree. + ^self]]. + treeNode := subNode] repeat! Item was added: + ----- Method: SpurMemoryManager>>addressCouldBeObjWhileScavenging: (in category 'debug support') ----- + addressCouldBeObjWhileScavenging: address + ^(address bitAnd: self baseHeaderSize - 1) = 0 + and: [(self isInOldSpace: address) + or: [(self isInEden: address) + or: [(self isInSurvivorSpace: address) + or: [scavengeInProgress and: [self isInFutureSpace: address]]]]]! Item was added: + ----- Method: SpurMemoryManager>>become:with: (in category 'plugin support') ----- + become: array1 with: array2 + <api> + ^self become: array1 with: array2 twoWay: true copyHash: true! Item was changed: ----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') ----- checkHeapIntegrity "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects has set a bit at each object's header. Scan all objects in the heap checking that every pointer points to a header. Scan the rootTable, remapBuffer and extraRootTable checking that every entry is a pointer to a header. Check that the number of roots is correct and that all rootTable entries have their rootBit set. Answer if all checks pass." | prevObj prevPrevObj ok numRememberedRootsInHeap | <inline: false> ok := true. numRememberedRootsInHeap := 0. self allHeapEntitiesDo: [:obj| | containsYoung fieldOop classIndex classOop | (self isFreeObject: obj) ifFalse: [containsYoung := false. (self isRemembered: obj) ifTrue: [numRememberedRootsInHeap := numRememberedRootsInHeap + 1. + (scavenger isInRememberedSet: obj) ifFalse: - (scavenger isInRememberedTable: obj) ifFalse: [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr. self eek. ok := false]]. (self isForwarded: obj) ifTrue: [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj. (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr. self eek. ok := false]. (self isYoung: fieldOop) ifTrue: [containsYoung := true]] ifFalse: [classOop := self classAtIndex: (classIndex := self classIndexOf: obj). ((classOop isNil or: [classOop = nilObj]) and: [obj ~= self freeListsObject]) ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr. self eek. ok := false]. self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do: [:ptr| fieldOop := self longAt: obj + ptr. (self isNonImmediate: fieldOop) ifTrue: [| fi | fi := ptr - self baseHeaderSize / self wordSize. (fieldOop bitAnd: self wordSize - 1) ~= 0 ifTrue: [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false] ifFalse: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue: [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr. self eek. ok := false]. "don't be misled by CogMethods; they appear to be young, but they're not" ((self isYoung: fieldOop) and: [fieldOop >= startOfMemory]) ifTrue: [containsYoung := true]]]]]. (containsYoung and: [(self isYoung: obj) not]) ifTrue: [(self isRemembered: obj) ifFalse: [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr. self eek. ok := false]]]. prevPrevObj := prevObj. prevObj := obj]. numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue: [coInterpreter print: 'root count mismatch. #heap roots '; printNum: numRememberedRootsInHeap; print: '; #roots '; printNum: scavenger rememberedSetSize; cr. self eek. "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 remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr. self eek. ok := false] ifFalse: [(self isYoung: obj) ifTrue: [coInterpreter print: 'non-root in remembered set @ '; 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 added: + ----- Method: SpurMemoryManager>>checkOkayOop: (in category 'debug support') ----- + checkOkayOop: oop + "Verify that the given oop is legitimate. Check address, header, and size but not class. + Answer true if OK. Otherwise print reason and answer false." + <api> + <var: #oop type: #usqInt> + | classIndex fmt unusedBits unusedBitsInYoungObjects | + + "address and size checks" + (self isImmediate: oop) ifTrue: [^true]. + (self addressCouldBeObjWhileScavenging: oop) ifFalse: + [self print: 'oop '; printHex: oop; print: ' is not a valid address'. ^false]. + + (self addressAfter: oop) <= freeOldSpaceStart ifFalse: + [self print: 'oop '; printHex: oop; print: ' size would make it extend beyond the end of memory'. ^false]. + + "header type checks" + (classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse: + [self print: 'oop '; printHex: oop; print: ' is a free chunk, or bridge, not an object'. ^false]. + ((self rawNumSlotsOf: oop) = self numSlotsMask + and: [(self rawNumSlotsOf: oop) - self baseHeaderSize ~= self numSlotsMask]) ifTrue: + [self print: 'oop '; printHex: oop; print: ' header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false]. + + "format check" + fmt := self formatOf: oop. + (fmt = 6) | (fmt = 8) ifTrue: + [self print: 'oop '; printHex: oop; print: ' has an unknown format type'. ^false]. + (fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue: + [self print: 'oop '; printHex: oop; print: ' has mismached format/classIndex fields; only one of them is the isForwarded value'. ^false]. + + "specific header bit checks" + unusedBits := (1 << self classIndexFieldWidth) + | (1 << (self identityHashFieldWidth + 32)). + ((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue: + [self print: 'oop '; printHex: oop; print: ' has some unused header bits set; should be zero'. ^false]. + + unusedBitsInYoungObjects := self newSpaceRefCountMask. + ((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue: + [self print: 'oop '; printHex: oop; print: ' has some header bits unused in young objects set; should be zero'. ^false]. + ^true! Item was added: + ----- Method: SpurMemoryManager>>checkOkayYoungReferrer: (in category 'debug support') ----- + checkOkayYoungReferrer: obj + "Verify that the given obj is a valid youngReferrer. Check remembered is set and + is in remembered set. Answer true if OK. Otherwise print reason and answer false. + Assumes the object contains young references." + + (self oop: obj isLessThan: newSpaceLimit) ifTrue: + [^true]. + + (self isRemembered: obj) ifFalse: + [ self print: 'remembered bit is not set in '; printHex: obj; cr. ^false ]. + + (scavenger isInRememberedSet: obj) ifTrue: [^true]. + + self printHex: obj; print: ' has remembered bit set but is not in remembered set'; cr. + + ^false + ! Item was added: + ----- Method: SpurMemoryManager>>checkedLongAt: (in category 'memory access') ----- + checkedLongAt: byteAddress + "Assumes zero-based array indexing." + <api> + (self addressCouldBeObj: byteAddress) ifFalse: + [self warning: 'checkedLongAt bad address'. + coInterpreter primitiveFail]. + ^self longAt: byteAddress! Item was added: + ----- Method: SpurMemoryManager>>firstClassIndexPun (in category 'class table puns') ----- + firstClassIndexPun + "Class puns are class indices not used by any class. There is an entry + for the pun that refers to the notional class of objects with this class + index. But because the index doesn't match the class it won't show up + in allInstances, hence hiding the object with a pun as its class index. + The puns occupy indices 16 through 31." + ^16! Item was changed: ----- Method: SpurMemoryManager>>formatOfHeader: (in category 'object access') ----- formatOfHeader: header - <var: 'header' type: #usqLong> "0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 unused, reserved for exotic pointer objects? + 7 Forwarded Object, 1st field is pointer, rest of fields are ignored + 8 unused, reserved for exotic non-pointer objects? - 6,7,8 unused 9 (?) 64-bit indexable 10 - 11 32-bit indexable 12 - 15 16-bit indexable 16 - 23 byte indexable 24 - 31 compiled method" + <var: 'header' type: #usqLong> ^header >> self formatShift bitAnd: self formatMask! Item was added: + ----- Method: SpurMemoryManager>>gcStartUsecs (in category 'accessing') ----- + gcStartUsecs + ^gcStartUsecs! Item was added: + ----- Method: SpurMemoryManager>>greyBitShift (in category 'header format') ----- + greyBitShift + "bit 2 of 3-bit field above format (little endian)" + ^31! Item was changed: ----- Method: SpurMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') ----- headerForSlots: numSlots format: formatField classIndex: classIndex "The header format in LSB is MSB: | 8: numSlots | (on a byte boundary) + | 2 bits | (msb,lsb = {isMarked,?}) - | 2 bits | | 22: identityHash | (on a word boundary) + | 3 bits | (msb <-> lsb = {isGrey,isPinned,isRemembered} - | 3 bits | (msb <-> lsb = ?,isPinned,isRemembered | 5: format | (on a byte boundary) + | 2 bits | (msb,lsb = {isImmutable,?}) - | 2 bits | | 22: classIndex | (on a word boundary) : LSB + The remaining bits (7) are used for + isImmutable (bit 23) - The remaining bits (7) need to be used for - isGrey - isMarked isRemembered (bit 29) isPinned (bit 30) + isGrey (bit 31) + isMarked (bit 55) + leaving 2 unused bits, each next to a 22-bit field, allowing those fields to be + expanded to 23 bits.. The three bit field { isGrey, isPinned, isRemembered } - isImmutable - leaving 2 unused bits. The three bit field containing isPinned, isRemembered is for bits that are never set in young objects. This allows the remembered table to be pruned when full by using these bits as a reference count of newSpace objects from the remembered table. Objects with a high count should be tenured to prune the remembered table." <returnTypeC: #usqLong> ^ (numSlots << self numSlotsFullShift) + (formatField << self formatShift) + classIndex! Item was added: + ----- Method: SpurMemoryManager>>identityHashFieldWidth (in category 'header format') ----- + identityHashFieldWidth + ^22! Item was added: + ----- Method: SpurMemoryManager>>immutableBitShift (in category 'header format') ----- + immutableBitShift + "bit 1 of 2-bit field above classIndex (little endian)" + ^23! Item was added: + ----- Method: SpurMemoryManager>>isGrey: (in category 'header access') ----- + isGrey: objOop + ^((self longAt: objOop) >> self greyBitShift bitAnd: 1) ~= 0! Item was added: + ----- Method: SpurMemoryManager>>isImmutable: (in category 'header access') ----- + isImmutable: objOop + ^((self longAt: objOop) >> self immutableBitShift bitAnd: 1) ~= 0! Item was added: + ----- Method: SpurMemoryManager>>isMarked: (in category 'header access') ----- + isMarked: objOop + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>isOopImmutable: (in category 'object testing') ----- + isOopImmutable: oop + <api> + ^(self isImmediate: oop) + or: [self isImmutable: oop]! Item was added: + ----- Method: SpurMemoryManager>>isOopMutable: (in category 'object testing') ----- + isOopMutable: oop + <api> + ^(self isNonImmediate: oop) + and: [(self isImmutable: oop) not]! Item was changed: + ----- Method: SpurMemoryManager>>isWordsNonImm: (in category 'object testing') ----- - ----- Method: SpurMemoryManager>>isWordsNonImm: (in category 'header access') ----- isWordsNonImm: objOop "Answer if the argument contains only indexable words (no oops). See comment in formatOf:" ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>markedBitFullShift (in category 'header format') ----- + markedBitFullShift + "bit 1 of 2-bit field above identityHash (little endian)" + ^55! Item was added: + ----- Method: SpurMemoryManager>>markedBitHalfShift (in category 'header format') ----- + markedBitHalfShift + "bit 1 of 2-bit field above identityHash (little endian)" + ^23! Item was added: + ----- Method: SpurMemoryManager>>newSpaceRefCountMask (in category 'generation scavenging') ----- + newSpaceRefCountMask + "The three bit field { isGrey, isPinned, isRemembered } is for bits + that are never set in young objects. This allows the remembered + table to be pruned when full by using these bits as a reference + count of newSpace objects from the remembered table. Objects + with a high count should be tenured to prune the remembered table." + ^ (1 << self greyBitShift) + | (1 << self pinnedBitShift) + | (1 << self rememberedBitShift)! Item was added: + ----- Method: SpurMemoryManager>>okayOop: (in category 'debug support') ----- + okayOop: signedOop + "Verify that the given oop is legitimate. Check address, header, and size but not class." + + | oop classIndex fmt unusedBits unusedBitsInYoungObjects | + <var: #oop type: #usqInt> + oop := self cCoerce: signedOop to: #usqInt. + + "address and size checks" + (self isImmediate: oop) ifTrue: [^true]. + (self addressCouldBeObjWhileScavenging: oop) ifFalse: + [self error: 'oop is not a valid address'. ^false]. + + (self addressAfter: oop) <= freeOldSpaceStart ifFalse: + [self error: 'oop size would make it extend beyond the end of memory'. ^false]. + + "header type checks" + (classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse: + [self error: 'oop is a free chunk, or bridge, not an object'. ^false]. + ((self rawNumSlotsOf: oop) = self numSlotsMask + and: [(self rawNumSlotsOf: oop) - self baseHeaderSize ~= self numSlotsMask]) ifTrue: + [self error: 'oop header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false]. + + "format check" + fmt := self formatOf: oop. + (fmt = 6) | (fmt = 8) ifTrue: + [self error: 'oop has an unknown format type'. ^false]. + (fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue: + [self error: 'oop has mismached format/classIndex fields; only one of them is the isForwarded value'. ^false]. + + "specific header bit checks" + unusedBits := (1 << self classIndexFieldWidth) + | (1 << (self identityHashFieldWidth + 32)). + ((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue: + [self error: 'some unused header bits are set; should be zero'. ^false]. + + unusedBitsInYoungObjects := (1 << self greyBitShift) + | (1 << self pinnedBitShift) + | (1 << self rememberedBitShift). + ((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue: + [self error: 'some header bits unused in young objects are set; should be zero'. ^false]. + ^true + ! Item was added: + ----- Method: SpurMemoryManager>>setIsGreyOf:to: (in category 'header access') ----- + setIsGreyOf: objOop to: aBoolean + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>setIsImmutableOf:to: (in category 'header access') ----- + setIsImmutableOf: objOop to: aBoolean + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>setIsMarkedOf:to: (in category 'header access') ----- + setIsMarkedOf: objOop to: aBoolean + self subclassResponsibility!

1 0

Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.453.mcz
by Clément Bera 15 Oct '13

15 Oct '13

Hello, If I understand correctly now you have a working StackInterpreter with a Spur image. I wonder, as Spur is both compatible for 32 and 64 bits, how far are we from a Stack VM with a 64 bits image ? It shouldn't be so much work. I'm not talking about the JIT of course. Another question in the same direction, I saw on the Bochs website that their simulator now also supports 64 bits. Do you think if someone try to port Cog on 64bits he should try to use Bochs in 64 bits mode with the same plugin as we have, or he should do another plugin for another simulator ? Anyway I'm amazed by the speed at which you implement Spur :). 2013/10/12 <commits(a)source.squeak.org> > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-eem.453.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.453 > Author: eem > Time: 11 October 2013, 5:19:39.495 pm > UUID: 1510990d-a971-41cc-8a66-bc65a160454a > Ancestors: VMMaker.oscog-eem.452 > > Oops. Some stragglers. Now gcc3x-interp.c is generated for > StackInterpreter + Spur. > > =============== Diff against VMMaker.oscog-eem.452 =============== > > Item was added: > + ----- Method: Spur32BitMMLESimulator>>isNonIntegerObject: (in category > 'object testing') ----- > + isNonIntegerObject: oop > + "This list records the valid senders of isNonIntegerObject: as we > replace uses of > + isNonIntegerObject: by isNonImmediate: where appropriate." > + (#( on:do: "from the dbeugger" > + reverseDisplayFrom:to: > + primitiveObjectAtPut > + isCogMethodReference:) includes: thisContext sender method > selector) ifFalse: > + [self halt]. > + ^super isNonIntegerObject: oop! > > Item was added: > + ----- Method: SpurMemoryManager class>>additionalHeadersDo: (in category > 'translation') ----- > + additionalHeadersDo: aBinaryBlock > + "Evaluate aBinaryBlock with the names and contents of > + any additional header files that need to be generated."! > > Item was changed: > ----- Method: SpurMemoryManager>>isNonIntegerObject: (in category > 'object testing') ----- > isNonIntegerObject: oop > - "This list records the valid senders of isNonIntegerObject: as we > replace uses of > - isNonIntegerObject: by isNonImmediate: where appropriate." > - (#( on:do: "from the dbeugger" > - reverseDisplayFrom:to: > - primitiveObjectAtPut > - isCogMethodReference:) includes: thisContext sender method > selector) ifFalse: > - [self halt]. > ^(oop bitAnd: 1) = 0! > >

2 1

VM Maker: VMMaker.oscog-eem.457.mcz
by commits＠source.squeak.org 15 Oct '13

15 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.457.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.457 Author: eem Time: 14 October 2013, 8:22:22.312 pm UUID: c4aa88bc-7af4-4cfe-94e4-c79f485a488d Ancestors: VMMaker.oscog-eem.456 More protocol added to SpurMemoryManager. More primitives marked with <option: #SqueakV3ObjectMemory>. Time to desist... =============== Diff against VMMaker.oscog-eem.456 =============== Item was added: + ----- Method: CCodeGenerator>>generateNoMask:on:indent: (in category 'C translation') ----- + generateNoMask: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + aStream nextPut: $(. + self generateBitAnd: msgNode on: aStream indent: level. + aStream nextPutAll: ') == 0'! Item was added: + ----- Method: CCodeGenerator>>generateRounded:on:indent: (in category 'C translation') ----- + generateRounded: msgNode on: aStream indent: level + "Generate the C code for rounded onto the given stream." + + aStream nextPutAll: 'round('. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPut: $)! Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation." | pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent: #+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent: #bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert32 #generateBitInvert32:on:indent: #bitClear: #generateBitClear:on:indent: #truncateTo: #generateTruncateTo:on:indent: + #rounded #generateRounded:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent: #whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent: #ifNotNil: #generateIfNotNil:on:indent: #ifNil: #generateIfNil:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent: #at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent: #integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: #asLong #generateAsLong:on:indent: #asUnsignedLong #generateAsUnsignedLong:on:indent: #asSymbol #generateAsSymbol:on:indent: #flag: #generateFlag:on:indent: #anyMask: #generateBitAnd:on:indent: + #noMask: #generateNoMask:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #wordSize #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent: #value #generateValue:on:indent: #value: #generateValue:on:indent: #value:value: #generateValue:on:indent: #shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: #subclassResponsibility #generateSmalltalkMetaError:on:indent: ). 1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)]. pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #ifNotNil: #generateIfNotNilAsArgument:on:indent: #ifNil: #generateIfNilAsArgument:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent: #cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent: ). asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveIsYoung (in category 'memory space primitives') ----- primitiveIsYoung "Primitive. Answer whether the argument to the primitive resides in young space." | oop | <export: true> + <option: #SqueakV3ObjectMemory> "for now..." oop := self stackObjectValue: 0. self successful ifTrue: [self pop: argumentCount + 1 thenPushBool: (self oop: oop isGreaterThanOrEqualTo: objectMemory youngStart)]! Item was changed: ----- Method: InterpreterPrimitives>>primitivePathToUsing (in category 'other primitives') ----- primitivePathToUsing "primitivePathTo: anObject using: stack <Array> followWeak: boolean Answer a path to anObject from the root that does not pass through the current context" | err path | <export: true> + <option: #SqueakV3ObjectMemory> "for now..." self externalWriteBackHeadFramePointers. err := self pathTo: (self stackValue: 2) using: (self stackValue: 1) followWeak: self stackTop = objectMemory trueObject. err ~= 0 ifTrue: [^self primitiveFailFor: err]. path := self self stackValue: 1. self pop: argumentCount + 1 thenPush: path! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSetGCBiasToGrow (in category 'memory space primitives') ----- primitiveSetGCBiasToGrow "Primitive. Indicate if the GC logic should have bias to grow" | flag | <export: true> + <option: #SqueakV3ObjectMemory> "for now..." flag := self stackIntegerValue: 0. self successful ifTrue:[ objectMemory gcBiasToGrow: flag. self pop: argumentCount. ]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSetGCBiasToGrowGCLimit (in category 'memory space primitives') ----- primitiveSetGCBiasToGrowGCLimit "Primitive. If the GC logic has bias to grow, set growth limit" | value | <export: true> + <option: #SqueakV3ObjectMemory> "for now..." value := self stackIntegerValue: 0. self successful ifTrue: [objectMemory gcBiasToGrowGCLimit: value. objectMemory gcBiasToGrowThreshold: objectMemory youngStart - objectMemory startOfMemory asInteger. self pop: argumentCount]! Item was added: + ----- Method: Spur32BitMemoryManager>>byteSwapped: (in category 'snapshot') ----- + byteSwapped: w + "Answer the given integer with its bytes in the reverse order." + <api> + <returnTypeC: #sqInt> + ^ ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask) + + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask) + + ((w bitShift: Byte1Shift ) bitAnd: Byte2Mask) + + ((w bitShift: Byte3Shift ) bitAnd: Byte3Mask)! Item was added: + ----- Method: Spur64BitMemoryManager>>byteSwapped: (in category 'snapshot') ----- + byteSwapped: w + "Answer the given integer with its bytes in the reverse order." + <api> + <returnTypeC: #sqInt> + ^ ((w bitShift: Byte7ShiftNegated) bitAnd: Byte0Mask) + + ((w bitShift: Byte5ShiftNegated) bitAnd: Byte1Mask) + + ((w bitShift: Byte3ShiftNegated) bitAnd: Byte2Mask) + + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte3Mask) + + ((w bitShift: Byte1Shift ) bitAnd: Byte4Mask) + + ((w bitShift: Byte3Shift ) bitAnd: Byte5Mask) + + ((w bitShift: Byte5Shift ) bitAnd: Byte6Mask) + + ((w bitShift: Byte7Shift ) bitAnd: Byte7Mask)! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was added: + ----- Method: SpurMemoryManager>>accessibleObjectAfter: (in category 'object enumeration') ----- + accessibleObjectAfter: objOop + "Answer the accessible object following the given object or + free chunk in the heap. Return nil when heap is exhausted. + This is for primitiveNextObject subsequent to primtiiveSomeObject." + <inline: false> + | objAfter | + objAfter := objOop. + [objAfter := self objectAfter: objAfter limit: freeOldSpaceStart. + objAfter = freeOldSpaceStart ifTrue: + [^nil]. + (self isNormalObject: objAfter) ifTrue: + [^objAfter]] repeat! Item was added: + ----- Method: SpurMemoryManager>>byteSwapped: (in category 'snapshot') ----- + byteSwapped: w + self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>characterValueOf: (in category 'immediates') ----- characterValueOf: oop "Immediate characters are unsigned" + <api> ^oop asUnsignedInteger >> self numTagBits! Item was added: + ----- Method: SpurMemoryManager>>classCharacter (in category 'plugin support') ----- + classCharacter + ^self splObj: ClassCharacter! Item was added: + ----- Method: SpurMemoryManager>>classExternalStructure (in category 'accessing') ----- + classExternalStructure + ^self splObj: ClassExternalStructure! Item was added: + ----- Method: SpurMemoryManager>>classFloat (in category 'plugin support') ----- + classFloat + ^self splObj: ClassFloat! Item was added: + ----- Method: SpurMemoryManager>>classSmallInteger (in category 'accessing') ----- + classSmallInteger + ^self splObj: ClassInteger! Item was added: + ----- Method: SpurMemoryManager>>displayObject (in category 'accessing') ----- + displayObject + ^self splObj: TheDisplay! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize "We can put all initializations that set something to 0 or to false here. In C all global variables are initialized to 0, and 0 is false." remapBuffer := Array new: RemapBufferSize. remapBufferCount := 0. freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := false. becomeEffectsFlags := 0. statScavenges := statIncrGCs := statFullGCs := 0. + statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0. - statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0. + statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0. + statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0. self flag: #temporary. shrinkThreshold := 16r10000000. "something huge for now" "we can initialize things that are virtual in C." scavenger := SpurGenerationScavengerSimulator new manager: self; yourself. segmentManager := SpurSegmentManager new manager: self; yourself. "We can also initialize here anything that is only for simulation." heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]! Item was changed: + ----- Method: SpurMemoryManager>>isCharacterObject: (in category 'immediates') ----- - ----- Method: SpurMemoryManager>>isCharacterObject: (in category 'object testing') ----- isCharacterObject: oop + <api> + ^self isImmediateCharacter: oop! - ^(oop bitAnd: self tagMask) = self characterTag! Item was added: + ----- Method: SpurMemoryManager>>isCharacterValue: (in category 'immediates') ----- + isCharacterValue: anInteger + <api> + ^self isInRangeCharacterCode: anInteger! Item was changed: + ----- Method: SpurMemoryManager>>isForwardedObjectClassIndexPun (in category 'class table puns') ----- - ----- Method: SpurMemoryManager>>isForwardedObjectClassIndexPun (in category 'class table') ----- isForwardedObjectClassIndexPun ^8 "Not to be confused with that of any immediate class"! Item was added: + ----- Method: SpurMemoryManager>>isNormalObject: (in category 'object enumeration') ----- + isNormalObject: objOop + ^(self classIndexOf: objOop) > self lastClassIndexPun! Item was added: + ----- Method: SpurMemoryManager>>isWeak: (in category 'object testing') ----- + isWeak: oop + "Answer if the argument has only weak fields that can hold oops. See comment in formatOf:" + ^(self isNonImmediate: oop) and: [self isWeakNonImm: oop]! Item was added: + ----- Method: SpurMemoryManager>>lastClassIndexPun (in category 'class table puns') ----- + lastClassIndexPun + "Class puns are class indices not used by any class. There is an entry + for the pun that refers to the notional class of objects with this class + index. But because the index doesn't match the class it won't show up + in allInstances, hence hiding the object with a pun as its class index. + The puns occupy indices 16 through 31." + ^31! Item was added: + ----- Method: SpurMemoryManager>>obsoleteDontUseThisFetchWord:ofObject: (in category 'plugin support') ----- + obsoleteDontUseThisFetchWord: fieldIndex ofObject: oop + "This message is deprecated but supported for a while via a tweak to sqVirtualMachine.[ch] Use fetchLong32, fetchLong64 or fetchPointer instead for new code" + <api> + ^self fetchLong32: fieldIndex ofObject: oop! Item was added: + ----- Method: SpurMemoryManager>>reverseBytesFrom:to: (in category 'snapshot') ----- + reverseBytesFrom: startAddr to: stopAddr + "Byte-swap the given range of memory (not inclusive of stopAddr!!)." + | addr | + addr := startAddr. + [self oop: addr isLessThan: stopAddr] whileTrue: + [self longAt: addr put: (self byteSwapped: (self longAt: addr)). + addr := addr + BytesPerWord]! Item was added: + ----- Method: SpurMemoryManager>>reverseBytesInMemory (in category 'snapshot') ----- + reverseBytesInMemory + self reverseBytesFrom: newSpaceLimit to: freeOldSpaceStart! Item was added: + ----- Method: SpurMemoryManager>>rootTableCount (in category 'accessing') ----- + rootTableCount + ^scavenger rememberedSetSize! Item was changed: ----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'generation scavenging') ----- scavengingGCTenuringIf: tenuringCriterion "Run the scavenger." self assert: remapBufferCount = 0. self assert: (segmentManager numSegments = 0 "true in the spur image bootstrap" or: [scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes]). self checkFreeSpace. "coInterpreter printCallStackFP: coInterpreter framePointer" self runLeakCheckerForFullGC: false. coInterpreter preGCAction: GCModeIncr; "would prefer this to be in mapInterpreterOops, but compatibility with ObjectMemory dictates it goes here." flushMethodCacheFrom: startOfMemory to: newSpaceLimit. needGCFlag := false. gcStartUsecs := coInterpreter ioUTCMicrosecondsNow. scavengeInProgress := true. pastSpaceStart := scavenger scavenge: tenuringCriterion. self assert: (self oop: pastSpaceStart isGreaterThanOrEqualTo: scavenger pastSpace start andLessThanOrEqualTo: scavenger pastSpace limit). freeStart := scavenger eden start. self initSpaceForAllocationCheck: (self addressOf: scavenger eden). scavengeInProgress := false. statScavenges := statScavenges + 1. statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow. statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs. statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs. + statRootTableCount := scavenger rememberedSetSize. coInterpreter postGCAction. self runLeakCheckerForFullGC: false. self checkFreeSpace! Item was added: + ----- Method: SpurMemoryManager>>statFGCDeltaUsecs (in category 'accessing') ----- + statFGCDeltaUsecs + ^statFGCDeltaUsecs! Item was added: + ----- Method: SpurMemoryManager>>statGCEndUsecs (in category 'accessing') ----- + statGCEndUsecs + ^statGCEndUsecs! Item was added: + ----- Method: SpurMemoryManager>>statGrowMemory (in category 'accessing') ----- + statGrowMemory + ^statGrowMemory! Item was added: + ----- Method: SpurMemoryManager>>statMarkCount (in category 'accessing') ----- + statMarkCount + ^statMarkCount! Item was added: + ----- Method: SpurMemoryManager>>statMkFwdCount (in category 'accessing') ----- + statMkFwdCount + ^statMkFwdCount! Item was changed: ----- Method: SpurMemoryManager>>statRootTableCount (in category 'accessing') ----- statRootTableCount + ^statRootTableCount! - ^scavenger rememberedSetSize! Item was added: + ----- Method: SpurMemoryManager>>statRootTableOverflows (in category 'accessing') ----- + statRootTableOverflows + ^statRootTableOverflows! Item was added: + ----- Method: SpurMemoryManager>>statSGCDeltaUsecs (in category 'accessing') ----- + statSGCDeltaUsecs + ^statSGCDeltaUsecs! Item was added: + ----- Method: SpurMemoryManager>>statScavengeGCUsecs (in category 'accessing') ----- + statScavengeGCUsecs + ^statScavengeGCUsecs! Item was added: + ----- Method: SpurMemoryManager>>statShrinkMemory (in category 'accessing') ----- + statShrinkMemory + ^statShrinkMemory! Item was added: + ----- Method: SpurMemoryManager>>statSpecialMarkCount (in category 'accessing') ----- + statSpecialMarkCount + ^statSpecialMarkCount! Item was added: + ----- Method: SpurMemoryManager>>statSurvivorCount (in category 'accessing') ----- + statSurvivorCount + ^statSurvivorCount! Item was added: + ----- Method: SpurMemoryManager>>statSweepCount (in category 'accessing') ----- + statSweepCount + ^statSweepCount! Item was added: + ----- Method: SpurMemoryManager>>statTenures (in category 'accessing') ----- + statTenures + ^statTenures! Item was changed: ----- Method: SpurMemoryManager>>totalMemorySize (in category 'accessing') ----- totalMemorySize + ^scavenger newSpaceCapacity + segmentManager totalBytesInSegments! - ^scavenger newSpaceCapacity + segmentManager totalSegmentSize! Item was changed: ----- Method: SpurSegmentManager>>totalBytesInSegments (in category 'snapshot') ----- totalBytesInSegments | total | total := 0. 0 to: numSegments - 1 do: [:i| + total := total + (segments at: i) segSize - manager bridgeSize]. - total := total + (segments at: i) segSize]. ^total! Item was changed: ----- Method: TMethod>>newCascadeTempFor: (in category 'initialization') ----- newCascadeTempFor: aTParseNode | varNode | varNode := TVariableNode new setName: (self extraVariableName: 'cascade'). aTParseNode isLeaf ifFalse: [declarations at: varNode name + put: [:tm :cg| tm determineTypeFor: aTParseNode in: cg]]. - put: [:tm :cg| tm halt; determineTypeFor: aTParseNode in: cg]]. ^varNode!

1 0

VM Maker: VMMaker.oscog-eem.456.mcz
by commits＠source.squeak.org 15 Oct '13

15 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.456.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.456 Author: eem Time: 14 October 2013, 6:31:58.393 pm UUID: ac6bc9a3-b3f4-4576-9164-4d60eebd8544 Ancestors: VMMaker.oscog-eem.455 Fix bad bug with generation. Make sure vm classes are initialized *before* adding pools in VMMaker>>buildCodeGeneratorForInterpreter:. If not, BaseHeaderSize can have the wrong definition from a previous generation, e.g. 8 from a Spur generation. Also move initializeObjectHeaderConstants earlier in ObjectMemory/SpurMemoryManager>>initializeWithOptions:, and add some asserts to initializeObjectMemory: to try and catch the mis-translation if it reoccurs (I know, horse has already bolted...). Eliminate a couple of bogus nextLongFrom:swap:'s from readImageFromFile:HeapSize:StartingAt:. Make primitiveClipboardText, primitiveInvokeObjectAsMethod & signed32BitIntegerFor: use Spur instantiation when available. Make primitiveFullGC do an incrementalGC only in classic ObjectMemory. Implement Spur[NBit]MemoryManager>>changeClassOf:to: Add more missing protocol to SpurMemoryManager. Add support for truncateTo: if arg is an integer power-of-two. Add struct type support for addressOf:. Make addMethodFor:selector: cope with a missing VMMaker (for experimenting with TMethods). Merge with VMMaker-tpr.326. More isPointersNonInt: => isPointersNonImm:. Slang: Do a nicer job with empty ifTrue:ifFalse:'s in MessageNode>> asTranslatorNodeIn:. Now prepareMethodIn: uses nodesWithParentsDo: can do a neater job transforming caseOf:'s & dispatchOn:'s into switch statements. i.e. nuke replacements dict and dead transformSwitchExpression: call. =============== Diff against VMMaker.oscog-eem.455 =============== Item was changed: ----- Method: BitBltSimulation>>copyBits:Fallback: (in category 'setup') ----- copyBits: op Fallback: flags "Recover from the fast path specialised code saying Help-I-cant-cope" |done | <static: false> <returnTypeC: 'void'> <inline: false> <var: #op type: 'operation_t *'> <var: #flags type:'unsigned int'> self cppIf: #'ENABLE_FAST_BLT' ifTrue:[ "recover values from the operation struct used by the fast ARM code" self cCode:' combinationRule = op->combinationRule; noSource = op->noSource; sourceBits = (sqInt) op->src.bits; sourcePitch = op->src.pitch; sourceDepth = op->src.depth; sourceMSB = op->src.msb; sx = op->src.x; sy = op->src.y; destBits = (sqInt) op->dest.bits; destPitch = op->dest.pitch; destDepth = op->dest.depth; destMSB = op->dest.msb; dx = op->dest.x; dy = op->dest.y; bbW = op->width; bbH = op->height; cmFlags = op->cmFlags; cmShiftTable = (void *) op->cmShiftTable; cmMaskTable = (void *) op->cmMaskTable; cmMask = op->cmMask; cmLookupTable = (void *) op->cmLookupTable; noHalftone = op->noHalftone; halftoneHeight = op->halftoneHeight; halftoneBase = (sqInt) op->halftoneBase; if (combinationRule == 30 || combinationRule == 31) { sourceAlpha = op->opt.sourceAlpha; } if (combinationRule == 41) { componentAlphaModeColor = op->opt.componentAlpha.componentAlphaModeColor; componentAlphaModeAlpha = op->opt.componentAlpha.componentAlphaModeAlpha; gammaLookupTable = (void *) op->opt.componentAlpha.gammaLookupTable; ungammaLookupTable = (void *) op->opt.componentAlpha.ungammaLookupTable; }'. destPPW := 32 / destDepth. cmBitsPerColor := 0. cmMask = 16r1FF ifTrue: [cmBitsPerColor := 3]. cmMask = 16rFFF ifTrue: [cmBitsPerColor := 4]. + cmMask = 16r7FFF ifTrue: [cmBitsPerColor := 5]. - cmMask = 16r3FFF ifTrue: [cmBitsPerColor := 5]. "Try a shortcut for stuff that should be run as quickly as possible" done := self tryCopyingBitsQuickly. done ifTrue:[^nil]. bitCount := 0. "Choose and perform the actual copy loop." self performCopyLoop] ! Item was changed: ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') ----- addMethodFor: aClass selector: selector "Add the given method to the code base and answer its translation or nil if it shouldn't be translated." | method tmethod | selector == #initialize ifTrue: [^nil]. method := aClass compiledMethodAt: selector. (method pragmaAt: #doNotGenerate) ifNotNil: [^nil]. "process optional methods by interpreting the argument to the option: pragma as either a Cogit class name or a class variable name or a variable name in VMBasicConstants." (method pragmaAt: #option:) ifNotNil: + [:pragma| | key | - [:pragma| | key vmMaker | key := pragma argumentAt: 1. + VMClass getVMMaker ifNotNil: + [:vmMaker| + ((Cogit withAllSubclasses anySatisfy: [:c| c name = key]) + and: [vmMaker cogitClassName ~= key]) ifTrue: + [^nil]. + (vmMaker options at: key ifAbsent: []) ifNotNil: + [:option| option == false ifTrue: [^nil]]]. - vmMaker := VMClass getVMMaker. - ((Cogit withAllSubclasses anySatisfy: [:c| c name = key]) - and: [vmMaker cogitClassName ~= key]) ifTrue: - [^nil]. (aClass bindingOf: key) ifNotNil: [:binding| binding value == false ifTrue: [^nil]]. (VMBasicConstants bindingOf: key) ifNotNil: [:binding| + binding value == false ifTrue: [^nil]]]. - binding value == false ifTrue: [^nil]]. - (vmMaker options at: key ifAbsent: []) ifNotNil: - [:option| option == false ifTrue: [^nil]]]. tmethod := self addMethod: (self compileToTMethodSelector: selector in: aClass). "If the method has a macro then add the macro. But keep the method for analysis purposes (e.g. its variable accesses)." (method pragmaAt: #cmacro:) ifNotNil: [:pragma| self addMacro: (pragma argumentAt: 1) for: selector. tmethod inline: false]. (method propertyValueAt: #cmacro:) ifNotNil: [:macro| self addMacro: macro for: selector. tmethod inline: false]. ^tmethod! Item was added: + ----- Method: CCodeGenerator>>generateTruncateTo:on:indent: (in category 'C translation') ----- + generateTruncateTo: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + self assert: msgNode args first isConstant. + self assert: msgNode args first value isInteger. + self assert: msgNode args first value isPowerOfTwo. + aStream nextPut: $(. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' & ~'; print: msgNode args first value - 1; nextPut: $)! Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation." | pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent: #+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent: #bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert32 #generateBitInvert32:on:indent: #bitClear: #generateBitClear:on:indent: + #truncateTo: #generateTruncateTo:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent: #whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent: #ifNotNil: #generateIfNotNil:on:indent: #ifNil: #generateIfNil:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent: #at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent: #integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: #asLong #generateAsLong:on:indent: #asUnsignedLong #generateAsUnsignedLong:on:indent: #asSymbol #generateAsSymbol:on:indent: #flag: #generateFlag:on:indent: #anyMask: #generateBitAnd:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #wordSize #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent: #value #generateValue:on:indent: #value: #generateValue:on:indent: #value:value: #generateValue:on:indent: #shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: #subclassResponsibility #generateSmalltalkMetaError:on:indent: ). 1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)]. pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #ifNotNil: #generateIfNotNilAsArgument:on:indent: #ifNil: #generateIfNilAsArgument:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent: #cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent: ). asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. ! Item was added: + ----- Method: CCodeGenerator>>selectorReturnsStruct: (in category 'C code generator') ----- + selectorReturnsStruct: selector "<Symbol>" + | tMethod | + ^(tMethod := methods + at: selector + ifAbsent: + [apiMethods ifNotNil: + [apiMethods at: selector ifAbsent: []]]) notNil + and: [VMStructType isTypeStruct: tMethod returnType]! Item was changed: ----- Method: CoInterpreter>>checkOkayFields: (in category 'debug support') ----- checkOkayFields: oop "Check if the argument is an ok object. If this is a pointers object, check that its fields are all okay oops." | hasYoung i fieldOop | (oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013" (objectMemory isIntegerObject: oop) ifTrue: [ ^true ]. (objectMemory checkOkayOop: oop) ifFalse: [ ^false ]. (objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ]. + ((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ]. - ((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ]. hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonImm: oop). (objectMemory isCompiledMethod: oop) ifTrue: [i := (self literalCountOf: oop) + LiteralStart - 1] ifFalse: [(objectMemory isContext: oop) ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1] ifFalse: [i := (objectMemory lengthOf: oop) - 1]]. [i >= 0] whileTrue: [fieldOop := objectMemory fetchPointer: i ofObject: oop. (objectMemory isNonIntegerObject: fieldOop) ifTrue: [(i = 0 and: [objectMemory isCompiledMethod: oop]) ifTrue: [(cogMethodZone methodFor: (self pointerForOop: fieldOop)) = 0 ifTrue: [self print: 'method '; printHex: oop; print: ' has an invalid cog method reference'. ^false]] ifFalse: [hasYoung := hasYoung or: [objectMemory isYoung: fieldOop]. (objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ]. (self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]]]. i := i - 1]. hasYoung ifTrue: [^objectMemory checkOkayYoungReferrer: oop]. ^true! Item was changed: ----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory." "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command." "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!" | swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory heapSize bytesRead bytesToShift hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize firstSegSize | <var: #f type: 'sqImageFile '> <var: #memStart type: 'usqInt'> <var: #desiredHeapSize type: 'usqInt'> <var: #headerStart type: 'squeakFileOffsetType '> <var: #dataSize type: 'size_t '> <var: #imageOffset type: 'squeakFileOffsetType '> metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position" headerSize := self getLongFromFile: f swap: swapBytes. dataSize := self getLongFromFile: f swap: swapBytes. oldBaseAddr := self getLongFromFile: f swap: swapBytes. objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes). objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used." savedWindowSize := self getLongFromFile: f swap: swapBytes. headerFlags := self getLongFromFile: f swap: swapBytes. self setImageHeaderFlagsFrom: headerFlags. extraVMMemory := self getLongFromFile: f swap: swapBytes. "N.B. not used." hdrNumStackPages := self getShortFromFile: f swap: swapBytes. "4 stack pages is small. Should be able to run with as few as three. 4 should be comfortable but slow. 8 is a reasonable default. Can be changed via vmParameterAt: 43 put: n. Can be set as a preference (Info.plist, VM.ini, command line etc). If desiredNumStackPages is already non-zero then it has been set as a preference. Ignore (but preserve) the header's default." numStackPages := desiredNumStackPages ~= 0 ifTrue: [desiredNumStackPages] ifFalse: [hdrNumStackPages = 0 ifTrue: [self defaultNumStackPages] ifFalse: [hdrNumStackPages]]. desiredNumStackPages := hdrNumStackPages. "This slot holds the size of the native method zone in 1k units. (pad to word boundary)." hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024. cogCodeSize := desiredCogCodeSize ~= 0 ifTrue: [desiredCogCodeSize] ifFalse: [hdrCogCodeSize = 0 ifTrue: [self defaultCogCodeSize] ifFalse: [hdrCogCodeSize]]. hdrEdenBytes := self getLongFromFile: f swap: swapBytes. objectMemory edenBytes: (desiredEdenBytes ~= 0 ifTrue: [desiredEdenBytes] ifFalse: [hdrEdenBytes = 0 ifTrue: [objectMemory defaultEdenBytes] ifFalse: [hdrEdenBytes]]). desiredEdenBytes := hdrEdenBytes. hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes. hdrMaxExtSemTabSize ~= 0 ifTrue: [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. + firstSegSize := self getLongFromFile: f swap: swapBytes. - firstSegSize := self nextLongFrom: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "compare memory requirements with availability" minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed" + dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes. heapSize := cogCodeSize "no need to include the stackZone; this is alloca'ed" + desiredHeapSize "+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize" + self interpreterAllocationReserveBytes. heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]. "allocate a contiguous block of memory for the Squeak heap and ancilliary data structures" objectMemory memory: (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger. objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError]. heapBase := objectMemory memory + cogCodeSize. self assert: objectMemory startOfMemory = heapBase. objectMemory setHeapBase: heapBase memoryLimit: objectMemory memory + heapSize - 24 "decrease memoryLimit a tad for safety (?!!?!!? eem eem 10/9/2013 15:15)" endOfMemory: heapBase + dataSize. "position file after the header" self sqImageFile: f Seek: headerStart + headerSize. "read in the image in bulk, then swap the bytes if necessary" bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" self initializeCodeGenerator. ^dataSize! Item was changed: ----- Method: InterpreterPrimitives>>primitiveClipboardText (in category 'I/O primitives') ----- primitiveClipboardText "When called with a single string argument, post the string to the clipboard. When called with zero arguments, return a string containing the current clipboard contents." | s sz | argumentCount = 1 + ifTrue: + [s := self stackTop. + (objectMemory isBytes: s) ifFalse: [^ self primitiveFail]. + self successful ifTrue: + [sz := objectMemory byteLengthOf: s. + self clipboardWrite: sz From: s + objectMemory baseHeaderSize At: 0. + self pop: 1]] + ifFalse: + [sz := self clipboardSize. + objectMemory hasSpurMemoryManagerAPI + ifTrue: + [s := objectMemory allocateBytes: sz classIndex: ClassByteStringCompactIndex. + s ifNil: [^self primitiveFail]] + ifFalse: + [(objectMemory sufficientSpaceToAllocate: sz) ifFalse: [^self primitiveFail]. + s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz]. + self clipboardRead: sz Into: s + objectMemory baseHeaderSize At: 0. + self pop: 1 thenPush: s]! - ifTrue: [s := self stackTop. - (objectMemory isBytes: s) ifFalse: [^ self primitiveFail]. - self successful - ifTrue: [sz := self stSizeOf: s. - self clipboardWrite: sz From: s + BaseHeaderSize At: 0. - self pop: 1]] - ifFalse: [sz := self clipboardSize. - (objectMemory sufficientSpaceToAllocate: sz) ifFalse:[^self primitiveFail]. - s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz. - self clipboardRead: sz Into: s + BaseHeaderSize At: 0. - self pop: 1 thenPush: s]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') ----- primitiveFullGC "Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)." objectMemory fullGCLock > 0 ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. + objectMemory hasSpurMemoryManagerAPI ifFalse: + [objectMemory incrementalGC]. "maximimize space for forwarding table" - objectMemory incrementalGC. "maximimize space for forwarding table" objectMemory fullGC. self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).! Item was changed: ----- Method: InterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') ----- primitiveInvokeObjectAsMethod "Primitive. 'Invoke' an object like a function, sending the special message run: originalSelector with: arguments in: aReceiver. " <returnTypeC: #void> | runReceiver runArgs lookupClassTag | + runArgs := objectMemory hasSpurMemoryManagerAPI + ifTrue: [objectMemory + eeInstantiateClassIndex: ClassArrayCompactIndex + format: objectMemory arrayFormat + numSlots: argumentCount] + ifFalse: [objectMemory + eeInstantiateClass: (objectMemory splObj: ClassArray) + indexableSize: argumentCount]. - runArgs := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount. argumentCount - 1 to: 0 by: -1 do: [:i| objectMemory storePointerUnchecked: i ofObject: runArgs withValue: self popStack]. runReceiver := self popStack. "setup send of newMethod run: originalSelector with: runArgs in: runReceiver" self push: newMethod. "newReceiver" self push: messageSelector "original selector". self push: runArgs. self push: runReceiver. "stack is clean here" messageSelector := objectMemory splObj: SelectorRunWithIn. argumentCount := 3. lookupClassTag := objectMemory fetchClassTagOf: newMethod. self findNewMethodInClassTag: lookupClassTag. self executeNewMethod. "Recursive xeq affects successFlag" self initPrimCall! Item was changed: ----- Method: InterpreterPrimitives>>primitiveIsRoot (in category 'memory space primitives') ----- primitiveIsRoot "Primitive. Answer whether the argument to the primitive is a root for young space" | oop | <export: true> + <option: #SqueakV3ObjectMemory> oop := self stackObjectValue: 0. self successful ifTrue: [self pop: argumentCount + 1 thenPushBool: (objectMemory isYoungRoot: oop)]! Item was changed: ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used." | rcvrOrNil sel args | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. ((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." or: [sel = #cCode:]) and: [arguments first isBlockNode]) ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. args := (1 to: sel numArgs) collect: [:i | (arguments at: i) asTranslatorNodeIn: aTMethod]. (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: ["Restore limit expr that got moved by transformToDo:" args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. args second. args third. "add the limit var as a hidden extra argument; we may need it later" TVariableNode new setName: arguments first key}]. + (sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue: + [sel := #ifFalse:. args := {args last}]. + (sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue: + [sel := #ifTrue:. args := {args first}]. + (sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue: + [sel := #ifTrue:. args := {args last}]. + (sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue: + [sel := #ifTrue:. args := {args first}]. ((sel = #ifFalse: or: [sel = #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was changed: ----- Method: ObjectMemory class>>initializeWithOptions: (in category 'initialization') ----- initializeWithOptions: optionsDictionary "ObjectMemory initializeWithOptions: Dictionary new" self initBytesPerWord: (optionsDictionary at: #BytesPerWord ifAbsent: [4]). BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord]. "Translation flags (booleans that control code generation via conditional translation):" "generate assertion checks" DoAssertionChecks := optionsDictionary at: #DoAssertionChecks ifAbsent: [false]. DoExpensiveAssertionChecks := optionsDictionary at: #DoExpensiveAssertionChecks ifAbsent: [false]. + self initializeObjectHeaderConstants. "Initializes BaseHeaderSize so do early" self initializeImmediates. self initializeSpecialObjectIndices. self initializeCompactClassIndices. self initializePrimitiveErrorCodes. - self initializeObjectHeaderConstants. NilContext := 1. "the oop for the integer 0; used to mark the end of context lists" RemapBufferSize := 25. RootTableSize := 2500. "number of root table entries (4 bytes/entry)" RootTableRedZone := RootTableSize - 100. "red zone of root table - when reached we force IGC" WeakRootTableSize := RootTableSize + RemapBufferSize + 100. "tracer actions" StartField := 1. StartObj := 2. Upward := 3. Done := 4. ExtraRootSize := 2048. "max. # of external roots"! Item was changed: ----- Method: ObjectMemory>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory endOfMemory memoryLimit specialObjectsOop lastHash " "di 11/18/2000 fix slow full GC" <inline: false> + "Catch mis-initializations leading to bad translations to C" + self assert: BaseHeaderSize = BytesPerWord. "set the start of the young object space" youngStart := endOfMemory. "image may be at a different address; adjust oops for new location" totalObjectCount := self adjustAllOopsBy: bytesToShift. self initializeMemoryFirstFree: endOfMemory. "initializes endOfMemory, freeBlock" specialObjectsOop := specialObjectsOop + bytesToShift. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. rootTableCount := 0. rootTableOverflowed := false. freeContexts := NilContext. freeLargeContexts := NilContext. allocationCount := 0. lowSpaceThreshold := 0. signalLowSpace := false. compStart := 0. compEnd := 0. fwdTableNext := 0. fwdTableLast := 0. remapBufferCount := 0. allocationsBetweenGCs := 4000. "do incremental GC after this many allocations" tenuringThreshold := 2000. "tenure all suriving objects if count is over this threshold" growHeadroom := 4*1024*1024. "four megabyte of headroom when growing" shrinkThreshold := 8*1024*1024. "eight megabyte of free space before shrinking" "garbage collection statistics" statFullGCs := 0. statFullGCUsecs := 0. statIncrGCs := 0. statIncrGCUsecs := 0. statTenures := 0. statRootTableOverflows := 0. statGrowMemory := 0. statShrinkMemory := 0. forceTenureFlag := 0. gcBiasToGrow := 0. gcBiasToGrowGCLimit := 0. extraRootCount := 0. gcStartUsecs := 0! Item was added: + ----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') ----- + changeClassOf: rcvr to: argClass + "Attempt to change the class of the receiver to the argument given that the + format of the receiver matches the format of the argument. If successful, + answer 0, otherwise answer an error code indicating the reason for failure. + Fail if the format of the receiver is incompatible with the format of the argument, + or if the argument is a fixed class and the receiver's size differs from the size + that an instance of the argument should have." + <inline: false> + | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex | + classFormat := self formatOfClass: argClass. + fixedFields := self fixedFieldsOfClassFormat: classFormat. + instFormat := self formatOf: rcvr. + normalizedInstFormat := self classFormatForInstanceFormat: instFormat. + + normalizedInstFormat = classFormat + ifTrue: [newFormat := instFormat] + ifFalse: + [normalizedInstFormat <= self lastPointerFormat + ifTrue: + [classFormat > self lastPointerFormat ifTrue: + [^PrimErrInappropriate]. + (self numSlotsOf: rcvr) < fixedFields ifTrue: + [^PrimErrBadReceiver]. + newFormat := classFormat] + ifFalse: + [| instBytes | + instBytes := self byteLengthOf: rcvr. + normalizedInstFormat caseOf: { + [self sixtyFourBitIndexableFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + newFormat := classFormat]. + [self firstLongFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue: + [^PrimErrBadReceiver]. + newFormat := classFormat]. + [self firstShortFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + classFormat caseOf: { + [self sixtyFourBitIndexableFormat] + -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat]. + [self firstLongFormat] + -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat]. + [self firstByteFormat] + -> [newFormat := classFormat + (4 - instBytes bitAnd: 3)] }]. + [self firstByteFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + classFormat caseOf: { + [self sixtyFourBitIndexableFormat] + -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]]. + [self firstLongFormat] + -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]]. + [self firstShortFormat] + -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]] }. + newFormat := classFormat]. + [self firstCompiledMethodFormat] -> + [classFormat ~= self firstCompiledMethodFormat ifTrue: + [^PrimErrInappropriate]. + newFormat := instFormat] }]]. + + (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue: + [^classIndex negated]. + + self setFormatOf: rcvr to: newFormat; + setClassIndexOf: rcvr to: classIndex. + "ok" + ^0! Item was added: + ----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') ----- + changeClassOf: rcvr to: argClass + "Attempt to change the class of the receiver to the argument given that the + format of the receiver matches the format of the argument. If successful, + answer 0, otherwise answer an error code indicating the reason for failure. + Fail if the format of the receiver is incompatible with the format of the argument, + or if the argument is a fixed class and the receiver's size differs from the size + that an instance of the argument should have." + <inline: false> + | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex | + classFormat := self formatOfClass: argClass. + fixedFields := self fixedFieldsOfClassFormat: classFormat. + instFormat := self formatOf: rcvr. + normalizedInstFormat := self classFormatForInstanceFormat: instFormat. + + normalizedInstFormat = classFormat + ifTrue: [newFormat := instFormat] + ifFalse: + [normalizedInstFormat <= self lastPointerFormat + ifTrue: + [classFormat > self lastPointerFormat ifTrue: + [^PrimErrInappropriate]. + (self numSlotsOf: rcvr) < fixedFields ifTrue: + [^PrimErrBadReceiver]. + newFormat := classFormat] + ifFalse: + [| instBytes | + instBytes := self byteLengthOf: rcvr. + normalizedInstFormat caseOf: { + [self sixtyFourBitIndexableFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + newFormat := classFormat]. + [self firstLongFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue: + [^PrimErrBadReceiver]. + newFormat := classFormat]. + [self firstShortFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + classFormat caseOf: { + [self sixtyFourBitIndexableFormat] + -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat]. + [self firstLongFormat] + -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat + (2 - instBytes bitAnd: 1)]. + [self firstByteFormat] + -> [newFormat := classFormat + (8 - instBytes bitAnd: 7)] }]. + [self firstByteFormat] -> + [(classFormat < self sixtyFourBitIndexableFormat + or: [classFormat >= self firstCompiledMethodFormat]) ifTrue: + [^PrimErrInappropriate]. + classFormat caseOf: { + [self sixtyFourBitIndexableFormat] + -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat]. + [self firstLongFormat] + -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat + (2 - instBytes bitAnd: 1)]. + [self firstShortFormat] + -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]. + newFormat := classFormat + (4 - instBytes bitAnd: 3)] }. + newFormat := classFormat]. + [self firstCompiledMethodFormat] -> + [classFormat ~= self firstCompiledMethodFormat ifTrue: + [^PrimErrInappropriate]. + newFormat := instFormat] }]]. + + (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue: + [^classIndex negated]. + + self setFormatOf: rcvr to: newFormat; + setClassIndexOf: rcvr to: classIndex. + "ok" + ^0! Item was changed: ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') ----- initializeWithOptions: optionsDictionary "SpurMemoryManager initializeWithOptions: Dictionary new" super initializeWithOptions: optionsDictionary. self initBytesPerWord: (self == SpurMemoryManager ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]] ifFalse: [self wordSize]). BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord]. + self initializeObjectHeaderConstants. "Initializes BaseHeaderSize so do early" self initializeSpurObjectRepresentationConstants. self initializeSpecialObjectIndices. self initializeCompactClassIndices. self initializePrimitiveErrorCodes. - self initializeObjectHeaderConstants. SpurGenerationScavenger initialize! Item was added: + ----- Method: SpurMemoryManager>>allocateBytes:classIndex: (in category 'allocation') ----- + allocateBytes: numBytes classIndex: classIndex + "Allocate an object of numBytes. Answer nil if no available memory. + classIndex must be that of a byte class (e.g. ByteString). + The object is *NOT FILLED*." + self assert: (coInterpreter addressCouldBeClassObj: (self classAtIndex: classIndex)). + self assert: (self instSpecOfClass: (self classAtIndex: classIndex)) = self firstByteFormat. + ^self + allocateSlots: (numBytes + self wordSize - 1 // self wordSize) + format: self firstByteFormat + (self wordSize - numBytes bitAnd: self wordSize - 1) + classIndex: classIndex! Item was added: + ----- Method: SpurMemoryManager>>changeClassOf:to: (in category 'interpreter access') ----- + changeClassOf: rcvr to: argClass + "Attempt to change the class of the receiver to the argument given that the + format of the receiver matches the format of the argument. If successful, + answer 0, otherwise answer an error code indicating the reason for failure. + Fail if the format of the receiver is incompatible with the format of the argument, + or if the argument is a fixed class and the receiver's size differs from the size + that an instance of the argument should have." + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>characterTable (in category 'accessing') ----- + characterTable + self shouldNotImplement! Item was added: + ----- Method: SpurMemoryManager>>checkOopHasOkayClass: (in category 'debug support') ----- + checkOopHasOkayClass: obj + "Attempt to verify that the given obj has a reasonable behavior. The class must be a + valid, non-integer oop and must not be nilObj. It must be a pointers object with three + or more fields. Finally, the instance specification field of the behavior must match that + of the instance. If OK answer true. If not, print reason and answer false." + + <api> + <var: #oop type: #usqInt> + | objClass objFormat | + <var: #oopClass type: #usqInt> + + (self checkOkayOop: obj) ifFalse: + [^false]. + objClass := self cCoerce: (self fetchClassOfNonImm: obj) to: #usqInt. + + (self isImmediate: objClass) ifTrue: + [self print: 'obj '; printHex: obj; print: ' an immediate is not a valid class or behavior'; cr. ^false]. + (self okayOop: objClass) ifFalse: + [self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false]. + ((self isPointersNonImm: objClass) and: [(self numSlotsOf: objClass) >= 3]) ifFalse: + [self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false]. + objFormat := (self isBytes: obj) + ifTrue: [(self formatOf: obj) bitClear: 7] "ignore extra bytes size bits" + ifFalse: [self formatOf: obj]. + + (self instSpecOfClass: objClass) ~= objFormat ifTrue: + [self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false]. + ^true! Item was added: + ----- Method: SpurMemoryManager>>classAlien (in category 'accessing') ----- + classAlien + ^self splObj: ClassAlien! Item was added: + ----- Method: SpurMemoryManager>>classExternalAddress (in category 'accessing') ----- + classExternalAddress + ^self splObj: ClassExternalAddress! Item was added: + ----- Method: SpurMemoryManager>>classExternalData (in category 'accessing') ----- + classExternalData + ^self splObj: ClassExternalData! Item was added: + ----- Method: SpurMemoryManager>>classExternalFunction (in category 'accessing') ----- + classExternalFunction + ^self splObj: ClassExternalFunction! Item was added: + ----- Method: SpurMemoryManager>>classExternalLibrary (in category 'accessing') ----- + classExternalLibrary + ^self splObj: ClassExternalLibrary! Item was added: + ----- Method: SpurMemoryManager>>classFormatForInstanceFormat: (in category 'header format') ----- + classFormatForInstanceFormat: aFormat + "Clear any odd bits from the format so that it matches its class's format" + aFormat < self firstLongFormat ifTrue: + [^aFormat]. + aFormat >= self firstByteFormat ifTrue: + [^aFormat bitAnd: -8]. + ^aFormat >= self firstShortFormat + ifTrue: [aFormat bitAnd: -4] + ifFalse: [aFormat bitAnd: -2]! Item was added: + ----- Method: SpurMemoryManager>>classString (in category 'accessing') ----- + classString + ^self splObj: ClassByteString! Item was added: + ----- Method: SpurMemoryManager>>classUnsafeAlien (in category 'accessing') ----- + classUnsafeAlien + ^self splObj: ClassUnsafeAlien! Item was added: + ----- Method: SpurMemoryManager>>fullGCLock (in category 'garbage collection') ----- + fullGCLock + "Spur never has a need to lock GC because it does not move pinned objects." + ^0! Item was added: + ----- Method: SpurMemoryManager>>incrementalGC (in category 'garbage collection') ----- + incrementalGC + self shouldNotImplement! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory memoryLimit specialObjectsOop lastHash " <inline: false> | freeListObj | + "Catch mis-initializations leading to bad translations to C" + self assert: BaseHeaderSize = self baseHeaderSize. + segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. segmentManager numSegments > 0 "false if Spur image bootstrap" ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop] ifFalse: [self assert: bytesToShift = 0]. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = newSpaceLimit. self assert: falseObj = (self objectAfter: nilObj). self assert: trueObj = (self objectAfter: falseObj). freeListObj := self objectAfter: trueObj. self classTableRootObj: (self objectAfter: freeListObj). self initializeFreeSpacePostLoad: freeListObj. segmentManager collapseSegmentsPostSwizzle. self initializeNewSpaceVariables. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart" "lowSpaceThreshold := 0. signalLowSpace := false. remapBufferCount := 0. tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold"" growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing"" shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking"" ""garbage collection statistics"" statFullGCs := 0. statFullGCUsecs := 0. statIncrGCs := 0. statIncrGCUsecs := 0. statTenures := 0. statRootTableOverflows := 0. statGrowMemory := 0. statShrinkMemory := 0. forceTenureFlag := 0. gcBiasToGrow := 0. gcBiasToGrowGCLimit := 0. extraRootCount := 0."! Item was added: + ----- Method: SpurMemoryManager>>isInMemory: (in category 'plugin support') ----- + isInMemory: address + "Return true if the given address is in ST object memory" + ^(self oop: address isGreaterThanOrEqualTo: startOfMemory) + and: [(self oop: address isLessThan: newSpaceLimit) + or: [segmentManager isInSegments: address]]! Item was added: + ----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'primitive support') ----- + loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray + "This primitive is called from Squeak as... + <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray." + + "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" + + ^PrimErrUnsupported! Item was added: + ----- Method: SpurMemoryManager>>maxIdentityHash (in category 'accessing') ----- + maxIdentityHash + ^self identityHashHalfWordMask! Item was added: + ----- Method: SpurMemoryManager>>maybeSplObj: (in category 'interpreter access') ----- + maybeSplObj: index + <api> + "Answer one of the objects in the SpecialObjectsArray, if in range, otherwise answer nil." + ^index < (self numSlotsOf: specialObjectsOop) ifTrue: + [self fetchPointer: index ofObject: specialObjectsOop]! Item was added: + ----- Method: SpurMemoryManager>>oldSpaceSize (in category 'accessing') ----- + oldSpaceSize + ^segmentManager totalBytesInSegments! Item was added: + ----- Method: SpurMemoryManager>>primitiveErrorTable (in category 'accessing') ----- + primitiveErrorTable + <api> + ^self splObj: PrimErrTableIndex! Item was added: + ----- Method: SpurMemoryManager>>statCompMoveCount (in category 'accessing') ----- + statCompMoveCount + "Spur never compacts by moving" + ^0! Item was added: + ----- Method: SpurMemoryManager>>statRootTableCount (in category 'accessing') ----- + statRootTableCount + ^scavenger rememberedSetSize! Item was added: + ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'primitive support') ----- + storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots + "This primitive is called from Squeak as... + <imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray." + + "This primitive will store a binary image segment (in the same format as the Squeak image file) of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree). All pointers from within the tree to objects outside the tree will be copied into the array of outpointers. In their place in the image segment will be an oop equal to the offset in the outPointer array (the first would be 4). but with the high bit set." + + "The primitive expects the array and wordArray to be more than adequately long. In this case it returns normally, and truncates the two arrays to exactly the right size. To simplify truncation, both incoming arrays are required to be 256 bytes or more long (ie with 3-word headers). If either array is too small, the primitive will fail, but in no other case. + + During operation of the primitive, it is necessary to convert from both internal and external oops to their mapped values. To make this fast, the headers of the original objects in question are replaced by the mapped values (and this is noted by adding the forbidden XX header type). Tables are kept of both kinds of oops, as well as of the original headers for restoration. + + To be specific, there are two similar two-part tables, the outpointer array, and one in the upper fifth of the segmentWordArray. Each grows oops from the bottom up, and preserved headers from halfway up. + + In case of either success or failure, the headers must be restored. In the event of primitive failure, the table of outpointers must also be nilled out (since the garbage in the high half will not have been discarded." + + ^PrimErrUnsupported! Item was added: + ----- Method: SpurSegmentManager>>isInSegments: (in category 'testing') ----- + isInSegments: address + 0 to: numSegments - 1 do: + [:i| + address < (segments at: i) segStart ifTrue: + [^false]. + address < ((segments at: i) segStart + (segments at: i) segSize) ifTrue: + [^true]]. + ^false! Item was changed: ----- Method: StackInterpreter>>checkOkayFields: (in category 'debug support') ----- checkOkayFields: oop "Check if the argument is an ok object. If this is a pointers object, check that its fields are all okay oops." | hasYoung i fieldOop | (oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013" (objectMemory isIntegerObject: oop) ifTrue: [ ^true ]. (objectMemory checkOkayOop: oop) ifFalse: [ ^false ]. (objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ]. + ((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ]. - ((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ]. hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonImm: oop). (objectMemory isCompiledMethod: oop) ifTrue: [i := (self literalCountOf: oop) + LiteralStart - 1] ifFalse: [(objectMemory isContext: oop) ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1] ifFalse: [i := (objectMemory lengthOf: oop) - 1]]. [i >= 0] whileTrue: [fieldOop := objectMemory fetchPointer: i ofObject: oop. (objectMemory isIntegerObject: fieldOop) ifFalse: [hasYoung := hasYoung or: [objectMemory isYoung: fieldOop]. (objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ]. (self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]]. i := i - 1]. hasYoung ifTrue: [^objectMemory checkOkayYoungReferrer: oop]. ^true! Item was changed: ----- Method: StackInterpreter>>okayFields: (in category 'debug support') ----- okayFields: oop "Check if the argument is an ok object. If this is a pointers object, check that its fields are all okay oops." | i fieldOop | (oop = nil or: [oop = 0]) ifTrue: [ ^true ]. (objectMemory isIntegerObject: oop) ifTrue: [ ^true ]. (objectMemory okayOop: oop) ifFalse: [ ^false ]. (objectMemory oopHasOkayClass: oop) ifFalse: [ ^false ]. + ((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ]. - ((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ]. (objectMemory isCompiledMethod: oop) ifTrue: [i := (self literalCountOf: oop) + LiteralStart - 1] ifFalse: [(objectMemory isContext: oop) ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1] ifFalse: [i := (objectMemory lengthOf: oop) - 1]]. [i >= 0] whileTrue: [ fieldOop := objectMemory fetchPointer: i ofObject: oop. (objectMemory isIntegerObject: fieldOop) ifFalse: [ (objectMemory okayOop: fieldOop) ifFalse: [ ^false ]. (self oopHasOkayClass: fieldOop) ifFalse: [ ^false ]. ]. i := i - 1. ]. ^true! Item was changed: ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') ----- readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory." "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command." "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!" | swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes headerFlags hdrMaxExtSemTabSize firstSegSize | <var: #f type: 'sqImageFile '> <var: #heapBase type: 'usqInt'> <var: #desiredHeapSize type: 'usqInt'> <var: #headerStart type: 'squeakFileOffsetType '> <var: #dataSize type: 'size_t '> <var: #imageOffset type: 'squeakFileOffsetType '> metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)" swapBytes := self checkImageVersionFrom: f startingAt: imageOffset. headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position" headerSize := self getLongFromFile: f swap: swapBytes. dataSize := self getLongFromFile: f swap: swapBytes. oldBaseAddr := self getLongFromFile: f swap: swapBytes. objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes). objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used." savedWindowSize := self getLongFromFile: f swap: swapBytes. headerFlags := self getLongFromFile: f swap: swapBytes. self setImageHeaderFlagsFrom: headerFlags. extraVMMemory := self getLongFromFile: f swap: swapBytes. hdrNumStackPages := self getShortFromFile: f swap: swapBytes. "4 stack pages is small. Should be able to run with as few as three. 4 should be comfortable but slow. 8 is a reasonable default. Can be changed via vmParameterAt: 43 put: n. Can be set as a preference (Info.plist, VM.ini, command line etc). If desiredNumStackPages is already non-zero then it has been set as a preference. Ignore (but preserve) the header's default." numStackPages := desiredNumStackPages ~= 0 ifTrue: [desiredNumStackPages] ifFalse: [hdrNumStackPages = 0 ifTrue: [self defaultNumStackPages] ifFalse: [hdrNumStackPages]]. desiredNumStackPages := hdrNumStackPages. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. It is used for the cog code size in Cog. Preserve it to be polite to other VMs." theUnknownShort := self getShortFromFile: f swap: swapBytes. hdrEdenBytes := self getLongFromFile: f swap: swapBytes. objectMemory edenBytes: (desiredEdenBytes ~= 0 ifTrue: [desiredEdenBytes] ifFalse: [hdrEdenBytes = 0 ifTrue: [objectMemory defaultEdenBytes] ifFalse: [hdrEdenBytes]]). desiredEdenBytes := hdrEdenBytes. hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes. hdrMaxExtSemTabSize ~= 0 ifTrue: [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize]. "pad to word boundary. This slot can be used for anything else that will fit in 16 bits. Preserve it to be polite to other VMs." the2ndUnknownShort := self getShortFromFile: f swap: swapBytes. + firstSegSize := self getLongFromFile: f swap: swapBytes. - firstSegSize := self nextLongFrom: f swap: swapBytes. objectMemory firstSegmentSize: firstSegSize. "decrease Squeak object heap to leave extra memory for the VM" heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'. "compare memory requirements with availability". minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes. heapSize < minimumMemory ifTrue: [self insufficientMemorySpecifiedError]. "allocate a contiguous block of memory for the Squeak heap" objectMemory memory: (self allocateMemory: heapSize minimum: minimumMemory imageFile: f headerSize: headerSize) asUnsignedInteger. objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError]. heapBase := objectMemory startOfMemory. objectMemory setHeapBase: heapBase memoryLimit: (heapBase + heapSize) - 24 "decrease memoryLimit a tad for safety" endOfMemory: heapBase + dataSize. "position file after the header" self sqImageFile: f Seek: headerStart + headerSize. "read in the image in bulk, then swap the bytes if necessary" bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize. bytesRead ~= dataSize ifTrue: [self unableToReadImageError]. self ensureImageFormatIsUpToDate: swapBytes. "compute difference between old and new memory base addresses" bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" ^dataSize! Item was changed: ----- Method: StackInterpreter>>signed32BitIntegerFor: (in category 'primitive support') ----- signed32BitIntegerFor: integerValue "Return a full 32 bit integer object for the given integer value" | newLargeInteger value largeClass | <inline: false> + (objectMemory isIntegerValue: integerValue) ifTrue: + [^objectMemory integerObjectOf: integerValue]. + objectMemory hasSpurMemoryManagerAPI + ifTrue: + [integerValue < 0 + ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex. + value := 0 - integerValue] + ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex. + value := integerValue]. + objectMemory allocateBytes: 4 classIndex: largeClass] + ifFalse: + [integerValue < 0 + ifTrue: [largeClass := objectMemory classLargeNegativeInteger. + value := 0 - integerValue] + ifFalse: [largeClass := objectMemory classLargePositiveInteger. + value := integerValue]. + newLargeInteger := objectMemory eeInstantiateClass: largeClass indexableSize: 4]. - (objectMemory isIntegerValue: integerValue) - ifTrue: [^ objectMemory integerObjectOf: integerValue]. - integerValue < 0 - ifTrue:[ largeClass := objectMemory classLargeNegativeInteger. - value := 0 - integerValue] - ifFalse:[ largeClass := objectMemory classLargePositiveInteger. - value := integerValue]. - newLargeInteger := objectMemory eeInstantiateClass: largeClass indexableSize: 4. objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF). objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF). objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF). objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF). ^newLargeInteger! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') ----- primitiveFullGC "Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)." objectMemory fullGCLock > 0 ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. self externalWriteBackHeadFramePointers. + objectMemory hasSpurMemoryManagerAPI ifFalse: + [objectMemory incrementalGC]. "maximimize space for forwarding table" - objectMemory incrementalGC. "maximimize space for forwarding table" objectMemory fullGC. self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).! Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. - Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:]. - These must be top-level statements; they cannot appear in expressions. As a hack also update the types of variables introduced to implement cascades correctly. This has to be done at the same time as this is done, so why not piggy back here?" - | replacements | extraVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. - replacements := IdentityDictionary new. aCodeGen pushScope: declarations + while:"N.B. nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved." - while: [parseTree nodesWithParentsDo: [:node :parent| node isSend ifTrue: [(aCodeGen isBuiltinSelector: node selector) ifTrue: [node isBuiltinOperator: true. "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" (node selector = #to:by:do: and: [node args size = 4]) ifTrue: [| limitExpr | limitExpr := node args first. (limitExpr anySatisfy: [:subNode| subNode isSend and: [(aCodeGen isBuiltinSelector: subNode selector) not and: [(subNode isStructSend: aCodeGen) not]]]) ifTrue: [locals add: node args last name] ifFalse: [node arguments: node args allButLast]]] ifFalse: [(CaseStatements includes: node selector) ifTrue: + [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node})]. - [replacements at: node put: (self buildCaseStmt: node)]. (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: + [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]]]]]! - [replacements at: node put: (self buildSwitchStmt: node parent: parent)]]]. - ((node isAssignment or: [node isReturn]) - and: [node expression isSwitch]) ifTrue: - [replacements at: node put: (self transformSwitchExpression: node)]]]. - replacements isEmpty ifFalse: - [parseTree := parseTree replaceNodesIn: replacements]! Item was changed: ----- Method: TSendNode>>structTargetKind: (in category 'testing') ----- structTargetKind: aCodeGen "Answer if the recever evaluates to a struct or struct pointer and hence can be dereferenced using . or ->. Answer any of #struct #pointer or nil. Right now we don't need or support structure return so this method answers either #pointer or nil." selector == #cCoerceSimple:to: ifTrue: [^(VMStructType isTypePointerToStruct: arguments last value) ifTrue: [#pointer]]. + selector == #addressOf: ifTrue: + [^#pointer]. + selector == #at: ifTrue: [receiver isVariable ifTrue: [(aCodeGen typeOfVariable: receiver name) ifNotNil: [:type| | derefType | type last = $* ifFalse: [^receiver structTargetKind: aCodeGen]. + (VMStructType isTypeStruct: (aCodeGen - (Smalltalk classNamed: (aCodeGen extractTypeFor: receiver name + fromDeclaration: type allButLast)) ifTrue: + [^#struct]]]. - fromDeclaration: type allButLast)) ifNotNil: - [:class| - class isStructClass ifTrue: - [^#struct]]]]. (receiver structTargetKind: aCodeGen) ifNotNil: [:kind| ^kind]]. + (aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: + [^#pointer]. + + (aCodeGen selectorReturnsStruct: selector) ifTrue: + [^#struct]. + + ^nil! - ^(aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: - [#pointer]! Item was changed: ----- Method: TStmtListNode>>nodesDo:parent: (in category 'enumerating') ----- nodesDo: aBlock parent: parent "Apply aBlock to all nodes in the receiver with each node's parent. N.B. This is assumed to be bottom-up, leaves first." + statements do: [:s| s nodesDo: aBlock parent: self]. - statements do: [:s| s nodesDo: aBlock parent: self.]. aBlock value: self value: parent! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForCogit: (in category 'generate sources') ----- buildCodeGeneratorForCogit: getAPIMethods "Answer the code generator for translating the cogit." | cg cogitClass cogitClasses apicg | cg := self createCogitCodeGenerator. cg vmClass: (cogitClass := self cogitClass). + { cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do: - { cogitClass. self interpreterClass } do: [:cgc| (cgc respondsTo: #initializeWithOptions:) ifTrue: [cgc initializeWithOptions: optionsDictionary] ifFalse: [cgc initialize]]. cogitClasses := OrderedCollection new. [cogitClasses addFirst: cogitClass. cogitClass ~~ Cogit and: [cogitClass inheritsFrom: Cogit]] whileTrue: [cogitClass := cogitClass superclass]. cogitClasses addFirst: VMClass. cogitClasses addAllLast: ((self cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]). cogitClasses do: [:cgc| cg addClass: cgc]. cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses). getAPIMethods ifTrue: [apicg := self buildCodeGeneratorForInterpreter: false. cg apiMethods: apicg selectAPIMethods]. ^cg! Item was changed: ----- Method: VMMaker>>buildCodeGeneratorForInterpreter: (in category 'generate sources') ----- buildCodeGeneratorForInterpreter: getAPIMethods "Answer the code generator for translating the interpreter." | cg interpreterClass interpreterClasses apicg | interpreterClasses := OrderedCollection new. interpreterClass := self interpreterClass. interpreterClass initializeWithOptions: optionsDictionary. (cg := self createCodeGenerator) vmClass: interpreterClass. [interpreterClass ~~ VMClass] whileTrue: [interpreterClasses addFirst: interpreterClass. interpreterClass := interpreterClass superclass]. cg vmClass objectMemoryClass ifNotNil: [:objectMemoryClass| interpreterClass := objectMemoryClass. [interpreterClass ~~ VMClass] whileTrue: [interpreterClasses addFirst: interpreterClass. interpreterClass := interpreterClass superclass]]. interpreterClasses addFirst: VMClass. interpreterClasses addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses). - (cg structClassesForTranslationClasses: interpreterClasses) do: - [:structClass| structClass initialize]. - cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses). interpreterClasses do: [:ic| (ic respondsTo: #initializeWithOptions:) ifTrue: [ic initializeWithOptions: optionsDictionary] ifFalse: [ic initialize]]. + (cg structClassesForTranslationClasses: interpreterClasses) do: + [:structClass| structClass initialize]. + cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses). + interpreterClasses do: [:ic| cg addClass: ic]. (getAPIMethods and: [self interpreterClass needsCogit]) ifTrue: [apicg := self buildCodeGeneratorForCogit: false. cg apiMethods: apicg selectAPIMethods]. ^cg! Item was added: + ----- Method: VMStructType class>>isTypeStruct: (in category 'translation') ----- + isTypeStruct: type + StructTypeNameCache ifNil: + [StructTypeNameCache := Set new. + self allSubclassesDo: + [:sc| StructTypeNameCache add: sc name; add: sc structTypeName]]. + ^type notNil + and: [StructTypeNameCache anySatisfy: + [:structType| + type = structType]]!

1 0

VM Maker: VMMaker.oscog-eem.455.mcz
by commits＠source.squeak.org 14 Oct '13

14 Oct '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.455.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.455 Author: eem Time: 14 October 2013, 10:54:31.148 am UUID: aa5d9a84-c8f8-4bea-b3c6-3871153f8238 Ancestors: VMMaker.oscog-eem.454 Harvest any initializations of localised inst vars and add them to the methods into which they're localised. =============== Diff against VMMaker.oscog-eem.454 =============== Item was added: + ----- Method: CCodeGenerator>>initializerForInstVar:in: (in category 'inlining') ----- + initializerForInstVar: varName in: aClass + | instVarIndex | + instVarIndex := aClass instVarIndexFor: varName ifAbsent: [^nil]. + aClass selectorsAndMethodsDo: + [:s :m| | tmeth | + ((s beginsWith: 'initialize') + and: [m writesField: instVarIndex]) ifTrue: + [tmeth := m methodNode asTranslationMethodOfClass: TMethod. + tmeth parseTree nodesDo: + [:node| | exprOrAssignment | + (node isAssignment + and: [node variable name = varName]) ifTrue: + [exprOrAssignment := node. + [exprOrAssignment isAssignment] whileTrue: + [exprOrAssignment := exprOrAssignment expression]. + ^exprOrAssignment]]]]. + ^nil! Item was added: + ----- Method: CCodeGenerator>>initializerForInstVar:inStartClass: (in category 'inlining') ----- + initializerForInstVar: varName inStartClass: aClass + | allClasses sizeBefore | + (aClass inheritsFrom: VMClass) ifFalse: + [^false]. + allClasses := (aClass withAllSuperclasses copyUpTo: VMClass) asSet. + [sizeBefore := allClasses size. + allClasses copy do: + [:class| + (class ancilliaryClasses: optionsDictionary) do: + [:ancilliary| + allClasses addAll: (ancilliary withAllSuperclasses copyUpTo: VMClass)]]. + sizeBefore ~= allClasses size] whileTrue. + allClasses do: + [:class| + (self initializerForInstVar: varName in: class) ifNotNil: + [:initializer| ^initializer]]. + ^nil! Item was changed: ----- Method: CCodeGenerator>>localizeGlobalVariables (in category 'utilities') ----- localizeGlobalVariables | candidates elected | "find all globals used in only one method" candidates := globalVariableUsage select: [:e | e size = 1]. (candidates keys select: [:k| vmClass mustBeGlobal: k]) do: [:k| candidates removeKey: k]. elected := Set new. "move any suitable global to be local to the single method using it" candidates keysAndValuesDo: + [:key :targets | - [:key :targets | targets do: + [:name | | procedure newDeclaration | - [:name | | procedure | procedure := methods at: name. procedure isRealMethod ifTrue: [logger notNil ifTrue: [logger ensureCr; show: key, ' localised to ', name; cr]. elected add: (procedure locals add: key). + newDeclaration := variableDeclarations at: key ifAbsent: ['sqInt ', key]. + (self initializerForInstVar: key inStartClass: (methods at: name) definingClass) ifNotNil: + [:initializerNode| + newDeclaration := String streamContents: + [:s| + s nextPutAll: newDeclaration; nextPutAll: ' = '. + initializerNode emitCCodeOn: s level: 0 generator: self]]. + procedure declarationAt: key put: newDeclaration. + variableDeclarations removeKey: key ifAbsent: []]]]. - variableDeclarations at: key ifPresent: - [:v | - procedure declarationAt: key put: v. - variableDeclarations removeKey: key]]]]. elected do: [:ea| (variables includes: ea) ifTrue: [self checkDeleteVariable: ea]]. variables removeAllFoundIn: elected!

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
15
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 October 2013