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! |
Free forum by Nabble | Edit this page |