Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.477.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.477 Author: eem Time: 25 October 2013, 12:57:49.906 pm UUID: b29f70be-1ead-4893-8f3c-f39b3d189a87 Ancestors: VMMaker.oscog-eem.476
Fix shift in headerForSlots:format:classIndex:; needs to be long long. Make a few vitals inlined. Fix off-by-one in printOopShortInner:. Relax restriction in isFunctional of return type being sqInt to being any of sqInt, usqInt, sqLong or usqLong.
C Spur VM runs up to the end of the first scavenge, when it tries to shrink memory.
=============== Diff against VMMaker.oscog-eem.476 ===============
Item was changed: ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') ----- cCoerceSimple: value to: cTypeString "Type coercion for translation and simulation. For simulation answer a suitable surrogate for the struct types" ^cTypeString caseOf: { [#'unsigned long'] -> [value]. [#sqInt] -> [value]. [#usqInt] -> [value]. + [#sqLong] -> [value]. + [#usqLong] -> [value]. [#'AbstractInstruction *'] -> [value]. [#'BytecodeFixup *'] -> [value]. [#'CogMethod *'] -> [value]. [#'char *'] -> [value]. [#'sqInt *'] -> [value]. [#'void *'] -> [value]. [#void] -> [value]. [#'void (*)()'] -> [value]. [#'void (*)(void)'] -> [value]. [#'unsigned long (*)(void)'] -> [value]. [#'void (*)(unsigned long,unsigned long)'] -> [value] }!
Item was changed: ----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') ----- fillObj: objOop numSlots: numSlots with: fillValue + <inline: true> self assert: (objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1) < (self addressAfter: objOop). objOop + self baseHeaderSize to: objOop + self baseHeaderSize + (numSlots * self wordSize) - 1 by: self allocationUnit do: [:p| self longAt: p put: fillValue; longAt: p + 4 put: fillValue]!
Item was changed: ----- Method: Spur64BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') ----- fillObj: objOop numSlots: numSlots with: fillValue + <inline: true> self assert: (objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1) < (self addressAfter: objOop). objOop + self baseHeaderSize to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1 by: self allocationUnit do: [:p| self longAt: p put: fillValue]!
Item was changed: ----- Method: SpurMemoryManager>>checkedLongAt: (in category 'memory access') ----- checkedLongAt: byteAddress "Assumes zero-based array indexing." <api> + (byteAddress asUnsignedInteger < self startOfMemory + or: [byteAddress asUnsignedInteger > endOfMemory + or: [byteAddress asUnsignedInteger > newSpaceLimit + and: [(segmentManager isInSegments: byteAddress asUnsignedInteger) not]]]) ifTrue: - (self addressCouldBeObj: byteAddress) ifFalse: [self warning: 'checkedLongAt bad address'. coInterpreter primitiveFail]. ^self longAt: byteAddress!
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,?}) | 22: identityHash | (on a word boundary) | 3 bits | (msb <-> lsb = {isGrey,isPinned,isRemembered} | 5: format | (on a byte boundary) | 2 bits | (msb,lsb = {isImmutable,?}) | 22: classIndex | (on a word boundary) : LSB The remaining bits (7) are used for isImmutable (bit 23) 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 } 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> + <inline: true> + ^ ((self cCoerceSimple: numSlots to: #usqLong) << self numSlotsFullShift) - ^ (numSlots << self numSlotsFullShift) + (formatField << self formatShift) + classIndex!
Item was changed: ----- Method: SpurMemoryManager>>unlinkSolitaryFreeTreeNode: (in category 'free space') ----- unlinkSolitaryFreeTreeNode: freeTreeNode "Unlink a freeTreeNode. Assumes the node has no list (null next link)." | parent smaller larger | self assert: (self fetchPointer: self freeChunkNextIndex ofObject: freeTreeNode) = 0.
"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 |"
smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeTreeNode. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeTreeNode. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: freeTreeNode. 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: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: larger. + larger ~= 0 ifTrue: + [self storePointer: self freeChunkParentIndex + ofObject: larger + withValue: parent]] - self storePointer: self freeChunkParentIndex - ofObject: larger - withValue: parent] ifFalse: [self storePointer: (freeTreeNode = (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]]]!
Item was changed: ----- Method: SpurSegmentManager>>isInSegments: (in category 'testing') ----- isInSegments: address + <var: #address type: #usqInt> 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>>nameOfClass: (in category 'debug printing') ----- nameOfClass: classOop "Brain-damaged nameOfClass: for C VM. Does *not* answer Foo class for metaclasses. Use e.g. classIsMeta: to avoid being fooled." <inline: false> <returnTypeC: 'char *'> | numSlots | numSlots := objectMemory numSlotsOf: classOop. numSlots = metaclassNumSlots ifTrue: [^self nameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop)]. numSlots <= classNameIndex ifTrue: [^'bad class']. + ^objectMemory firstIndexableField: (objectMemory fetchPointer: classNameIndex ofObject: classOop)! - ^objectMemory firstFixedField: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was changed: ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') ----- printOopShortInner: oop | classOop name nameLen | <var: #name type: #'char *'> <inline: true> (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: [self printChar: $$; printChar: (objectMemory characterValueOf: oop); printChar: $(; printHex: (objectMemory integerValueOf: oop); printChar: $). ^nil]. self printNum: (objectMemory integerValueOf: oop); printChar: $(; printHex: (objectMemory integerValueOf: oop); printChar: $). ^nil]. (objectMemory addressCouldBeObj: oop) ifFalse: [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [' is not on the heap']); cr. ^nil]. (self isFloatObject: oop) ifTrue: [self printFloat: (self dbgFloatValueOf: oop). ^nil]. classOop := objectMemory fetchClassOfNonImm: oop. (objectMemory addressCouldBeObj: classOop) ifFalse: [self print: 'a ??'. ^nil]. (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue: [self printNameOfClass: oop count: 5. ^nil]. oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil]. oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil]. oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil]. nameLen := self lengthOfNameOfClass: classOop. nameLen = 0 ifTrue: [self print: 'a ??'. ^nil]. name := self nameOfClass: classOop. nameLen = 10 ifTrue: [(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue: [self printChar: $'; printStringOf: oop; printChar: $'. ^nil]. (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue: [self printChar: $#; printStringOf: oop. ^nil]]. (nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue: [self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)). ^nil]. self print: 'a(n) '. + 0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]. - 1 to: nameLen do: [:i| self printChar: (name at: i)]. "Try to spot association-like things; they're all subclasses of LookupKey" ((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1) and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation))) and: [objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue: [self space; printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop); print: ' -> '; printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!
Item was changed: ----- Method: TMethod>>isFunctional (in category 'inlining') ----- isFunctional "Answer true if the receiver is a functional method. That is, if it consists of a single return statement of an expression that contains no other returns.
+ Answer false for methods with return types other than the simple + integer types to work around bugs in the inliner." - Answer false for methods with return types other than #sqInt to work - around bugs in the inliner."
(parseTree statements size = 1 and: [parseTree statements last isReturn]) ifFalse: [ ^false ]. parseTree statements last expression nodesDo: [ :n | n isReturn ifTrue: [ ^false ]]. + ^#(sqInt usqInt sqLong usqLong) includes: returnType! - returnType = #sqInt ifFalse:[^false]. - ^true!
Item was changed: ----- Method: TMethod>>maybeBreakFor:in: (in category 'inlining') ----- maybeBreakFor: aNode in: aCodeGen "convenient for debugging..." (aNode isSend and: [(aCodeGen breakSrcInlineSelector notNil or: [aCodeGen breakDestInlineSelector notNil]) and: [(aCodeGen breakSrcInlineSelector ifNil: [true] ifNotNil: [:srcSel| srcSel = aNode selector]) and: [aCodeGen breakDestInlineSelector ifNil: [true] ifNotNil: [:dstSel| dstSel = selector]]]]) ifTrue: + [self halt: selector]! - [self halt]!
vm-dev@lists.squeakfoundation.org