[Vm-dev] VM Maker: VMMaker.oscog-eem.2040.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 15 21:25:03 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2040.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2040
Author: eem
Time: 15 December 2016, 1:24:23.427888 pm
UUID: 5c1c9278-c66a-4508-8b7c-fb1b0c8b3e46
Ancestors: VMMaker.oscog-eem.2039
ThreadedX64SysVFFIPlugin
Fix regression due to faulty merge.
Slang:
Make functional methods that start with an assert inlineable and hence4 make isSmallFloatZero: inlineable, given that it is marked <inline: #always>. To this end:
Refactor tryToInlineMethodsIn: into tryToInlineMethodsIn:, tryToInlineMethodExpressionsIn: & tryToInlineMethodStatementsIn:statementListsInto:.
Choose to apply tryToInlineMethodStatementsIn:statementListsInto: first (reversing the order of the previous tryToInlineMethodExpressionsIn:) because doing so creates less methods with long comma-chained expressions, which IME can be a source of C compiler bugs.
Add a check for failure to inline <inline: #always> methods.
Fix TAssignmentNode>>emitCCodeAsExpressionOn:level:generator:
StackInterpreter:
Remove nsMethodCache in non NewspeakVMs.
=============== Diff against VMMaker.oscog-eem.2039 ===============
Item was changed:
----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
| vmClass |
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
aCCodeGenerator
addHeaderFile:'<stddef.h> /* for e.g. alloca */';
addHeaderFile:'<setjmp.h>';
addHeaderFile:'<wchar.h> /* for wint_t */';
addHeaderFile:'"vmCallback.h"';
addHeaderFile:'"sqMemoryFence.h"';
addHeaderFile:'"dispdbg.h"'.
LowcodeVM ifTrue: [ aCCodeGenerator addHeaderFile:'"sqLowcodeFFI.h"'].
vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
aCCodeGenerator
var: #interpreterProxy type: #'struct VirtualMachine*'.
aCCodeGenerator
declareVar: #sendTrace type: 'volatile int';
declareVar: #byteCount type: #usqInt.
"These need to be pointers or unsigned."
self declareC: #(instructionPointer method newMethod)
as: #usqInt
in: aCCodeGenerator.
"These are all pointers; char * because Slang has no support for C pointer arithmetic."
self declareC: #(localIP localSP localFP nativeSP stackPointer framePointer stackLimit breakSelector nativeStackPointer nativeFramePointer shadowCallStack)
as: #'char *'
in: aCCodeGenerator.
aCCodeGenerator
var: #breakSelectorLength
declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
self declareC: #(stackPage overflowedPage)
as: #'StackPage *'
in: aCCodeGenerator.
aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code."
- NewspeakVM ifFalse:
- [aCCodeGenerator
- removeVariable: 'localAbsentReceiver';
- removeVariable: 'localAbsentReceiverOrZero';
- removeVariable: 'nsMethodCache'].
"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
is not defined, for the benefit of the interpreter on slow machines."
aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
MULTIPLEBYTECODESETS == false ifTrue:
[aCCodeGenerator
removeVariable: 'bytecodeSetSelector'].
BytecodeSetHasExtensions == false ifTrue:
[aCCodeGenerator
removeVariable: 'extA';
removeVariable: 'extB'].
aCCodeGenerator
var: #methodCache
declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
+ NewspeakVM
+ ifTrue:
+ [aCCodeGenerator
+ var: #nsMethodCache
+ declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
+ ifFalse:
+ [aCCodeGenerator
+ removeVariable: 'localAbsentReceiver';
+ removeVariable: 'localAbsentReceiverOrZero'].
- aCCodeGenerator
- var: #nsMethodCache
- declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'.
AtCacheTotalSize isInteger ifTrue:
[aCCodeGenerator
var: #atCache
declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
aCCodeGenerator
var: #primitiveTable
declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
vmClass primitiveTable do:
[:symbolOrNot|
(symbolOrNot isSymbol
and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
[:tMethod| tMethod returnType: #void]]].
vmClass objectMemoryClass hasSpurMemoryManagerAPI
ifTrue:
[aCCodeGenerator
var: #primitiveAccessorDepthTable
type: 'signed char'
sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
array: vmClass primitiveAccessorDepthTable]
ifFalse:
[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
aCCodeGenerator
var: #primitiveFunctionPointer
declareC: 'void (*primitiveFunctionPointer)()'.
aCCodeGenerator
var: #externalPrimitiveTable
declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
aCCodeGenerator var: #showSurfaceFn type: #'void *'.
aCCodeGenerator
var: #jmpBuf
declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
aCCodeGenerator
var: #suspendedCallbacks
declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
aCCodeGenerator
var: #suspendedMethods
declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
aCCodeGenerator
var: #interruptCheckChain
declareC: 'void (*interruptCheckChain)(void) = 0'.
self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong.
LowcodeVM ifTrue: [
aCCodeGenerator
var: #shadowCallStackPointer
type: #'char*'.
aCCodeGenerator
var: #lowcodeCalloutState
type: #'sqLowcodeCalloutState*'
].!
Item was changed:
----- Method: TAssignmentNode>>emitCCodeAsArgumentOn:level:generator: (in category 'C code generation') -----
emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
+ ^self emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen!
- aStream nextPut: $(.
- self emitCCodeOn: aStream level: level generator: aCodeGen.
- aStream nextPut: $)!
Item was changed:
----- Method: TAssignmentNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
+ (expression isStmtList and: [expression statements size > 1]) ifTrue:
+ [^self emitStatementListExpansionAsExpression: expression on: aStream level: level generator: aCodeGen].
aStream nextPut: $(.
self emitCCodeOn: aStream level: level generator: aCodeGen.
aStream nextPut: $)!
Item was added:
+ ----- Method: TAssignmentNode>>emitStatementListExpansionAsExpression:on:level:generator: (in category 'C code generation') -----
+ emitStatementListExpansionAsExpression: stmtList on: aStream level: level generator: aCodeGen
+ stmtList statements last = variable ifTrue:
+ [^expression emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen].
+ stmtList copy
+ assignLastExpressionTo: variable;
+ emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen!
Item was added:
+ ----- Method: TMethod>>checkForRequiredInlinability (in category 'testing') -----
+ checkForRequiredInlinability
+ "This is used in methods answering inlinability.
+ Always answer false. But if the receiver is marked as something that must be inlined (inline == #always) raise an error."
+ (inline == #always and: [complete]) ifTrue:
+ [self error: 'cannot inline method ', selector, ' marked as <inline: #always>'].
+ ^false!
Item was changed:
----- 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 isFunctionalIn: aCodeGen) ifTrue:
- 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 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].
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 parseTree endsWithReturn
+ ifTrue: [meth parseTree copyWithoutReturn]
- ^meth statements first isReturn
- ifTrue: [meth statements first expression]
ifFalse: [meth parseTree]!
Item was changed:
----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') -----
inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen
"Answer a collection of statements to replace the given send. directReturn indicates
that the send is the expression in a return statement, so returns can be left in the
body of the inlined method. If exitVar is nil, the value returned by the send is not
used; thus, returns need not assign to the output variable.
Types are propagated to as-yet-untyped variables when inlining a send that is assigned,
otherwise the assignee variable type must match the return type of the inlinee. Return
types are not propagated."
| sel meth methArgs exitLabel inlineStmts label exitType |
sel := aSendNode selector.
meth := aCodeGen methodNamed: sel.
methArgs := meth args.
"convenient for debugging..."
aCodeGen maybeBreakForInlineOf: aSendNode in: self.
(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
[methArgs := methArgs allButFirst].
methArgs size = aSendNode args size ifFalse:
[^nil].
meth := meth copy.
+ (meth statements size > 1
+ and: [meth statements first isSend
+ and: [meth statements first selector == #flag:]]) ifTrue:
+ [meth statements removeFirst].
+
"Propagate the return type of an inlined method"
(directReturn or: [exitVar notNil]) ifTrue:
[exitType := directReturn
ifTrue: [returnType]
ifFalse: [(self typeFor: exitVar in: aCodeGen) ifNil: [#sqInt]].
(exitType = #void or: [exitType = meth returnType]) ifFalse:
[meth propagateReturnIn: aCodeGen]].
"Propagate any unusual argument types to untyped argument variables"
methArgs
with: aSendNode args
do: [:formal :actual|
(meth declarationAt: formal ifAbsent: nil) ifNil:
[(self typeFor: actual in: aCodeGen) ifNotNil:
[:type|
type ~= #sqInt ifTrue:
[meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
meth renameVarsForInliningInto: self except: #() in: aCodeGen.
meth renameLabelsForInliningInto: self.
self addVarsDeclarationsAndLabelsOf: meth except: #().
meth hasReturn ifTrue:
[directReturn ifFalse:
[exitLabel := self unusedLabelForInliningInto: self.
(meth exitVar: exitVar label: exitLabel) "is label used?"
ifTrue: [ labels add: exitLabel ]
ifFalse: [ exitLabel := nil ]]].
(inlineStmts := OrderedCollection new: meth statements size + meth args size + 2)
add: (label := TLabeledCommentNode new setComment: 'begin ', sel);
addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen);
addAll: meth statements. "method body"
directReturn ifTrue:
[meth endsWithReturn
ifTrue:
[exitVar ifNotNil: "don't remove the returns if being invoked in the context of a return"
[inlineStmts at: inlineStmts size put: inlineStmts last copyWithoutReturn]]
ifFalse:
[inlineStmts add:
(TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]].
exitLabel ifNotNil:
[inlineStmts add:
(TLabeledCommentNode new setLabel:
exitLabel comment: 'end ', meth selector)].
inlineStmts size = 1 ifTrue: "Nuke empty methods; e.g. override of flushAtCache"
[self assert: inlineStmts first isComment.
inlineStmts removeFirst].
^inlineStmts!
Item was changed:
----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') -----
inlineableFunctionCall: aNode in: aCodeGen
+ "Answer 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."
- "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."
aCodeGen maybeBreakForTestToInline: aNode in: self.
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 isFunctionalIn: aCodeGen)
+ and: [(aCodeGen mayInline: m selector)
+ and: [aNode args allSatisfy: [:a| self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]])
+ or: [m checkForRequiredInlinability]]!
- m ~~ self
- and: [m isFunctional
- and: [(aCodeGen mayInline: m selector)
- and: [aNode args allSatisfy: [ :a | self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]!
Item was changed:
----- Method: TMethod>>inlineableSend:in: (in category 'inlining') -----
inlineableSend: aNode in: aCodeGen
+ "Answer if the given send node is a call to a method that can be inlined."
- "Answer true if the given send node is a call to a method that can be inlined."
| m |
aCodeGen maybeBreakForTestToInline: aNode in: self.
+ aNode isSend ifFalse: [^false].
- aNode isSend ifFalse: [ ^false ].
m := aCodeGen methodNamed: aNode selector. "nil if builtin or external function"
+ ^m ~= nil
+ and: [m ~~ self
+ and: [(m isComplete and: [aCodeGen mayInline: m selector])
+ or: [m checkForRequiredInlinability]]]!
- ^m ~= nil and: [m ~~ self and: [m isComplete and: [aCodeGen mayInline: m selector]]]!
Item was removed:
- ----- 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."
-
- parseTree statements isEmpty ifTrue:
- [^false].
- parseTree statements last isReturn ifFalse:
- [^false].
- parseTree statements size = 1 ifFalse:
- [(parseTree statements size = 2
- and: [parseTree statements first isSend
- and: [parseTree statements first selector == #flag:]]) ifFalse:
- [^false]].
- parseTree statements last expression nodesDo:
- [ :n | n isReturn ifTrue: [^false]].
- ^#(int #'unsigned int' #long #'unsigned long' #'long long' #'unsigned long long'
- sqInt usqInt #'sqIntptr_t' #'usqIntptr_t' sqLong usqLong
- #'int *' #'unsigned int *' #'sqInt *' #'usqInt *' #'sqLong *' #'usqLong *' #'CogMethod *' #'char *') includes: returnType!
Item was added:
+ ----- Method: TMethod>>isFunctionalIn: (in category 'inlining') -----
+ isFunctionalIn: aCodeGen
+ "Answer 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, or an assert or flag followed by
+ such a statement.
+
+ Answer false for methods with return types other than the simple
+ integer types to work around bugs in the inliner."
+
+ parseTree statements size = 1 ifFalse:
+ [(parseTree statements size = 2
+ and: [parseTree statements first isSend
+ and: [parseTree statements first selector == #flag:
+ or: [(aCodeGen isAssertSelector: parseTree statements first selector)
+ and: [parseTree statements first selector ~~ #asserta:]]]]) ifFalse:
+ [^false]].
+ parseTree statements last isReturn ifFalse:
+ [^false].
+ parseTree statements last expression nodesDo:
+ [ :n | n isReturn ifTrue: [^false]].
+ ^#(int #'unsigned int' #long #'unsigned long' #'long long' #'unsigned long long'
+ sqInt usqInt #'sqIntptr_t' #'usqIntptr_t' sqLong usqLong
+ #'int *' #'unsigned int *' #'sqInt *' #'usqInt *' #'sqLong *' #'usqLong *' #'CogMethod *' #'char *') includes: returnType!
Item was added:
+ ----- Method: TMethod>>tryToInlineMethodExpressionsIn: (in category 'inlining') -----
+ tryToInlineMethodExpressionsIn: aCodeGen
+ "Expand any (complete) inline methods sent by this method as receivers or parameters.
+ Answer if anything was inlined."
+
+ | sendsToInline |
+ sendsToInline := Dictionary new: 100.
+ parseTree
+ nodesDo:
+ [:node|
+ (self transformConditionalAssignment: node in: aCodeGen) ifNotNil:
+ [:replacement|
+ sendsToInline at: node put: replacement].
+ (self inlineableFunctionCall: node in: aCodeGen) ifTrue:
+ [(self inlineFunctionCall: node in: aCodeGen) ifNotNil:
+ [:replacement|
+ sendsToInline at: node put: replacement]]]
+ 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 ifTrue:
+ [^false].
+ parseTree := parseTree replaceNodesIn: sendsToInline.
+ ^true!
Item was added:
+ ----- Method: TMethod>>tryToInlineMethodStatementsIn:statementListsInto: (in category 'inlining') -----
+ tryToInlineMethodStatementsIn: aCodeGen statementListsInto: aBlock
+ "Expand any (complete) inline methods sent by this method as top-level statements.
+ Answer if anything was inlined."
+
+ | stmtLists didSomething newStatements returningNodes |
+ didSomething := false.
+ returningNodes := Set new.
+ parseTree nodesDo:
+ [:node|
+ node isReturn ifTrue:
+ [returningNodes add: node expression.
+ node expression isConditionalSend ifTrue:
+ [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]].
+ stmtLists := self statementsListsForInliningIn: aCodeGen.
+ stmtLists do:
+ [:stmtList|
+ newStatements := OrderedCollection new: stmtList statements size.
+ stmtList statements do:
+ [:stmt|
+ (self inlineCodeOrNilForStatement: stmt returningNodes: returningNodes in: aCodeGen)
+ ifNil: [newStatements addLast: stmt]
+ ifNotNil: [:inlinedStmts|
+ didSomething := true.
+ newStatements addAllLast: inlinedStmts]].
+ stmtList setStatements: newStatements asArray].
+
+ "This is a hack; forgive me. The inlining above tends to keep return statements in statement lists.
+ In the case of returning ifs we don't want the returns in case the returning if is generated as an expression."
+ returningNodes do:
+ [:returningNode|
+ (returningNode isConditionalSend
+ and: [returningNode args anySatisfy: [:alternativeNode| alternativeNode endsWithReturn]]) ifTrue:
+ [returningNode args withIndexDo:
+ [:alternativeNode :index|
+ alternativeNode endsWithReturn ifTrue:
+ [returningNode args at: index put: alternativeNode copyWithoutReturn]]]].
+
+ aBlock value: stmtLists.
+
+ ^didSomething!
Item was changed:
----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
tryToInlineMethodsIn: aCodeGen
+ "Expand any (complete) inline methods sent by this method.
+ Set the complete flag when all inlining has been done.
+ Answer if something was inlined."
- "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."
+ | didSomething statementLists |
- | stmtLists didSomething newStatements sendsToInline returningNodes |
self definedAsMacro ifTrue:
[complete := true.
^false].
+ didSomething := self tryToInlineMethodStatementsIn: aCodeGen statementListsInto: [:stmtLists| statementLists := stmtLists].
+ didSomething := (self tryToInlineMethodExpressionsIn: aCodeGen) or: [didSomething].
- didSomething := false.
- sendsToInline := Dictionary new: 100.
- parseTree
- nodesDo:
- [:node|
- (self transformConditionalAssignment: node in: aCodeGen) ifNotNil:
- [:replacement|
- sendsToInline at: node put: replacement].
- (self inlineableFunctionCall: node in: aCodeGen) ifTrue:
- [(self inlineFunctionCall: node in: aCodeGen) ifNotNil:
- [:replacement|
- sendsToInline at: node put: replacement]]]
- 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].
- returningNodes := Set new.
- parseTree nodesDo:
- [:node|
- node isReturn ifTrue:
- [returningNodes add: node expression.
- node expression isConditionalSend ifTrue:
- [returningNodes addAll: (node expression args collect: [:stmtList| stmtList statements last])]]].
- stmtLists := self statementsListsForInliningIn: aCodeGen.
- stmtLists do:
- [:stmtList|
- newStatements := OrderedCollection new: stmtList statements size.
- stmtList statements do:
- [:stmt|
- (self inlineCodeOrNilForStatement: stmt returningNodes: returningNodes in: aCodeGen)
- ifNil: [newStatements addLast: stmt]
- ifNotNil: [:inlinedStmts|
- didSomething := true.
- newStatements addAllLast: inlinedStmts]].
- stmtList setStatements: newStatements asArray].
-
- "This is a hack; forgive me. The inlining abiove tends to keep return statements in statement lists.
- In the case of returning ifs we don't want the returns in case the returning if is generated as an expression."
- returningNodes do:
- [:returningNode|
- (returningNode isConditionalSend
- and: [returningNode args anySatisfy: [:alternativeNode| alternativeNode endsWithReturn]]) ifTrue:
- [returningNode args withIndexDo:
- [:alternativeNode :index|
- alternativeNode endsWithReturn ifTrue:
- [returningNode args at: index put: alternativeNode copyWithoutReturn]]]].
-
- didSomething ifTrue:
- [writtenToGlobalVarsCache := nil.
- ^didSomething].
-
complete ifFalse:
+ [self checkForCompleteness: statementLists in: aCodeGen.
+ complete ifTrue: [didSomething := true]]. "marking a method complete is progress"
- [self checkForCompleteness: stmtLists in: aCodeGen.
- complete ifTrue: [ didSomething := true ]]. "marking a method complete is progress"
^didSomething!
Item was changed:
----- Method: TStmtListNode>>copyWithoutReturn (in category 'transformations') -----
copyWithoutReturn
self assert: self endsWithReturn.
+ statements size = 1 ifTrue:
+ [^statements last expression].
^self class new
setArguments: arguments
statements: statements allButLast, {statements last copyWithoutReturn};
yourself!
Item was changed:
----- Method: ThreadedX64SysVFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
<var: #procAddr type: #'void *'>
<var: #calloutState type: #'CalloutState *'>
<var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'>
"Go out, call this guy and create the return value. This *must* be inlined because of
the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:"
| myThreadIndex atomicType floatRet intRet loadFloatRegs |
<var: #floatRet type: #double>
+ <var: #intRet type: #SixteenByteReturn>
- <var: #intRet type: 'SixteenByteReturn'>
<inline: true>
self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class].
self maybeDisownVM: calloutState threadIndexInto: [:threadIndex| myThreadIndex := threadIndex].
calloutState floatRegisterIndex > 0 ifTrue:
[self
load: (calloutState floatRegisters at: 0)
Flo: (calloutState floatRegisters at: 1)
a: (calloutState floatRegisters at: 2)
t: (calloutState floatRegisters at: 3)
R: (calloutState floatRegisters at: 4)
e: (calloutState floatRegisters at: 5)
g: (calloutState floatRegisters at: 6)
s: (calloutState floatRegisters at: 7)].
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
[self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
[atomicType = FFITypeSingleFloat
ifTrue:
[floatRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
with: (calloutState integerRegisters at: 0)
with: (calloutState integerRegisters at: 1)
with: (calloutState integerRegisters at: 2)
with: (calloutState integerRegisters at: 3)
with: (calloutState integerRegisters at: 4)
with: (calloutState integerRegisters at: 5)]
ifFalse: "atomicType = FFITypeDoubleFloat"
[floatRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
with: (calloutState integerRegisters at: 0)
with: (calloutState integerRegisters at: 1)
with: (calloutState integerRegisters at: 2)
with: (calloutState integerRegisters at: 3)
with: (calloutState integerRegisters at: 4)
with: (calloutState integerRegisters at: 5)].
self maybeOwnVM: calloutState threadIndex: myThreadIndex.
^interpreterProxy floatObjectOf: floatRet].
intRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturn (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
with: (calloutState integerRegisters at: 0)
with: (calloutState integerRegisters at: 1)
with: (calloutState integerRegisters at: 2)
with: (calloutState integerRegisters at: 3)
with: (calloutState integerRegisters at: 4)
with: (calloutState integerRegisters at: 5).
self maybeOwnVM: calloutState threadIndex: myThreadIndex.
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue:
["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet a ofType: (self ffiReturnType: specOnStack) in: calloutState].
- [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
+ ^self ffiCreateIntegralResultOop: intRet a ofAtomicType: atomicType in: calloutState!
- ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was changed:
----- Method: ThreadedX64SysVFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
ffiReturnStruct: sixteenByteRet ofType: ffiRetType in: calloutState
+ <var: #sixteenByteRet type: #SixteenByteReturn>
- <var: #sixteenByteRet type: 'SixteenByteReturn'>
<var: #calloutState type: #'CalloutState *'>
"Create a structure return value from an external function call. The value has been stored in
alloca'ed space pointed to by the calloutState or in the return value."
| retOop retClass oop |
<inline: true>
retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
self remapOop: retOop
in: [oop := interpreterProxy
instantiateClass: interpreterProxy classByteArray
indexableSize: calloutState structReturnSize].
self mem: (interpreterProxy firstIndexableField: oop)
cp: ((self returnStructInRegisters: calloutState structReturnSize)
ifTrue: [(self addressOf: sixteenByteRet) asVoidPointer]
ifFalse: [calloutState limit])
y: calloutState structReturnSize.
interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
^retOop!
More information about the Vm-dev
mailing list