[Pkg] The Trunk: Compiler-eem.337.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Apr 3 21:06:44 UTC 2017


Eliot Miranda uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-eem.337.mcz

==================== Summary ====================

Name: Compiler-eem.337
Author: eem
Time: 3 April 2017, 2:06:32.26662 pm
UUID: 85f04687-1157-4f7a-9a4c-c02c733b638e
Ancestors: Compiler-eem.336

Eliminate the support for blue book block decompilastion and collapse DecompilerConstructorForClosures into DecompilerConstructor.

Refactor MethodNode>>preen to also check for temps declared in blocks that conflict with method-level temps.  On decompilation this is a sign that the method level temps were delcraed in sme optimized block and the preen pass finds out where to push the method level temps down to.

=============== Diff against Compiler-eem.336 ===============

Item was removed:
- ----- Method: Decompiler>>checkForBlockCopy: (in category 'control') -----
- checkForBlockCopy: receiver
- 	"We just saw a blockCopy: message. Check for a following block."
- 
- 	| savePc jump args argPos block |
- 	receiver == constructor codeThisContext ifFalse: [^false].
- 	savePc := pc.
- 	(jump := self interpretJump) ifNil:
- 		[pc := savePc.  ^false].
- 	self sawBlueBookBlock.
- 	"Definitely a block"
- 	jump := jump + pc.
- 	argPos := statements size.
- 	[self willStorePop]
- 		whileTrue:
- 			[stack addLast: ArgumentFlag.  "Flag for doStore:"
- 			self interpretNextInstructionFor: self].
- 	args := Array new: statements size - argPos.
- 	1 to: args size do:  "Retrieve args"
- 		[:i | args at: i put: statements removeLast.
- 		(args at: i) scope: -1  "flag args as block temps"].
- 	block := self blockTo: jump.
- 	stack addLast: (constructor codeArguments: args block: block).
- 	^true!

Item was changed:
  ----- Method: Decompiler>>constructorForMethod: (in category 'private') -----
  constructorForMethod: aMethod
+ 	^DecompilerConstructor new!
- 	^(aMethod isBlueBookCompiled
- 		ifTrue: [DecompilerConstructor]
- 		ifFalse: [DecompilerConstructorForClosures]) new!

Item was changed:
  ----- Method: Decompiler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
  popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	self sawClosureBytecode.
  	self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: statements!

Item was changed:
  ----- Method: Decompiler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
  pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
  	| copiedValues |
- 	self sawClosureBytecode.
  	copiedValues := ((1 to: numCopied) collect: [:ign| stack removeLast]) reversed.
  	self doClosureCopyCopiedValues: copiedValues numArgs: numArgs blockSize: blockSize!

Item was changed:
  ----- Method: Decompiler>>pushConsArrayWithElements: (in category 'instruction decoding') -----
  pushConsArrayWithElements: numElements 
  	| array |
- 	self sawClosureBytecode.
  	array := Array new: numElements.
  	numElements to: 1 by: -1 do:
  		[:i|
  		array at: i put: stack removeLast].
  	stack addLast: (constructor codeBrace: array)!

Item was changed:
  ----- Method: Decompiler>>pushNewArrayOfSize: (in category 'instruction decoding') -----
  pushNewArrayOfSize: size
- 	self sawClosureBytecode.
  	stack addLast: #pushNewArray -> (Array new: size)!

Item was changed:
  ----- Method: Decompiler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
  pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	self sawClosureBytecode.
  	stack addLast: ((tempVars at: tempVectorIndex + 1) remoteTemps at: remoteTempIndex + 1)!

Item was removed:
- ----- Method: Decompiler>>sawBlueBookBlock (in category 'private') -----
- sawBlueBookBlock
- 	constructor isForClosures ifTrue:
- 		[constructor primitiveChangeClassTo: DecompilerConstructor new]!

Item was removed:
- ----- Method: Decompiler>>sawClosureBytecode (in category 'private') -----
- sawClosureBytecode
- 	constructor isForClosures ifFalse:
- 		[constructor primitiveChangeClassTo: DecompilerConstructorForClosures new]!

Item was changed:
  ----- Method: Decompiler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
  storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	self sawClosureBytecode.
  	self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: stack!

Item was changed:
  ----- Method: DecompilerConstructor>>codeMethod:block:tempVars:primitive:class: (in category 'constructor') -----
  codeMethod: selector block: block tempVars: vars primitive: primitive class: class
  
+ 	| blockNode selectorNode visibleTemps invisibleTemps arguments temporaries properties |
+ 	selectorNode := self codeSelector: selector code: nil.
- 	| node methodTemps arguments temporaries |
- 	node := self codeSelector: selector code: nil.
  	tempVars := vars.
+ 	visibleTemps := OrderedCollection new.
+ 	invisibleTemps := OrderedCollection new.
+ 	tempVars do: [:t|
+ 				   ((t isIndirectTempVector or: [t scope >= 0])
+ 						ifTrue: [visibleTemps]
+ 						ifFalse: [invisibleTemps]) addLast: t].
+ 	arguments := visibleTemps copyFrom: 1 to: nArgs.
+ 	temporaries := visibleTemps copyFrom: nArgs + 1 to: visibleTemps size.
- 	methodTemps := tempVars select: [:t | t scope >= 0].
- 	arguments := methodTemps copyFrom: 1 to: nArgs.
- 	temporaries := methodTemps copyFrom: nArgs + 1 to: methodTemps size.
  	block
  		arguments: arguments;
  		temporaries: temporaries.
+ 	properties := method properties copy.
+ 	(properties at: #onceCache ifAbsent: []) ifNotNil:
+ 		[:onceCache|
+ 		 properties := properties copyWithout: (Association
+ 													key: #onceCache
+ 													value: onceCache)].
+ 	blockNode := MethodNode new
+ 		selector: selectorNode
- 	^MethodNode new
- 		selector: node
  		arguments: arguments
  		precedence: selector precedence
  		temporaries: temporaries
  		block: block
+ 		encoder: (method encoderClass new initScopeAndLiteralTables
+ 					temps: visibleTemps, invisibleTemps
- 		encoder: (Encoder new initScopeAndLiteralTables
- 					temps: tempVars
  					literals: literalValues
  					class: class)
+ 		primitive: primitive
+ 		properties: properties.
+ 	blockNode properties method: blockNode.
+ 	^blockNode!
- 		primitive: primitive!

Item was added:
+ ----- Method: DecompilerConstructor>>codeRemoteTemp:remoteTemps: (in category 'as yet unclassified') -----
+ codeRemoteTemp: index remoteTemps: tempVector
+ 
+ 	^(RemoteTempVectorNode new
+ 		name: '_r', index printString
+ 		index: index
+ 		type: LdTempType
+ 		scope: 0)
+ 			remoteTemps: tempVector;
+ 			yourself!

Item was removed:
- ----- Method: DecompilerConstructor>>isForClosures (in category 'testing') -----
- isForClosures
- 	^false!

Item was removed:
- DecompilerConstructor subclass: #DecompilerConstructorForClosures
- 	instanceVariableNames: 'tempNameCounter'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Compiler-Support'!

Item was removed:
- ----- Method: DecompilerConstructorForClosures>>codeMethod:block:tempVars:primitive:class: (in category 'constructor') -----
- codeMethod: selector block: block tempVars: vars primitive: primitive class: class
- 
- 	| blockNode selectorNode visibleTemps invisibleTemps arguments temporaries properties |
- 	selectorNode := self codeSelector: selector code: nil.
- 	tempVars := vars.
- 	visibleTemps := OrderedCollection new.
- 	invisibleTemps := OrderedCollection new.
- 	tempVars do: [:t|
- 				   ((t isIndirectTempVector or: [t scope >= 0])
- 						ifTrue: [visibleTemps]
- 						ifFalse: [invisibleTemps]) addLast: t].
- 	arguments := visibleTemps copyFrom: 1 to: nArgs.
- 	temporaries := visibleTemps copyFrom: nArgs + 1 to: visibleTemps size.
- 	block
- 		arguments: arguments;
- 		temporaries: temporaries.
- 	properties := method properties copy.
- 	(properties at: #onceCache ifAbsent: []) ifNotNil:
- 		[:onceCache|
- 		 properties := properties copyWithout: (Association
- 													key: #onceCache
- 													value: onceCache)].
- 	blockNode := MethodNode new
- 		selector: selectorNode
- 		arguments: arguments
- 		precedence: selector precedence
- 		temporaries: temporaries
- 		block: block
- 		encoder: (method encoderClass new initScopeAndLiteralTables
- 					temps: visibleTemps, invisibleTemps
- 					literals: literalValues
- 					class: class)
- 		primitive: primitive
- 		properties: properties.
- 	blockNode properties method: blockNode.
- 	^blockNode!

Item was removed:
- ----- Method: DecompilerConstructorForClosures>>codeRemoteTemp:remoteTemps: (in category 'constructor') -----
- codeRemoteTemp: index remoteTemps: tempVector
- 
- 	^(RemoteTempVectorNode new
- 		name: '_r', index printString
- 		index: index
- 		type: LdTempType
- 		scope: 0)
- 			remoteTemps: tempVector;
- 			yourself!

Item was removed:
- ----- Method: DecompilerConstructorForClosures>>isForClosures (in category 'testing') -----
- isForClosures
- 	^true!

Item was changed:
  ----- Method: MethodNode>>preen (in category 'converting') -----
  preen
  	"Preen for pretty-printing and/or decompilation.
  	 i.e. post-process to cover up for inadequacies in both algorithms.
- 	 Currently one case, hiding the assignment to the arg of an inlined block arg to ifNotNil:,
- 		(var := expr) ifNil: [...] ifNotNil: [...]    =>    expr ifNil: [...] ifNotNil: [:var| ...]."
  
+ 	 Currently two cases:
+ 
+ 		preenLocalIfNotNilArg: blockNode
+ 		hiding the assignment to the arg of an inlined block arg to ifNotNil:,
+ 			(var := expr) ifNil: [...] ifNotNil: [...]    =>    expr ifNil: [...] ifNotNil: [:var| ...].
+ 
+ 		preenTempsConflictingWithBlockNode: temps
+ 		hiding the declaration of a temp that is redeclared in some block"
+ 
+ 	self preenableNodes keysAndValuesDo:
+ 		[:nodeOrArray :selector |
+ 		 self perform: selector with: nodeOrArray]!
- 	self preenLocalIfNotNilArg!

Item was added:
+ ----- Method: MethodNode>>preenIfNotNilNode: (in category 'converting-private') -----
+ preenIfNotNilNode: messageNode
+ 	"Transform a (var := expr) ifNil: [...] ifNotNil: [...] where var is only used in the ifNotNil: block
+ 	 and convert it to expr ifNil: [...] ifNotNil: [:var| ...].  Deal both with the pretty-print case where
+ 	 the block already declares the variable and the decompile case where it does not."
+ 
+ 	| variable |
+ 	self assert: (messageNode isMessageNode
+ 				and: [messageNode macroPrinter == #printIfNilNotNil:indent:
+ 				and: [messageNode receiver receiver isAssignmentNode]]).
+ 	variable := messageNode receiver receiver variable.
+ 	self assert: (variable isTemp and: [variable isRemote not]).
+ 	messageNode arguments last arguments isEmpty
+ 		ifTrue: [messageNode arguments last arguments: { variable }]
+ 		ifFalse:
+ 			[self assert: messageNode arguments last arguments asArray = { variable }.
+ 			 variable := nil].
+ 	messageNode receiver receiver: messageNode receiver receiver value.
+ 	variable ifNil: [^self].
+ 	self nodesDo:
+ 		[:node|
+ 		((node == self or: [node isBlockNode])
+ 		 and: [node temporaries includes: variable]) ifTrue:
+ 			[node temporaries: (node temporaries copyWithout: variable)]]!

Item was removed:
- ----- Method: MethodNode>>preenLocalIfNotNilArg (in category 'converting') -----
- preenLocalIfNotNilArg
- 	"Try and spot a (var := expr) ifNil: [...] ifNotNil: [...] where var is only used in the ifNotNil: block
- 	 and convert it to expr ifNil: [...] ifNotNil: [:var| ...].  Deal both with the pretty-print case where
- 	 the block already declares the variable and the decompile case where it does not."
- 
- 	| varsToHide |
- 	varsToHide := Set new.
- 	self nodesDo:
- 		[:node| | variable |
- 		(node isMessageNode
- 		and: [node macroPrinter == #printIfNilNotNil:indent:
- 		and: [node receiver isMessageNode
- 		and: [node receiver selector key == #==
- 		and: [node receiver receiver isAssignmentNode
- 		and: [(variable := node receiver receiver variable) isTemp
- 		and: [variable isRemote not
- 		and: [variable isOnlySubnodeOf: node in: self]]]]]]]) ifTrue:
- 			[node arguments last arguments isEmpty
- 				ifTrue: [node arguments last arguments: { variable }.
- 						varsToHide add: variable]
- 				ifFalse: [self assert: node arguments last arguments asArray =  { variable }].
- 			 node receiver receiver: node receiver receiver value]].
- 	varsToHide notEmpty ifTrue:
- 		[self nodesDo:
- 			[:node|
- 			((node == self or: [node isBlockNode])
- 			and: [node temporaries anySatisfy: [:temp| varsToHide includes: temp]]) ifTrue:
- 				[node temporaries: (node temporaries reject: [:temp| varsToHide includes: temp])]]]!

Item was added:
+ ----- Method: MethodNode>>preenTempsConflictingWithBlockNode: (in category 'converting-private') -----
+ preenTempsConflictingWithBlockNode: temps
+ 	"Push temps that conflict with other bocks down into their narrowest enclosing block scope."
+ 	temps do:
+ 		[:tempVar|
+ 		(self accept: (NarrowerVariableScopeFinder new ofVariable: tempVar)) ifNotNil:
+ 			[:enclosingScope |
+ 			 self assert: enclosingScope isBlockNode.
+ 			 self nodesDo:
+ 				[:node|
+ 				 ((node == self or: [node isBlockNode])
+ 				  and: [node temporaries includes: tempVar]) ifTrue:
+ 					[node temporaries: (node temporaries copyWithout: tempVar)]].
+ 			 enclosingScope temporaries: enclosingScope temporaries, { tempVar }]]!

Item was added:
+ ----- Method: MethodNode>>preenableNodes (in category 'converting-private') -----
+ preenableNodes
+ 	"Answer a Dictionary from node or sequence of nodes to preen method selector for nodes
+ 	 in the tree that require post-processing after either a format or a decompile.  Such issues
+ 	 are the variable for an ifNotNil: which is local to the ifNotNil: block but, due to the inlining
+ 	 of ifNotNil: appears to be declared at the outer level, and, similarly, a temporary variable
+ 	 that conflicts with one of the same name in a block when, were the variable declared
+ 	 local to some inlined block it would no longer conflict.  The resulting dictionary is used to
+ 	 perform the value with the key (node or array) as argument to preen the tree."
+ 
+ 	| preenableNodes priorBlocks priorVariables |
+ 	preenableNodes := Dictionary new.
+ 	priorBlocks := OrderedCollection new.
+ 	priorVariables := Set new.
+ 	self nodesDo:
+ 		[:node| | variable temps |
+ 		(node isMessageNode
+ 		and: [node macroPrinter == #printIfNilNotNil:indent:
+ 		and: [node receiver isMessageNode
+ 		and: [node receiver selector key == #==
+ 		and: [node receiver receiver isAssignmentNode
+ 		and: [(variable := node receiver receiver variable) isTemp
+ 		and: [variable isRemote not
+ 		and: [variable isOnlySubnodeOf: node in: self]]]]]]]) ifTrue:
+ 			[preenableNodes at: node put: #preenIfNotNilNode:.
+ 			 priorVariables add: variable].
+ 		node isBlockNode ifTrue:
+ 			[temps := OrderedCollection new.
+ 			 node temporaries do:
+ 				[:temp|
+ 				 priorBlocks do:
+ 					[:aBlock|
+ 					 aBlock temporaries do:
+ 						[:priorTemp|
+ 						 (priorVariables includes: priorTemp) ifFalse:
+ 							[priorTemp key = temp key ifTrue:
+ 								[temps addLast: priorTemp]]]]].
+ 			 temps isEmpty ifFalse:
+ 				[preenableNodes at: temps put: #preenTempsConflictingWithBlockNode:].
+ 			 priorBlocks addLast: node]].
+ 	^preenableNodes!

Item was added:
+ VariableScopeFinder subclass: #NarrowerVariableScopeFinder
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Compiler-Support'!
+ 
+ !NarrowerVariableScopeFinder commentStamp: 'eem 4/3/2017 11:59' prior: 0!
+ A NarrowerVariableScopeFinder is used to find a smaller scope for an already declared variable.!

Item was added:
+ ----- Method: NarrowerVariableScopeFinder>>visitTempVariableNode: (in category 'visiting') -----
+ visitTempVariableNode: aVariableNode
+ 	^theVariable = aVariableNode ifTrue: [theVariable]!

Item was added:
+ ----- Method: NarrowerVariableScopeFinder>>visitUndeclaredVariableNode: (in category 'visiting') -----
+ visitUndeclaredVariableNode: aVariableNode
+ 	^nil!



More information about the Packages mailing list