diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCodeGenerator.st --- a/compiler/PPCCodeGenerator.st Fri Jul 24 15:06:54 2015 +0100 +++ b/compiler/PPCCodeGenerator.st Mon Aug 17 12:13:16 2015 +0100 @@ -131,7 +131,7 @@ compiler addOnLine: '].'. ]." - guard id: (compiler idFor: guard prefixed: #guard). + guard id: (compiler idFor: guard defaultName: #guard). guard compileGuard: compiler. trueBlock isNil ifFalse: [ @@ -191,6 +191,61 @@ !PPCCodeGenerator methodsFor:'private'! +checkBlockIsInlinable: block + "Check whether the given block could be inlined. If not, + throw an error. If yes, this method is noop. + + A block is inlineable if and only if it's a purely functional + (see PPCASTUtilities>>checkBlockIsPurelyFunctional:inClass: for + details) + + As a side-effect, copy all self-sent methods from the block + to the target class. + " + | blockNode | + + blockNode := block sourceNode. + "In Smalltalk implementation which use cheap-block optimization (Smalltalk/X) it may + happen that home context of the block is nil (in case of cheap blocks)" + block home notNil ifTrue:[ + | blockClass | + + blockClass := block home receiver class. + PPCASTUtilities new checkNodeIsFunctional: blockNode inClass: blockClass. + "The above code should raise an error when block is not functional (i.e., when not + inlineable, so if the control flow reach this point, block is OK and we can safely + copy self-sent methods." + self copySelfSentMethodsOf: blockNode inClass: blockClass + ]. + + "Created: / 27-07-2015 / 14:40:07 / Jan Vrany " + "Modified: / 27-07-2015 / 15:52:59 / Jan Vrany " +! + +copySelfSentMethodsOf: anRBProgramNode inClass: aClass + PPCASTUtilities new withAllMessageNodesOf: anRBProgramNode sentToSelfDo: [ :node| + | method source | + + method := aClass lookupSelector: node selector. + method isNil ifTrue:[ + PPCCompilationError new signalWith: 'oops, no method found (internal error)!!'. + ]. + source := method source. + source isNil ifTrue:[ + PPCCompilationError new signalWith: 'unavailable source for method ', method printString ,'!!'. + ]. + "Following actually copies the method to the target class, + though the APU is not nice. This has to be cleaned up" + (compiler cachedValue: node selector) isNil ifTrue:[ + compiler cache: node selector as: (PPCMethod new id: node selector; source: source; yourself). + "Now compile self-sends of the just copied method" + self copySelfSentMethodsOf: method parseTree inClass: aClass + ]. + ] + + "Created: / 27-07-2015 / 14:50:47 / Jan Vrany " +! + withAllVariableNodesOf: anRBProgramNode do: aBlock "Enumerate all chilren of `anRBProgramNode` (including itself) and evaluate `aBlock` for each variable node. @@ -225,7 +280,7 @@ | classificationId classification | self error: 'deprecated.'. classification := node extendClassification: node predicate classification. - classificationId := (compiler idFor: classification prefixed: #classification). + classificationId := (compiler idFor: classification defaultName: #classification). compiler addConstant: classification as: classificationId. compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'. @@ -266,11 +321,11 @@ startMethodForNode:node node isMarkedForInline ifTrue:[ compiler startInline: (compiler idFor: node). - compiler addComment: 'BEGIN inlined code of ' , node printString. + compiler codeComment: 'BEGIN inlined code of ' , node printString. compiler indent. ] ifFalse:[ compiler startMethod: (compiler idFor: node). - compiler addComment: 'GENERATED by ' , node printString. + compiler codeComment: 'GENERATED by ' , node printString. compiler allocateReturnVariable. ]. @@ -311,6 +366,7 @@ visitActionNode: node | blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars | + self checkBlockIsInlinable: node block. blockNode := node block sourceNode copy. self assert: blockNode arguments size == 1. blockNodesVar := blockNode arguments first . @@ -335,7 +391,7 @@ blockNeedsCollection := false. blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!" childValueVars := node child preferredChildrenVariableNames. - self withAllVariableNodesOf: blockBody do:[:variableNode| + PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode| variableNode name = blockNodesVar name ifTrue:[ "Check if variable node matches..." variableNode parent isMessage ifTrue:[ @@ -366,7 +422,7 @@ blockNeedsCollection ifTrue:[ "Bad, we have to use the collection. Replace all references to blockNodeVar to retvalVar..." - self withAllVariableNodesOf: blockBody do:[:variableNode| + PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode| variableNode name = blockNodesVar name ifTrue:[ variableNode name: self retvalVar. ]. @@ -404,7 +460,7 @@ compiler code: blockBody. ] - "Modified: / 19-06-2015 / 07:05:35 / Jan Vrany " + "Modified: / 27-07-2015 / 15:49:15 / Jan Vrany " ! visitAndNode: node @@ -434,7 +490,7 @@ | classification classificationId | classification := node extendClassification: node predicate classification. - classificationId := compiler idFor: classification prefixed: #classification. + classificationId := compiler idFor: classification defaultName: #classification. compiler addConstant: classification as: classificationId. compiler add: '(', classificationId, ' at: context peek asInteger)'. @@ -452,7 +508,7 @@ node character ppcPrintable ifTrue: [ chid := node character storeString ] ifFalse: [ - chid := compiler idFor: node character prefixed: #char. + chid := compiler idFor: node character defaultName: #char. compiler addConstant: (Character value: node character asInteger) as: chid . ]. @@ -536,6 +592,7 @@ visitMappedActionNode: node | child blockNode blockBody | + self checkBlockIsInlinable: node block. child := node child. blockNode := node block sourceNode copy. blockBody := blockNode body. @@ -569,7 +626,7 @@ | blockArg | blockArg := blockNode arguments first. - self withAllVariableNodesOf: blockBody do:[:variableNode| + PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode| variableNode name = blockArg name ifTrue:[ variableNode name: self retvalVar. ]. @@ -595,7 +652,7 @@ ] "Created: / 02-06-2015 / 17:28:55 / Jan Vrany " - "Modified: / 19-06-2015 / 07:06:19 / Jan Vrany " + "Modified: / 27-07-2015 / 15:49:58 / Jan Vrany " ! visitMessagePredicateNode: node @@ -616,7 +673,7 @@ visitNotCharSetPredicateNode: node | classificationId classification | classification := node extendClassification: node predicate classification. - classificationId := (compiler idFor: classification prefixed: #classification). + classificationId := (compiler idFor: classification defaultName: #classification). compiler addConstant: classification as: classificationId. compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'. @@ -634,7 +691,7 @@ node character ppcPrintable ifTrue: [ chid := node character storeString ] ifFalse: [ - chid := compiler idFor: node character prefixed: #char. + chid := compiler idFor: node character defaultName: #char. compiler addConstant: (Character value: node character asInteger) as: chid . ]. @@ -707,7 +764,7 @@ visitPluggableNode: node | blockId | - blockId := compiler idFor: node block prefixed: #block. + blockId := compiler idFor: node block defaultName: #pluggableBlock. compiler addConstant: node block as: blockId. compiler codeReturn: blockId, ' value: context.'. @@ -753,7 +810,7 @@ visitPredicateNode: node | pid | - pid := (compiler idFor: node predicate prefixed: #predicate). + pid := (compiler idFor: node predicate defaultName: #predicate). compiler addConstant: node predicate as: pid. @@ -844,7 +901,7 @@ classification := node extendClassification: node predicate classification. - classificationId := compiler idFor: classification prefixed: #classification. + classificationId := compiler idFor: classification defaultName: #classification. compiler addConstant: classification as: classificationId. compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. @@ -876,8 +933,15 @@ self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ]. - compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar. + compiler codeIf: 'error' + then: [ + compiler codeClearError. + compiler codeReturn: '#()'. + ] else: [ + compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. + ]. + compiler add: '[ error ] whileFalse: ['. compiler indent. compiler add: self retvalVar, ' add: ', elementVar, '.'.