[Vm-dev] VM Maker: VMMaker.oscog-eem.830.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jul 21 17:38:30 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.830.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.830
Author: eem
Time: 21 July 2014, 7:35:48.335 am
UUID: ad7e3584-5924-4500-be7c-ea7ebac3f71c
Ancestors: VMMaker.oscog-eem.829
Revise markAndTrace: given that markAndShouldScan: is
inlined within it (see Slang changes below). Move the
ephemeron processing into markAndShouldScan: out of
the now unused numStringSlotsOf:ephemeronInactiveIf:
circumlocution. Add activeAndDeferredScan: and
numStrongSlotsOfInephemeral: in place of the double
negative inactiveOrFailedToDeferScan: and hence inline
numStrongSlotsOfInephemeral:.
Increase the traceImmediatelySlotLimit. These changes
plus the 2 repeats for compaction speed up global GC
by at least x2.
In the wake of the inlining changes below, split
lookupInMethodCacheSel:classTag: into it and
inlineLookupInMethodCacheSel:classTag:, and use the inline
version in internalFindNewMethod.
Slang:
Add support for inlining into the condition of ifTrue:/ifFalse:
when it is marked as inline. Transform
expr1 ifTrue:/ifFalse: [^expr2]
by inlining ^expr2 into expr1. Transform
expr ifTrue:/ifFalse: [statements]
by replacing ^boolean occurrences in expr with gotos.
=============== Diff against VMMaker.oscog-eem.829 ===============
Item was changed:
----- Method: CoInterpreter>>internalFindNewMethod (in category 'message sending') -----
internalFindNewMethod
"Find the compiled method to be run when the current messageSelector is
sent to the given class, setting the values of newMethod and primitiveIndex."
| ok |
<inline: true>
+ ok := self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
- ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
ok ifTrue:
[self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
ifFalse:
[self externalizeIPandSP.
((objectMemory isOopForwarded: messageSelector)
or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue:
[(objectMemory isOopForwarded: messageSelector) ifTrue:
[messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
(objectMemory isForwardedClassTag: lkupClassTag) ifTrue:
[lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag].
+ (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue:
- ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
- ok ifTrue:
[^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]].
lkupClass := objectMemory classForClassTag: lkupClassTag.
self lookupMethodInClass: lkupClass.
self internalizeIPandSP.
self addNewMethodToCache: lkupClass]!
Item was changed:
----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initializing') -----
setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
"Initialize this method using the given information."
selector := sel.
definingClass := class.
returnType := #sqInt. "assume return type is sqInt for now"
args := argList asOrderedCollection collect: [:arg | arg key].
locals := (localList collect: [:arg | arg key]) asSet.
declarations := Dictionary new.
primitive := aNumber.
properties := methodProperties.
comment := aComment.
parseTree := aBlockNode asTranslatorNodeIn: self.
+ labels := Set new.
- labels := OrderedCollection new.
complete := false. "set to true when all possible inlining has been done"
export := self extractExportDirective.
static := self extractStaticDirective.
canAsmLabel := self extractLabelDirective.
self extractSharedCase.
isPrimitive := false. "set to true only if you find a primtive direction."
suppressingFailureGuards := self extractSuppressFailureGuardDirective.
self recordDeclarationsIn: nil.
self extractPrimitiveDirectives.
!
Item was added:
+ ----- Method: SpurMemoryManager>>activeAndDeferredScan: (in category 'weakness and ephemerality') -----
+ activeAndDeferredScan: anEphemeron
+ "Answer whether an ephemeron is active (has an unmarked
+ key) and was pushed on the unscanned ephemerons stack."
+ | key |
+ <inline: #never>
+ self assert: (self isEphemeron: anEphemeron).
+ ((self isImmediate: (key := self keyOfEphemeron: anEphemeron))
+ or: [self isMarked: key]) ifTrue:
+ [^false].
+ ^self pushOnUnscannedEphemeronsStack: anEphemeron!
Item was changed:
----- Method: SpurMemoryManager>>fixFollowedField:ofObject:withInitialValue: (in category 'forwarding') -----
fixFollowedField: fieldIndex ofObject: anObject withInitialValue: initialValue
"Private helper for followField:ofObject: to avoid code duplication for rare case."
+ <inline: #never>
- <inline: false>
| objOop |
self assert: (self isOopForwarded: initialValue).
objOop := self followForwarded: initialValue.
self storePointer: fieldIndex ofObject: anObject withValue: objOop.
^objOop!
Item was changed:
----- Method: SpurMemoryManager>>markAndShouldScan: (in category 'gc - global') -----
markAndShouldScan: objOop
+ "Helper for markAndTrace:.
+ Mark the argument, and answer if its fields should be scanned now.
- "Mark the argument, and answer if its fields should be scanned now.
Immediate objects don't need to be marked.
Already marked objects have already been processed.
Pure bits objects don't need scanning, although their class does.
Weak objects should be pushed on the weakling stack.
Anything else need scanning."
| format |
+ <inline: true>
(self isImmediate: objOop) ifTrue:
[^false].
+ "if markAndTrace: is to follow and eliminate forwarding pointers
+ in its scan it cannot be handed an r-value which is forwarded."
self assert: (self isForwarded: objOop) not.
(self isMarked: objOop) ifTrue:
[^false].
self setIsMarkedOf: objOop to: true.
format := self formatOf: objOop.
(self isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack"
[self markAndTraceClassOf: objOop.
^false].
format = self weakArrayFormat ifTrue: "push weaklings on the weakling stack to scan later"
[self push: objOop onObjStack: weaklingStack.
^false].
+ (format = self ephemeronFormat
+ and: [self activeAndDeferredScan: objOop]) ifTrue:
+ [^false].
^true!
Item was changed:
----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') -----
markAndTrace: objOop
"Mark the argument, and all objects reachable from it, and any remaining objects
on the mark stack. Follow forwarding pointers in the scan."
<api>
+ | objToScan scanLargeObject numStrongSlots index field |
+ "if markAndTrace: is to follow and eliminate forwarding pointers
+ in its scan it cannot be handed an r-value which is forwarded.
+ The assert for this is in markAndShouldScan:"
- | objToScan numStrongSlots index field |
(self markAndShouldScan: objOop) ifFalse:
[^self].
- "if markAndTrace: is to follow and eliminate forwarding pointers
- in its scan it cannot be handed an r-value which is forwarded."
- self assert: (self isForwarded: objOop) not.
"Now scan the object, and any remaining objects on the mark stack."
objToScan := objOop.
"To avoid overflowing the mark stack when we encounter large objects, we
push the obj, then its numStrongSlots, and then index the object from the stack."
+ [(self isImmediate: objToScan)
+ ifTrue: [scanLargeObject := true]
+ ifFalse:
+ [numStrongSlots := self numStrongSlotsOfInephemeral: objToScan.
+ scanLargeObject := numStrongSlots > self traceImmediatelySlotLimit].
+ scanLargeObject
- [((self isImmediate: objToScan)
- or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
- numStrongSlots > self traceImmediatelySlotLimit])
ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any."
[(self isImmediate: objToScan)
ifTrue:
[index := self integerValueOf: objToScan.
objToScan := self topOfObjStack: markStack]
ifFalse:
[index := numStrongSlots.
self markAndTraceClassOf: objToScan].
[index > 0] whileTrue:
[index := index - 1.
field := self fetchPointer: index ofObject: objToScan.
+ (self isNonImmediate: field) ifTrue:
+ [(self isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined"
+ [field := self fixFollowedField: index ofObject: objToScan withInitialValue: field].
+ (self markAndShouldScan: field) ifTrue:
+ [index > 0 ifTrue:
+ [(self topOfObjStack: markStack) ~= objToScan ifTrue:
+ [self push: objToScan onObjStack: markStack].
+ self push: (self integerObjectOf: index) onObjStack: markStack].
+ objToScan := field.
+ index := -1]]].
- (self isOopForwarded: field) ifTrue:
- [field := self followForwarded: field.
- self storePointer: index ofObject: objToScan withValue: field].
- (self markAndShouldScan: field) ifTrue:
- [index > 0 ifTrue:
- [(self topOfObjStack: markStack) ~= objToScan ifTrue:
- [self push: objToScan onObjStack: markStack].
- self push: (self integerObjectOf: index) onObjStack: markStack].
- objToScan := field.
- index := -1]].
index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack."
[objToScan := self popObjStack: markStack.
objToScan = objOop ifTrue:
[objToScan := self popObjStack: markStack]]]
ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack."
[index := numStrongSlots.
self markAndTraceClassOf: objToScan.
[index > 0] whileTrue:
[index := index - 1.
field := self fetchPointer: index ofObject: objToScan.
+ (self isNonImmediate: field) ifTrue:
+ [(self isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined"
+ [field := self fixFollowedField: index ofObject: objToScan withInitialValue: field].
+ (self markAndShouldScan: field) ifTrue:
+ [self push: field onObjStack: markStack.
+ ((self rawNumSlotsOf: field) > self traceImmediatelySlotLimit
+ and: [(numStrongSlots := self numStrongSlotsOfInephemeral: field) > self traceImmediatelySlotLimit]) ifTrue:
+ [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]].
- (self isOopForwarded: field) ifTrue:
- [field := self followForwarded: field.
- self storePointer: index ofObject: objToScan withValue: field].
- (self markAndShouldScan: field) ifTrue:
- [self push: field onObjStack: markStack.
- numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
- numStrongSlots > self traceImmediatelySlotLimit ifTrue:
- [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]].
objToScan := self popObjStack: markStack].
objToScan notNil] whileTrue!
Item was removed:
- ----- Method: SpurMemoryManager>>numStrongSlotsOf:ephemeronInactiveIf: (in category 'object access') -----
- numStrongSlotsOf: objOop ephemeronInactiveIf: criterion
- "Answer the number of strong pointer fields in the given object.
- Works with CompiledMethods, as well as ordinary objects."
- <var: 'criterion' declareC: 'int (*criterion)(sqInt key)'>
- <inline: true>
- <asmLabel: false>
- | fmt |
- fmt := self formatOf: objOop.
- ^self numStrongSlotsOf: objOop format: (self formatOf: objOop) ephemeronInactiveIf: criterion!
Item was added:
+ ----- Method: SpurMemoryManager>>numStrongSlotsOfInephemeral: (in category 'object access') -----
+ numStrongSlotsOfInephemeral: objOop
+ "Answer the number of strong pointer fields in the given object,
+ which is .expected not to be an active ephemeron.
+ Works with CompiledMethods, as well as ordinary objects."
+ <inline: true>
+ <asmLabel: false>
+ | fmt numSlots contextSize numLiterals |
+ fmt := self formatOf: objOop.
+ self assert: (fmt ~= self ephemeronFormat or: [self isMarked: (self keyOfEphemeron: objOop)]).
+ fmt <= self lastPointerFormat ifTrue:
+ [numSlots := self numSlotsOf: objOop.
+ fmt <= self arrayFormat ifTrue:
+ [^numSlots].
+ fmt = self indexablePointersFormat ifTrue:
+ [(self isContextNonImm: objOop) ifTrue:
+ [coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: objOop.
+ "contexts end at the stack pointer"
+ contextSize := coInterpreter fetchStackPointerOf: objOop.
+ ^CtxtTempFrameStart + contextSize].
+ ^numSlots].
+ fmt = self weakArrayFormat ifTrue:
+ [^self fixedFieldsOfClass: (self fetchClassOfNonImm: objOop)]].
+ fmt = self forwardedFormat ifTrue: [^1].
+ fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
+
+ "CompiledMethod: contains both pointers and bytes"
+ numLiterals := coInterpreter literalCountOf: objOop.
+ ^numLiterals + LiteralStart!
Item was changed:
----- Method: SpurMemoryManager>>traceImmediatelySlotLimit (in category 'gc - global') -----
traceImmediatelySlotLimit
"Arbitrary level at which to defer tracing large objects until later.
+ The average slot size of Smalltalk objects is typically near 8.
+ We do require traceImmediatelySlotLimit to be < numSlotsMask."
+ ^64!
- The average slot size of Smalltalk objects is typically near 8."
- ^16!
Item was added:
+ ----- Method: StackInterpreter>>inlineLookupInMethodCacheSel:classTag: (in category 'method lookup cache') -----
+ inlineLookupInMethodCacheSel: selector classTag: classTag
+ "This method implements a simple method lookup cache. If an entry for the given selector and classTag is
+ found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and answer true. Otherwise,
+ answer false."
+ "About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless
+ lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe,
+ introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up."
+ "WARNING: Since the hash computation is based on the object addresses of the class and selector, we must
+ rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating
+ the addresses of the objects in the cache."
+ "classTag is either a class object, if using NewObjectMemory, or a classIndex, if using SpurMemoryManager."
+
+ | hash probe |
+ <inline: true>
+ <asmLabel: false>
+ hash := selector bitXor: classTag. "shift drops two low-order zeros from addresses"
+
+ probe := hash bitAnd: MethodCacheMask. "first probe"
+ (((methodCache at: probe + MethodCacheSelector) = selector) and:
+ [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
+ [newMethod := methodCache at: probe + MethodCacheMethod.
+ primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
+ to: #'void (*)()'.
+ ^true "found entry in cache; done"].
+
+ probe := (hash >> 1) bitAnd: MethodCacheMask. "second probe"
+ (((methodCache at: probe + MethodCacheSelector) = selector) and:
+ [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
+ [newMethod := methodCache at: probe + MethodCacheMethod.
+ primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
+ to: #'void (*)()'.
+ ^true "found entry in cache; done"].
+
+ probe := (hash >> 2) bitAnd: MethodCacheMask.
+ (((methodCache at: probe + MethodCacheSelector) = selector) and:
+ [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
+ [newMethod := methodCache at: probe + MethodCacheMethod.
+ primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
+ to: #'void (*)()'.
+ ^true "found entry in cache; done"].
+
+ ^false!
Item was changed:
----- Method: StackInterpreter>>internalFindNewMethod (in category 'message sending') -----
internalFindNewMethod
"Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'."
- | ok |
<inline: true>
+ (self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
+ ["entry was not found in the cache; look it up the hard way"
+ self externalizeIPandSP.
- ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
- ok ifFalse: "entry was not found in the cache; look it up the hard way"
- [self externalizeIPandSP.
((objectMemory isOopForwarded: messageSelector)
or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue:
[(objectMemory isOopForwarded: messageSelector) ifTrue:
[messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
(objectMemory isForwardedClassTag: lkupClassTag) ifTrue:
[lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag].
+ (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue:
- ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
- ok ifTrue:
[^nil]].
lkupClass := objectMemory classForClassTag: lkupClassTag.
self lookupMethodInClass: lkupClass.
self internalizeIPandSP.
self addNewMethodToCache: lkupClass]!
Item was changed:
----- Method: StackInterpreter>>lookupInMethodCacheSel:classTag: (in category 'method lookup cache') -----
lookupInMethodCacheSel: selector classTag: classTag
+ "This method implements a simple method lookup cache. If an entry for the given
+ selector and classTag is found in the cache, set the values of 'newMethod' and
+ 'primitiveFunctionPointer' and answer true. Otherwise, answer false."
+ <inline: false>
+ ^self inlineLookupInMethodCacheSel: selector classTag: classTag!
- "This method implements a simple method lookup cache. If an entry for the given selector and classTag is
- found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and answer true. Otherwise,
- answer false."
- "About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless
- lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe,
- introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up."
- "WARNING: Since the hash computation is based on the object addresses of the class and selector, we must
- rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating
- the addresses of the objects in the cache."
- "classTag is either a class object, if using NewObjectMemory, or a classIndex, if using SpurMemoryManager."
-
- | hash probe |
- <inline: true>
- <asmLabel: false>
- hash := selector bitXor: classTag. "shift drops two low-order zeros from addresses"
-
- probe := hash bitAnd: MethodCacheMask. "first probe"
- (((methodCache at: probe + MethodCacheSelector) = selector) and:
- [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
- [newMethod := methodCache at: probe + MethodCacheMethod.
- primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
- to: #'void (*)()'.
- ^true "found entry in cache; done"].
-
- probe := (hash >> 1) bitAnd: MethodCacheMask. "second probe"
- (((methodCache at: probe + MethodCacheSelector) = selector) and:
- [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
- [newMethod := methodCache at: probe + MethodCacheMethod.
- primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
- to: #'void (*)()'.
- ^true "found entry in cache; done"].
-
- probe := (hash >> 2) bitAnd: MethodCacheMask.
- (((methodCache at: probe + MethodCacheSelector) = selector) and:
- [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
- [newMethod := methodCache at: probe + MethodCacheMethod.
- primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
- to: #'void (*)()'.
- ^true "found entry in cache; done"].
-
- ^false!
Item was changed:
----- Method: StackInterpreter>>lookupMethodNoMNUEtcInClass: (in category 'callback support') -----
lookupMethodNoMNUEtcInClass: class
"Lookup messageSelector in class. Answer 0 on success. Answer the splObj: index
for the error selector to use on failure rather than performing MNU processing etc."
| currentClass dictionary |
+ <inline: false>
- <inline: true>
currentClass := class.
[currentClass ~= objectMemory nilObject] whileTrue:
[dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
dictionary = objectMemory nilObject ifTrue:
[lkupClass := self superclassOf: currentClass.
^SelectorCannotInterpret].
(self lookupMethodInDictionary: dictionary) ifTrue:
[self addNewMethodToCache: class.
^0].
currentClass := self superclassOf: currentClass].
lkupClass := class.
^SelectorDoesNotUnderstand!
Item was changed:
----- Method: TLabeledCommentNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream level: level generator: aCodeGen
"Emit a C comment with optional label."
self printOptionalLabelOn: aStream.
+ comment ifNotNil:
+ [aStream nextPutAll: '/* '.
+ aStream nextPutAll: comment.
+ aStream nextPutAll: ' */'].
- aStream nextPutAll: '/* '.
- aStream nextPutAll: comment.
- aStream nextPutAll: ' */'.
(asmLabel notNil "only output labels in the interpret function."
and: [aCodeGen currentMethod selector == #interpret]) ifTrue:
[aStream crtab: level.
aCodeGen outputAsmLabel: asmLabel on: aStream]!
Item was changed:
----- Method: TLabeledCommentNode>>printOn:level: (in category 'printing') -----
printOn: aStream level: level
self printOptionalLabelOn: aStream.
+ comment ifNotNil:
+ [aStream nextPut: $".
+ aStream nextPutAll: comment.
+ aStream nextPut: $"]!
- aStream nextPut: $".
- aStream nextPutAll: comment.
- aStream nextPut: $".!
Item was added:
+ ----- Method: TMethod>>inlineBuiltin:in: (in category 'inlining') -----
+ inlineBuiltin: aSendNode in: aCodeGen
+ | sel meth inlinedReplacement |
+ (aSendNode selector beginsWith: 'perform:') ifTrue:
+ [^self inlineFunctionCall: aSendNode asTransformedConstantPerform in: aCodeGen].
+ sel := aSendNode receiver selector.
+ meth := aCodeGen methodNamed: sel.
+ (meth notNil and: [meth inline == true]) ifFalse: [^nil].
+ meth isFunctional ifTrue:
+ [inlinedReplacement := (aCodeGen methodNamed: aSendNode receiver selector) copy
+ inlineFunctionCall: aSendNode receiver
+ in: aCodeGen.
+ ^TSendNode new
+ setSelector: aSendNode selector
+ receiver: inlinedReplacement
+ arguments: aSendNode args copy].
+ (self isInlineableConditional: aSendNode in: aCodeGen) ifTrue:
+ [^self inlineConditional: aSendNode in: aCodeGen].
+ ^nil!
Item was added:
+ ----- Method: TMethod>>inlineConditional:in: (in category 'inlining') -----
+ inlineConditional: aSendNode in: aCodeGen
+ "If possible answer the inlining of a conditional, otherwise answer nil.
+ Currently the only pattern we support is
+ aSend ifTrue:/ifFalse: [...]
+ where aSend is marked inline and always answers booleans."
+ self assert: (self isInlineableConditional: aSendNode in: aCodeGen).
+ self assert: aSendNode args first isStmtList.
+ ^(aSendNode args first statements size = 1
+ and: [aSendNode args first statements first isReturn])
+ ifTrue: [self inlineReturningConditional: aSendNode in: aCodeGen]
+ ifFalse: [self inlineGuardingConditional: aSendNode in: aCodeGen]!
Item was changed:
----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') -----
inlineFunctionCall: aSendNode in: aCodeGen
"Answer the body of the called function, substituting the actual
parameters for the formal argument variables in the method body.
Assume caller has established that:
1. the method arguments are all substitutable nodes, and
2. the method to be inlined contains no additional embedded returns."
| sel meth doNotRename argsForInlining substitutionDict |
sel := aSendNode selector.
meth := (aCodeGen methodNamed: sel) copy.
+ meth ifNil:
+ [^self inlineBuiltin: aSendNode in: aCodeGen].
- (meth isNil and: [sel beginsWith: 'perform:']) ifTrue:
- [^self inlineFunctionCall: aSendNode asTransformedConstantPerform in: aCodeGen].
doNotRename := Set withAll: args.
argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen.
meth args with: argsForInlining do:
[ :argName :exprNode |
exprNode isLeaf ifTrue:
[doNotRename add: argName]].
(meth statements size = 2
and: [meth statements first isSend
and: [meth statements first selector == #flag:]]) ifTrue:
[meth statements removeFirst].
meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen.
meth renameLabelsForInliningInto: self.
self addVarsDeclarationsAndLabelsOf: meth except: doNotRename.
substitutionDict := Dictionary new: meth args size * 2.
meth args with: argsForInlining do:
[ :argName :exprNode |
substitutionDict at: argName put: exprNode.
(doNotRename includes: argName) ifFalse:
[locals remove: argName]].
meth parseTree bindVariablesIn: substitutionDict.
+ ^meth statements first isReturn
+ ifTrue: [meth statements first expression]
+ ifFalse: [meth parseTree]!
- ^meth statements first expression!
Item was added:
+ ----- Method: TMethod>>inlineGuardingConditional:in: (in category 'inlining') -----
+ inlineGuardingConditional: aSendNode in: aCodeGen
+ "Inline
+ aSend ifTrue:/ifFalse: [statements]
+ where aSend is inlineable and always answers booleans. We convert
+ the boolean returns in aSend to jumps."
+ | evaluateIfTrue replacementTree map lastNode evaluateLabel skipLabel method |
+ self assert: self == aCodeGen currentMethod.
+ self assert: (self isInlineableConditional: aSendNode in: aCodeGen).
+ self maybeBreakFor: aSendNode receiver in: aCodeGen.
+ evaluateIfTrue := aSendNode selector = #ifTrue:.
+ method := (aCodeGen methodNamed: aSendNode receiver selector) copy.
+ replacementTree := method inlineFunctionCall: aSendNode receiver in: aCodeGen.
+ map := Dictionary new.
+ (replacementTree statements last isReturn
+ and: [replacementTree statements last expression value = evaluateIfTrue]) ifTrue:
+ [lastNode := replacementTree statements last].
+ skipLabel := TLabeledCommentNode new setLabel:
+ (self unusedLabelForInlining: method).
+ replacementTree nodesDo:
+ [:node| | expr |
+ node isReturn ifTrue:
+ [expr := node expression.
+ self assert: (expr isConstant and: [#(true false) includes: expr value]).
+ map
+ at: node
+ put: (expr value ~~ evaluateIfTrue
+ ifTrue: [TGoToNode new setLabel: skipLabel label]
+ ifFalse:
+ [node == lastNode
+ ifTrue: [TLabeledCommentNode new setComment: 'end ', aSendNode receiver selector, '; fall through']
+ ifFalse:
+ [evaluateLabel ifNil:
+ [evaluateLabel := TLabeledCommentNode new setLabel:
+ (self unusedLabelForInlining: method)].
+ TGoToNode new setLabel: evaluateLabel label]])]].
+ replacementTree replaceNodesIn: map.
+ replacementTree comment: {'inline ', aSendNode receiver selector}.
+ self addVarsDeclarationsAndLabelsOf: method except: method args.
+ ^TStmtListNode new
+ setArguments: #()
+ statements:
+ (evaluateLabel
+ ifNil: [replacementTree statements, aSendNode args first statements, {skipLabel}]
+ ifNotNil:
+ [replacementTree statements, {evaluateLabel}, aSendNode args first statements, {skipLabel}])!
Item was added:
+ ----- Method: TMethod>>inlineReturningConditional:in: (in category 'inlining') -----
+ inlineReturningConditional: aSendNode in: aCodeGen
+ "Inline
+ aSend ifTrue:/ifFalse: [^expr]
+ where aSend is inlineable and always answers booleans. We inline ^expr
+ into aSend."
+ | returnIfTrue returnNode replacementTree map lastNode label method |
+ self assert: self == aCodeGen currentMethod.
+ self assert: (self isInlineableConditional: aSendNode in: aCodeGen).
+ self maybeBreakFor: aSendNode receiver in: aCodeGen.
+ returnIfTrue := aSendNode selector = #ifTrue:.
+ returnNode := aSendNode args first.
+ method := (aCodeGen methodNamed: aSendNode receiver selector) copy.
+ replacementTree := method inlineFunctionCall: aSendNode receiver in: aCodeGen.
+ map := Dictionary new.
+ (replacementTree statements last isReturn
+ and: [replacementTree statements last expression value = returnIfTrue not]) ifTrue:
+ [lastNode := replacementTree statements last].
+ replacementTree nodesDo:
+ [:node| | expr |
+ node isReturn ifTrue:
+ [expr := node expression.
+ self assert: (expr isConstant and: [#(true false) includes: expr value]).
+ map
+ at: node
+ put: (expr value == returnIfTrue
+ ifTrue: [returnNode]
+ ifFalse:
+ [node == lastNode
+ ifTrue: [TLabeledCommentNode new setComment: 'end ', aSendNode receiver selector, '; fall through']
+ ifFalse:
+ [label ifNil:
+ [label := TLabeledCommentNode new setLabel:
+ (self unusedLabelForInlining: method)].
+ TGoToNode new setLabel: label label]])]].
+ replacementTree replaceNodesIn: map.
+ self addVarsDeclarationsAndLabelsOf: method except: method args.
+ replacementTree comment: {'inline ', aSendNode receiver selector}.
+ ^label
+ ifNil: [replacementTree]
+ ifNotNil:
+ [TStmtListNode new
+ setArguments: #()
+ statements: {replacementTree. label}]!
Item was changed:
----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') -----
inlineableFunctionCall: aNode in: aCodeGen
"Answer true if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted."
self maybeBreakFor: aNode in: aCodeGen.
+ aNode isSend ifFalse:
+ [^false].
+ ^(aCodeGen methodNamed: aNode selector)
+ ifNil:
+ [aNode asTransformedConstantPerform
+ ifNil: [self isInlineableConditional: aNode in: aCodeGen]
+ ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]]
+ ifNotNil:
+ [:m|
+ m ~~ self
+ and: [m isFunctional
+ and: [(aCodeGen mayInline: m selector)
+ and: [aNode args allSatisfy: [ :a | self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]!
- ^aNode isSend
- and: [(aCodeGen methodNamed: aNode selector)
- ifNil:
- [aNode asTransformedConstantPerform
- ifNil: [false]
- ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]]
- ifNotNil:
- [:m|
- m ~~ self
- and: [m isFunctional
- and: [(aCodeGen mayInline: m selector)
- and: [aNode args allSatisfy: [ :a | self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]]!
Item was added:
+ ----- Method: TMethod>>isInlineableConditional:in: (in category 'inlining') -----
+ isInlineableConditional: aSendNode in: aCodeGen
+ "Answer if the given send node is of the form aSend [ifTrue:|ifFalse:] [statements]
+ where the method for aSend is marked as inline and all returns within it answer booleans."
+ |method |
+ ^(#(ifTrue: ifFalse:) includes: aSendNode selector)
+ and: [aSendNode receiver isSend
+ and: [(method := aCodeGen methodNamed: aSendNode receiver selector) notNil
+ and: [method inline == true
+ and: [method parseTree statements last isReturn
+ and: [method parseTree allSatisfy:
+ [:node|
+ node isReturn not
+ or: [node expression isConstant
+ and: [#(true false) includes: node expression value]]]]]]]]!
Item was changed:
----- Method: TMethod>>labels: (in category 'accessing') -----
labels: aCollection
+ labels := aCollection asSet!
- labels := aCollection isSequenceable
- ifTrue: [aCollection asOrderedCollection]
- ifFalse: [aCollection asSortedCollection asOrderedCollection]!
Item was changed:
----- Method: TMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') -----
setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
"Initialize this method using the given information."
selector := sel.
definingClass := class.
args := argList asOrderedCollection collect: [:arg | arg key].
locals := (localList collect: [:arg | arg key]) asSet.
declarations := Dictionary new.
self addTypeForSelf.
primitive := aNumber.
properties := methodProperties.
comment := aComment.
parseTree := aBlockNode. "hack; allows nodes to find their parent, etc"
parseTree := aBlockNode asTranslatorNodeIn: self.
+ labels := Set new.
- labels := OrderedCollection new.
complete := false. "set to true when all possible inlining has been done"
export := self extractExportDirective.
static := self extractStaticDirective.
canAsmLabel := self extractLabelDirective.
self extractSharedCase.
globalStructureBuildMethodHasFoo := false!
Item was changed:
----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
tryToInlineMethodsIn: aCodeGen
"Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
| stmtLists didSomething newStatements sendsToInline |
self definedAsMacro ifTrue:
[complete := true.
^false].
didSomething := false.
sendsToInline := Dictionary new: 100.
parseTree
nodesDo:
[:node|
(self inlineableFunctionCall: node in: aCodeGen) ifTrue:
+ [(self inlineFunctionCall: node in: aCodeGen) ifNotNil:
+ [:replacement|
+ sendsToInline at: node put: replacement]]]
- [sendsToInline at: node put: (self inlineFunctionCall: node in: aCodeGen)]]
unless: "Don't inline the arguments to asserts to keep the asserts readable"
[:node|
node isSend
and: [node selector == #cCode:inSmalltalk:
or: [aCodeGen isAssertSelector: node selector]]].
sendsToInline isEmpty ifFalse:
[didSomething := true.
parseTree := parseTree replaceNodesIn: sendsToInline].
didSomething ifTrue:
[writtenToGlobalVarsCache := nil.
^didSomething].
stmtLists := self statementsListsForInliningIn: aCodeGen.
stmtLists do:
[:stmtList|
newStatements := OrderedCollection new: 100.
stmtList statements do:
[:stmt|
(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
ifNil: [newStatements addLast: stmt]
ifNotNil: [:inlinedStmts|
didSomething := true.
newStatements addAllLast: inlinedStmts]].
stmtList setStatements: newStatements asArray].
didSomething ifTrue:
[writtenToGlobalVarsCache := nil.
^didSomething].
complete ifFalse:
[self checkForCompleteness: stmtLists in: aCodeGen.
complete ifTrue: [ didSomething := true ]]. "marking a method complete is progress"
^didSomething!
Item was added:
+ ----- Method: TMethod>>unusedLabelForInlining: (in category 'inlining') -----
+ unusedLabelForInlining: sourceMethod
+ ^labels add: (self unusedLabelForInliningInto: sourceMethod)!
Item was changed:
----- Method: TMethod>>unusedLabelForInliningInto: (in category 'inlining') -----
unusedLabelForInliningInto: targetMethod
| usedLabels |
+ usedLabels := labels copy.
- usedLabels := labels asSet.
usedLabels addAll: targetMethod labels.
^self unusedNamePrefixedBy: 'l' avoiding: usedLabels!
Item was changed:
----- Method: TStmtListNode>>emitCCodeOn:prependToEnd:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen
self emitCCommentOn: aStream level: level.
statements withIndexDo:
[:s :idx|
+ s isStmtList ifFalse:
+ [s emitCCommentOn: aStream level: level].
- s emitCCommentOn: aStream level: level.
aStream peekLast ~~ Character tab ifTrue:
[aStream tab: level].
(aNodeOrNil notNil
and: [idx = statements size])
ifTrue:
[s emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen]
ifFalse:
[s emitCCodeOn: aStream level: level generator: aCodeGen].
(self stream: aStream endsWithAnyOf: '};') ifFalse:
[s needsTrailingSemicolon ifTrue:
[aStream nextPut: $;]].
aStream cr].
!
More information about the Vm-dev
mailing list