[Vm-dev] VM Maker: VMMaker.oscog-eem.652.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Mar 20 16:41:13 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.652.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.652
Author: eem
Time: 20 March 2014, 9:39:01.361 am
UUID: d044d1df-74db-4230-8670-4fcbc815e762
Ancestors: VMMaker.oscog-eem.651
Implement whereIs: to provide better debugging of weak containers.
Allow inlining when parameters include structure accessors for
e.g. isInFutureSpace: in whereIsMaybeHeapThing:.
=============== Diff against VMMaker.oscog-eem.651 ===============
Item was changed:
----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
shouldIncludeMethodFor: aClass selector: selector
"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."
(aClass >> selector pragmaAt: #option:) ifNotNil:
[:pragma| | key |
key := pragma argumentAt: 1.
vmMaker ifNotNil:
+ [vmMaker cogitClassName ifNotNil:
+ [(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
+ [| cogitClass optionClass |
+ cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
+ optionClass := Smalltalk classNamed: key.
+ ^cogitClass includesBehavior: optionClass]].
- [(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
- [| cogitClass optionClass |
- cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
- optionClass := Smalltalk classNamed: key.
- ^cogitClass includesBehavior: optionClass].
((vmClass
ifNotNil: [vmClass initializationOptions]
ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil:
[:option| option ~~ false ifTrue: [^true]].
(aClass bindingOf: key) ifNotNil:
[:binding|
binding value ~~ false ifTrue: [^true]].
(VMBasicConstants bindingOf: key) ifNotNil:
[:binding|
binding value ~~ false ifTrue: [^true]]].
^false].
^true!
Item was added:
+ ----- Method: CoInterpreter>>whereIs: (in category 'debug printing') -----
+ whereIs: anOop
+ <var: 'somewhere' type: #'char *'>
+ (cogit whereIsMaybeCodeThing: anOop) ifNotNil: [:somewhere| ^somewhere].
+ ^super whereIs: anOop!
Item was added:
+ ----- Method: CoInterpreterStackPages>>whereIsMaybeStackThing: (in category 'debug printing') -----
+ whereIsMaybeStackThing: anOop
+ <returnTypeC: 'char *'>
+ (self oop: anOop
+ isGreaterThanOrEqualTo: (stackBasePlus1 - 1)
+ andLessThan: (self cCode: [pages]
+ inSmalltalk: [(self stackPageAt: 0)])) ifTrue:
+ [^' is in the stack zone'].
+ ^nil!
Item was added:
+ ----- Method: CogMethodZone>>whereIsMaybeCodeThing: (in category 'debug printing') -----
+ whereIsMaybeCodeThing: anOop
+ <api>
+ <returnTypeC: 'char *'>
+ (self oop: anOop isGreaterThanOrEqualTo: baseAddress andLessThan: limitAddress) ifTrue:
+ [(self oop: anOop isLessThan: cogit minCogMethodAddress) ifTrue:
+ [^' is in generated runtime'].
+ (self oop: anOop isLessThan: mzFreeStart) ifTrue:
+ [^' is in generated methods'].
+ (self oop: anOop isLessThan: youngReferrers) ifTrue:
+ [^' is in code zone'].
+ ^' is in young referrers'].
+ ^nil!
Item was changed:
----- Method: CogVMSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^(objectMemory characterValueOf: oop) < 256
ifTrue:
['=$' , (objectMemory characterValueOf: oop) printString ,
' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
ifFalse:
['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop]].
- ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
Item was added:
+ ----- Method: Cogit>>whereIsMaybeCodeThing: (in category 'debug printing') -----
+ whereIsMaybeCodeThing: anOop
+ <doNotGenerate>
+ ^methodZone whereIsMaybeCodeThing: anOop!
Item was added:
+ ----- Method: InterpreterStackPages>>whereIsMaybeStackThing: (in category 'debug printing') -----
+ whereIsMaybeStackThing: anOop
+ <returnTypeC: 'char *'>
+ (self cCode:
+ [self oop: anOop isGreaterThanOrEqualTo: stackMemory andLessThan: pages]
+ inSmalltalk:
+ [(self memIndexFor: anOop) between: 1 and: stackMemory size]) ifTrue:
+ [^' is in the stack zone'].
+ ^nil!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
baseFrameReturn
bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
bytecodePrimAt
bytecodePrimAtPut
bytesOrInt:growTo:
ceBaseFrameReturn:
checkIsStillMarriedContext:currentFP:
checkedIntegerValueOf:
cogMethodDoesntLookKosher:
commonAt:
commonAtPut:
commonVariable:at:put:cacheIndex:
compare31or32Bits:equal:
digitBitLogic:with:opIndex:
digitLength:
displayBitsOf:Left:Top:Right:Bottom:
ensureContextHasBytecodePC:
externalInstVar:ofContext:
fetchIntOrFloat:ofObject:
fetchIntOrFloat:ofObject:ifNil:
fetchStackPointerOf:
fileValueOf:
frameOfMarriedContext:
functionForPrimitiveExternalCall:
genSpecialSelectorArithmetic
genSpecialSelectorComparison
inlineCacheTagForInstance:
instVar:ofContext:
isCogMethodReference:
isLiveContext:
isMarriedOrWidowedContext:
isNegativeIntegerValueOf:
isNormalized:
loadBitBltDestForm
loadBitBltSourceForm
loadFloatOrIntFrom:
loadPoint:from:
magnitude64BitValueOf:
makeBaseFrameFor:
numPointerSlotsOf:
objCouldBeClassObj:
on:do: "from the debugger"
positive32BitValueOf:
positive64BitValueOf:
primDigitAdd:
primDigitBitShiftMagnitude:
primDigitCompare:
primDigitDiv:negative:
primDigitMultiply:negative:
primDigitSubtract:
primitiveAllInstances
primitiveAsCharacter
primitiveContextAt
primitiveContextAtPut
primitiveExternalCall
primitiveFileSetPosition
primitiveFileTruncate DoIt
primitiveForwardSignalToSemaphore
primitiveGrowMemoryByAtLeast
primitiveInputSemaphore
primitiveMakePoint
primitiveNewMethod
primitiveObjectAtPut
primitiveSizeInBytesOfInstance
primitiveVMParameter
printContext:
quickFetchInteger:ofObject:
shortPrint:
shortPrintOop:
signed32BitValueOf:
signed64BitValueOf:
subscript:with:storing:format:
+ unlockSurfaces
+ establishFrameForContextToReturnTo:) includes: sel) ifFalse:
- unlockSurfaces) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was changed:
----- Method: Spur32BitMMLESimulator>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
baseFrameReturn
bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
bytecodePrimAt
bytecodePrimAtPut
bytesOrInt:growTo:
ceBaseFrameReturn:
checkIsStillMarriedContext:currentFP:
checkedIntegerValueOf:
cogMethodDoesntLookKosher:
commonAt:
commonAtPut:
commonVariable:at:put:cacheIndex:
compare31or32Bits:equal:
digitBitLogic:with:opIndex:
digitLength:
displayBitsOf:Left:Top:Right:Bottom:
ensureContextHasBytecodePC:
externalInstVar:ofContext:
fetchIntOrFloat:ofObject:
fetchIntOrFloat:ofObject:ifNil:
fetchStackPointerOf:
fileValueOf:
frameOfMarriedContext:
functionForPrimitiveExternalCall:
genSpecialSelectorArithmetic
genSpecialSelectorComparison
inlineCacheTagForInstance:
instVar:ofContext:
isCogMethodReference:
isLiveContext:
isMarriedOrWidowedContext:
isNegativeIntegerValueOf:
isNormalized:
loadBitBltDestForm
loadBitBltSourceForm
loadFloatOrIntFrom:
loadPoint:from:
magnitude64BitValueOf:
makeBaseFrameFor:
numPointerSlotsOf:
objCouldBeClassObj:
on:do: "from the debugger"
positive32BitValueOf:
positive64BitValueOf:
primDigitAdd:
primDigitBitShiftMagnitude:
primDigitCompare:
primDigitDiv:negative:
primDigitMultiply:negative:
primDigitSubtract:
primitiveAllInstances
primitiveAsCharacter
primitiveContextAt
primitiveContextAtPut
primitiveExternalCall
primitiveFileSetPosition
primitiveFileTruncate DoIt
primitiveForwardSignalToSemaphore
primitiveGrowMemoryByAtLeast
primitiveInputSemaphore
primitiveMakePoint
primitiveNewMethod
primitiveObjectAtPut
primitiveSizeInBytesOfInstance
primitiveVMParameter
printContext:
quickFetchInteger:ofObject:
shortPrint:
shortPrintOop:
signed32BitValueOf:
signed64BitValueOf:
subscript:with:storing:format:
+ unlockSurfaces
+ establishFrameForContextToReturnTo:) includes: sel) ifFalse:
- unlockSurfaces) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was changed:
----- Method: SpurGenerationScavengerSimulator>>scavenge: (in category 'scavenger') -----
scavenge: tenuringCriterion
+ coInterpreter transcript nextPutAll: 'scavenging ('; print: manager statScavenges; nextPutAll: ') ...'; flush.
- coInterpreter transcript nextPutAll: 'scavenging...'; flush.
^super scavenge: tenuringCriterion!
Item was added:
+ ----- Method: SpurMemoryManager>>whereIsMaybeHeapThing: (in category 'debug printing') -----
+ whereIsMaybeHeapThing: anOop
+ <returnTypeC: 'char *'>
+ (self isInNewSpace: anOop) ifTrue:
+ [(self isInEden: anOop) ifTrue: [^' is in eden'].
+ (self isInFutureSpace: anOop) ifTrue: [^' is in future space'].
+ (self isInPastSpace: anOop) ifTrue: [^' is in past space'].
+ ^' is in new space'].
+ (self isInOldSpace: anOop) ifTrue:
+ [(segmentManager segmentContainingObj: anOop) ifNotNil:
+ [^' is in old space'].
+ ^' is between old space segments'].
+ ^nil!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine column |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self shortPrintOop: oop].
self printHex: oop.
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop]); cr].
- ifFalse: [' is not on the heap']); cr].
(objectMemory isFreeObject: oop) ifTrue:
[^self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr].
(objectMemory isForwarded: oop) ifTrue:
[^self
print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[^self cr; printFloat: (self dbgFloatValueOf: oop); cr].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
(objectMemory isWords: oop) ifTrue:
[lastIndex := 64 min: ((objectMemory byteLengthOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^self].
^self printStringOf: oop; cr].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>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: $)].
^self
printNum: (objectMemory integerValueOf: oop);
printChar: $(;
printHex: (objectMemory integerValueOf: oop);
printChar: $)].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop])].
- ifFalse: [' is not on the heap'])].
(objectMemory isOopForwarded: oop) ifTrue:
[^self printHex: oop; print: ' is a forwarder to '; printHex: (objectMemory followForwarded: oop)].
(self isFloatObject: oop) ifTrue:
[^self printFloat: (self dbgFloatValueOf: oop)].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory addressCouldBeObj: classOop) ifFalse:
[^self print: 'a ??'].
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^self printNameOfClass: oop count: 5].
oop = objectMemory nilObject ifTrue: [^self print: 'nil'].
oop = objectMemory trueObject ifTrue: [^self print: 'true'].
oop = objectMemory falseObject ifTrue: [^self print: 'false'].
nameLen := self lengthOfNameOfClass: classOop.
nameLen = 0 ifTrue: [^self print: 'a ??'].
name := self nameOfClass: classOop.
nameLen = 10 ifTrue:
[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
[^self printChar: $'; printStringOf: oop; printChar: $'].
(self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
[self printChar: $#; printStringOf: oop. ^self]].
(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
[^self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))].
self print: 'a(n) '.
self
cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]
inSmalltalk:
[name isString
ifTrue: [self print: name]
ifFalse: [0 to: nameLen - 1 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: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
self printHexnp: oop.
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[self
cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
(objectMemory isIntegerObject: oop) ifTrue:
[self
cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
^self].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop]); cr].
- ifFalse: [' is not on the heap']); cr].
((objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]) ifTrue:
[^self printOop: oop].
self print: ': a(n) '.
self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
self cr!
Item was added:
+ ----- Method: StackInterpreter>>whereIs: (in category 'debug printing') -----
+ whereIs: anOop
+ <api>
+ <returnTypeC: 'char *'>
+ <inline: false>
+ <var: 'where' type: #'char *'>
+ (objectMemory whereIsMaybeHeapThing: anOop) ifNotNil: [:where| ^where].
+ (stackPages whereIsMaybeStackThing: anOop) ifNotNil: [:where| ^where].
+ ^' is no where obvious'!
Item was changed:
----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^(objectMemory characterValueOf: oop) < 256
ifTrue:
['=$' , (objectMemory characterValueOf: oop) printString ,
' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
ifFalse:
['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [self whereIs: oop]].
- ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
classOop ifNil: [^' has a nil class!!!!'].
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
Item was changed:
----- Method: TMethod>>isSubstitutableNode:intoMethod:in: (in category 'inlining') -----
isSubstitutableNode: aNode intoMethod: targetMeth in: aCodeGen
"Answer true if the given parameter node is either a constant, a local variable, or a formal parameter of the receiver. Such parameter nodes may be substituted directly into the body of the method during inlining. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument."
| var |
aNode isConstant ifTrue: [ ^ true ].
aNode isVariable ifTrue: [
var := aNode name.
((locals includes: var) or: [args includes: var]) ifTrue: [ ^ true ].
(#(self true false nil) includes: var) ifTrue: [ ^ true ].
(targetMeth maySubstituteGlobal: var in: aCodeGen) ifTrue: [ ^ true ].
].
"For now allow literal blocks to be substituted. They better be accessed only
with value[:value:*] messages though!!"
aNode isStmtList ifTrue: [^true].
+ (aNode isSend
+ and: [aNode numArgs = 0
+ and: [aNode isStructSendIn: aCodeGen]]) ifTrue:
+ [^true].
+
"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
aNode nodesDo: [ :node |
node isSend ifTrue: [
node isBuiltinOperator ifFalse: [ ^false ].
].
node isVariable ifTrue: [
var := node name.
((locals includes: var) or:
[(args includes: var) or:
[(#(self true false nil) includes: var) or:
[targetMeth maySubstituteGlobal: var in: aCodeGen]]]) ifFalse: [ ^ false ].
].
(node isConstant or: [node isVariable or: [node isSend]]) ifFalse: [ ^false ].
].
^ true!
Item was added:
+ ----- Method: TSendNode>>numArgs (in category 'accessing') -----
+ numArgs
+ ^arguments size!
Item was changed:
----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') -----
shouldExcludeReceiverAsFirstArgument: aCodeGen
"Only include the receiver as the first argument in certain cases.
The receiver is always included if it is an expression.
If it is a variable:
If the vmClass says it is an implicit variable, don't include it.
If the method's definingClass says it is an implicit variable, don't include it.
If the variable is 'self' and the method being called is not in
the method set (i.e. it is some external code), don't include it.
If it is a struct send of something the vm says is an implicit variable, don't include it."
| m |
(aCodeGen isAssertSelector: selector) ifTrue:
[^true].
(receiver isSend
and: [receiver receiver isVariable
and: [(self isSelfReference: receiver receiver in: aCodeGen)
or: [self isStructReference: receiver receiver in: aCodeGen]]]) ifTrue:
[^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector].
^receiver isVariable
and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name)
or: [(self isSelfReference: receiver in: aCodeGen)
and: [(m := aCodeGen methodNamed: selector) isNil
+ or: [#(implicit nil) includes: m typeForSelf]]]]!
- or: [m typeForSelf == #implicit]]]]!
More information about the Vm-dev
mailing list