[squeak-dev] The Inbox: Compiler-nice.139.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Apr 7 01:18:53 UTC 2010


Nicolas Cellier uploaded a new version of Compiler to project The Inbox:
http://source.squeak.org/inbox/Compiler-nice.139.mcz

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

Name: Compiler-nice.139
Author: nice
Time: 7 April 2010, 3:06:44.988 am
UUID: a131f445-c2f7-dd47-85fd-b0d38ab18874
Ancestors: Compiler-nice.138

nil out locals in a block if readBeforeWritten
- Use noteOptimizedIn: instead of noteOptimized
- Let accept: return the result of message sent to visitor


=============== Diff against Compiler-nice.138 ===============

Item was changed:
  ----- Method: CommentNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitCommentNode: self!
- 	aVisitor visitCommentNode: self!

Item was changed:
  ----- Method: TempVariableNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitTempVariableNode: self!
- 	aVisitor visitTempVariableNode: self!

Item was changed:
  ----- Method: RemoteTempVectorNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitRemoteTempVectorNode: self!
- 	aVisitor visitRemoteTempVectorNode: self!

Item was changed:
  ----- Method: MessageNode>>transformToDo: (in category 'macro transformations') -----
  transformToDo: encoder
  	" var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] 
  Jmp(L1) L2: "
  	| limit increment block initStmt test incStmt limitInit blockVar myRange blockRange |
  	"First check for valid arguments"
  	((arguments last isMemberOf: BlockNode)
  	  and: [arguments last numberOfArguments = 1
  	  and: [arguments last firstArgument isVariableReference "As with debugger remote vars"]]) ifFalse:
  		[^false].
  	arguments size = 3
  		ifTrue: [increment := arguments at: 2.
  				(increment isConstantNumber
  				 and: [increment literalValue ~= 0]) ifFalse: [^ false]]
  		ifFalse: [increment := encoder encodeLiteral: 1].
  	arguments size < 3 ifTrue:   "transform to full form"
  		[selector := SelectorNode new key: #to:by:do: code: #macro].
  
  	"Now generate auxiliary structures"
  	myRange := encoder rawSourceRanges at: self ifAbsent: [1 to: 0].
  	block := arguments last.
  	blockRange := encoder rawSourceRanges at: block ifAbsent: [1 to: 0].
  	blockVar := block firstArgument.
  	initStmt := AssignmentNode new variable: blockVar value: receiver.
  	limit := arguments at: 1.
  	limit isVariableReference | limit isConstantNumber
  		ifTrue: [limitInit := nil]
  		ifFalse:  "Need to store limit in a var"
  			[limit := encoder bindBlockArg: blockVar key, 'LimiT' within: block.
  			 limit scope: -2.  "Already done parsing block; flag so it won't print"
  			 block addArgument: limit.
  			 limitInit := AssignmentNode new
  							variable: limit
  							value: arguments first].
  	test := MessageNode new
  				receiver: blockVar
  				selector: (increment key > 0 ifTrue: [#<=] ifFalse: [#>=])
  				arguments: (Array with: limit)
  				precedence: precedence from: encoder
  				sourceRange: (myRange first to: blockRange first).
  	incStmt := AssignmentNode new
  				variable: blockVar
  				value: (MessageNode new
  							receiver: blockVar selector: #+
  							arguments: (Array with: increment)
  							precedence: precedence from: encoder)
  				from: encoder
  				sourceRange: (myRange last to: myRange last).
  	arguments := (Array with: limit with: increment with: block),
  					(Array with: initStmt with: test with: incStmt with: limitInit).
+ 	block noteOptimizedIn: self.
- 	block noteOptimized.
  	^true!

Item was added:
+ ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitBlockNode: (in category 'visiting') -----
+ visitBlockNode: aBlockNode
+ 	| savedWritten |
+ 	"If we're in the optimized block in one side of an optimized ifTrue:ifFalse: et al
+ 	 leave it to the enclosing visitMessageNode: activation to handle merging written."
+ 	inOptimizedBlock ifTrue:
+ 		[^super visitBlockNode: aBlockNode].
+ 	"If we're not then don't update written because without evaluating the guard(s)
+ 	 we can't tell if the block is evaluated or not, and we must avoid false positives."
+ 	savedWritten := written copy.
+ 	super visitBlockNode: aBlockNode.
+ 	written := savedWritten!

Item was changed:
  ----- Method: AssignmentNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitAssignmentNode: self!
- 	aVisitor visitAssignmentNode: self!

Item was added:
+ ----- Method: ParseNode>>sizeForBlockValue: (in category 'code generation') -----
+ sizeForBlockValue: encoder
+ 	"Answer the size for evaluating the last statement in a block"
+ 	^self sizeForValue: encoder!

Item was changed:
  ----- Method: BlockNode>>analyseTempsWithin:rootNode:assignmentPools: (in category 'code generation (closures)') -----
  analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
  	| effectiveScope blockStart |
  	effectiveScope := optimized
  						ifTrue: [actualScopeIfOptimized := scopeBlock]
  						ifFalse: [self].
  
  	arguments ifNotNil:
  		[arguments do: [:temp| temp definingScope: self]].
  	temporaries ifNotNil:
  		[temporaries do: [:temp| temp definingScope: self]].
  
  	optimized ifFalse: "if optimized this isn't an actual scope"
  		[rootNode noteBlockEntry:
  			[:entryNumber|
  			 blockExtent := (blockStart := entryNumber) to: 0]].
  
  	"Need to enumerate a copy because closure analysis can add a statement
  	 via ifHasRemoteTempNodeEnsureInitializationStatementExists:."
  	statements copy do:
  		[:statement|
  		 statement analyseTempsWithin: effectiveScope rootNode: rootNode assignmentPools: assignmentPools].
  
+ 	optimized
+ 		ifTrue: "if optimized loop need to add nils for any temps read before written"
+ 			[optimizedMessageNode isOptimizedLoop ifTrue:
+ 				[self nilReadBeforeWrittenTemps]]
+ 		ifFalse: "if optimized this isn't an actual scope"
+ 			[rootNode noteBlockExit:
+ 				[:exitNumber|
+ 				 blockExtent := blockStart to: exitNumber]].
- 	optimized ifFalse: "if optimized this isn't an actual scope"
- 		[rootNode noteBlockExit:
- 			[:exitNumber|
- 			 blockExtent := blockStart to: exitNumber]].
  
  	"Now that the analysis is done move any temps that need to be moved."
  	self postNumberingProcessTempsWithin: effectiveScope rootNode: rootNode.
  
  	"This is simply a nicety for compiler developers..."
  	temporaries do:
  		[:temp|
  		(temp isIndirectTempVector and: [temp name includes: $?]) ifTrue:
  			[temp name: temp definingScope remoteTempNodeName]]!

Item was changed:
  ----- Method: NewArrayNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitNewArrayNode: self!
- 	aVisitor visitNewArrayNode: self!

Item was changed:
  ParseNode subclass: #BlockNode
+ 	instanceVariableNames: 'arguments statements returns nArgsNode size remoteCopyNode temporaries optimized optimizedMessageNode actualScopeIfOptimized blockExtent remoteTempNode copiedValues closureCreationNode startOfLastStatement'
- 	instanceVariableNames: 'arguments statements returns nArgsNode size remoteCopyNode temporaries optimized actualScopeIfOptimized blockExtent remoteTempNode copiedValues closureCreationNode startOfLastStatement'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Compiler-ParseNodes'!
  
  !BlockNode commentStamp: '<historical>' prior: 0!
  I represent a bracketed block with 0 or more arguments and 1 or more statements. If I am initialized with no statements, I create one. I have a flag to tell whether my last statement returns a value from the enclosing method. My last three fields remember data needed for code generation. I can emit for value in the usual way, in which case I create a literal method (actually a context remotely copied) to be evaluated by sending it value: at run time. Or I can emit code to be evaluated in line; this only happens at the top level of a method and in conditionals and while-loops, none of which have arguments.!

Item was changed:
  ----- Method: MessageNode>>transformIfFalseIfTrue: (in category 'macro transformations') -----
  transformIfFalseIfTrue: encoder
  	^(self checkBlock: (arguments at: 1) as: 'False arg' from: encoder)
  	   and: [(self checkBlock: (arguments at: 2) as: 'True arg' from: encoder)
  	   and: [selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
  			arguments swap: 1 with: 2.
+ 			arguments do: [:arg| arg noteOptimizedIn: self].
- 			arguments do: [:arg| arg noteOptimized].
  			true]]!

Item was changed:
  ----- Method: BlockNode>>emitForEvaluatedValue:on: (in category 'code generation') -----
  emitForEvaluatedValue: stack on: aStream
  	self emitExceptLast: stack on: aStream.
+ 	statements last emitForBlockValue: stack on: aStream.
- 	statements last emitForValue: stack on: aStream.
  !

Item was changed:
  ----- Method: ParseNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	"Accept a visitor by double-dispatching to a type-specific method on the visitor, e.g. visitBlockNode:.
+ 	 All such implementations under ParseNode should answer the result of the dispatch, e.g.
+ 		^aVisitor visitBlockNode: self"
  	^self subclassResponsibility!

Item was changed:
  ----- Method: BraceNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitBraceNode: self!
- 	aVisitor visitBraceNode: self!

Item was changed:
  ----- Method: InstanceVariableNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitInstanceVariableNode: self!
- 	aVisitor visitInstanceVariableNode: self!

Item was changed:
  ----- Method: ReturnNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitReturnNode: self!
- 	aVisitor visitReturnNode: self!

Item was changed:
  ----- Method: MessageNode>>transformIfTrue: (in category 'macro transformations') -----
  transformIfTrue: encoder
  	(self transformBoolean: encoder)
  		ifTrue: 
  			[arguments := 
  				Array 
+ 					with: ((arguments at: 1) noteOptimizedIn: self)
+ 					with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self).
- 					with: (arguments at: 1) noteOptimized
- 					with: (BlockNode withJust: NodeNil) noteOptimized.
  			^true]
  		ifFalse: 
  			[^false]!

Item was changed:
  ----- Method: MessageNode>>transformIfNilIfNotNil: (in category 'macro transformations') -----
  transformIfNilIfNotNil: encoder
  	"vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we
  	 transform the receiver to
  		(var := receiver)
  	 which is further transformed to
  		(var := receiver) == nil ifTrue: .... ifFalse: ...
  	 This does not allow the block variable to shadow an existing temp, but it's no different
  	 from how to:do: is done."
  	| ifNotNilArg |
  	ifNotNilArg := arguments at: 2.
  	((self checkBlock: (arguments at: 1) as: 'Nil arg' from: encoder)
  	  and: [self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1]) ifFalse:
  		[^false].
  
  	ifNotNilArg numberOfArguments = 1 ifTrue:
  		[receiver := AssignmentNode new
  						variable: ifNotNilArg firstArgument
  						value: receiver].
  
  	selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
  	receiver := MessageNode new
  					receiver: receiver
  					selector: #==
  					arguments: (Array with: NodeNil)
  					precedence: 2
  					from: encoder.
+ 	arguments do: [:arg| arg noteOptimizedIn: self].
- 	arguments do: [:arg| arg noteOptimized].
  	^true!

Item was changed:
  ----- Method: MessageNode>>transformOr: (in category 'macro transformations') -----
  transformOr: encoder
  	(self transformBoolean: encoder)
  		ifTrue: 
  			[arguments := 
  				Array 
+ 					with: ((BlockNode withJust: NodeTrue) noteOptimizedIn: self)
+ 					with: ((arguments at: 1) noteOptimizedIn: self).
- 					with: (BlockNode withJust: NodeTrue) noteOptimized
- 					with: (arguments at: 1) noteOptimized.
  			^true]
  		ifFalse: 
  			[^false]!

Item was changed:
  ----- Method: MessageNode>>transformIfNotNilIfNil: (in category 'macro transformations') -----
  transformIfNotNilIfNil: encoder
  	"vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we
  	 transform the receiver to
  		(var := receiver)
  	 which is further transformed to
  		(var := receiver) == nil ifTrue: .... ifFalse: ...
  	 This does not allow the block variable to shadow an existing temp, but it's no different
  	 from how to:do: is done."
  	| ifNotNilArg |
  	ifNotNilArg := arguments at: 1.
  	((self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1)
  	  and: [self checkBlock: (arguments at: 2) as: 'Nil arg' from: encoder]) ifFalse:
  		[^false].
  
  	ifNotNilArg numberOfArguments = 1 ifTrue:
  		[receiver := AssignmentNode new
  						variable: ifNotNilArg firstArgument
  						value: receiver].
  
  	selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
  	receiver := MessageNode new
  					receiver: receiver
  					selector: #==
  					arguments: (Array with: NodeNil)
  					precedence: 2
  					from: encoder.
  	arguments swap: 1 with: 2.
+ 	arguments do: [:arg| arg noteOptimizedIn: self].
- 	arguments do: [:arg| arg noteOptimized].
  	^true!

Item was changed:
  ----- Method: MethodNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitMethodNode: self!
- 	aVisitor visitMethodNode: self.
- 	^aVisitor!

Item was changed:
  ----- Method: MessageNode>>transformIfNil: (in category 'macro transformations') -----
  transformIfNil: encoder
  
  	"vb: Removed the original transformBoolean: which amounds to a test we perform in each of the branches below."
  	(MacroSelectors at: special) = #ifNotNil: ifTrue:
  		[(self checkBlock: arguments first as: 'ifNotNil arg' from: encoder maxArgs: 1) ifFalse:
  			[^false].
  
  		"Transform 'ifNotNil: [stuff]' to 'ifNil: [nil] ifNotNil: [stuff]'.
  		Slightly better code and more consistent with decompilation."
  		self noteSpecialSelector: #ifNil:ifNotNil:.
  		selector := SelectorNode new key: (MacroSelectors at: special) code: #macro.
  		arguments := Array
+ 						with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self)
+ 						with: (arguments first noteOptimizedIn: self).
- 						with: (BlockNode withJust: NodeNil) noteOptimized
- 						with: arguments first noteOptimized.
  		(self transform: encoder) ifFalse:
  			[self error: 'compiler logic error'].
  		^true].
  	(self checkBlock: arguments first as: 'ifNil arg' from: encoder) ifFalse:
  		[^false].
+ 	arguments first noteOptimizedIn: self.
- 	arguments first noteOptimized.
  	^true!

Item was changed:
  ----- Method: MessageNode>>transformAnd: (in category 'macro transformations') -----
  transformAnd: encoder
  	(self transformBoolean: encoder)
  		ifTrue: 
  			[arguments := 
  				Array 
+ 					with: ((arguments at: 1) noteOptimizedIn: self)
+ 					with: ((BlockNode withJust: NodeFalse) noteOptimizedIn: self).
- 					with: (arguments at: 1) noteOptimized
- 					with: (BlockNode withJust: NodeFalse) noteOptimized.
  			^true]
  		ifFalse: 
  			[^false]!

Item was changed:
  ----- Method: MessageNode>>transformCase: (in category 'macro transformations') -----
  transformCase: encoder
  
  	| caseNode |
  	caseNode := arguments first.
  	(caseNode isMemberOf: BraceNode) ifTrue:
  		[((caseNode blockAssociationCheck: encoder)
  		  and: [arguments size = 1
  			    or: [self checkBlock: arguments last as: 'otherwise arg' from: encoder]]) ifFalse:
  			[^false].
  		 caseNode elements do:
  			[:messageNode|
+ 			messageNode receiver noteOptimizedIn: self.
+ 			messageNode arguments first noteOptimizedIn: self].
- 			messageNode receiver noteOptimized.
- 			messageNode arguments first noteOptimized].
  		 arguments size = 2 ifTrue:
+ 			[arguments last noteOptimizedIn: self].
- 			[arguments last noteOptimized].
  		 ^true].
  	(caseNode canBeSpecialArgument and: [(caseNode isMemberOf: BlockNode) not]) ifTrue:
  		[^false]. "caseOf: variable"
  	^encoder notify: 'caseOf: argument must be a brace construct or a variable'!

Item was changed:
  ----- Method: FieldNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitFieldNode: self!
- 	aVisitor visitFieldNode: self!

Item was changed:
  ----- Method: SelectorNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitSelectorNode: self!
- 	aVisitor visitSelectorNode: self!

Item was added:
+ ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>initialize (in category 'initialize-release') -----
+ initialize
+ 	inOptimizedBlock := false!

Item was changed:
  ----- Method: MessageNode>>transformIfTrueIfFalse: (in category 'macro transformations') -----
  transformIfTrueIfFalse: encoder
  	^(self checkBlock: (arguments at: 1) as: 'True arg' from: encoder)
  	   and: [(self checkBlock: (arguments at: 2) as: 'False arg' from: encoder)
+ 	   and: [arguments do: [:arg| arg noteOptimizedIn: self].
- 	   and: [arguments do: [:arg| arg noteOptimized].
  			true]]!

Item was changed:
  ----- Method: MessageNode>>transformIfFalse: (in category 'macro transformations') -----
  transformIfFalse: encoder
  	(self transformBoolean: encoder)
  		ifTrue: 
  			[arguments := 
  				Array 
+ 					with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self)
+ 					with: ((arguments at: 1) noteOptimizedIn: self).
- 					with: (BlockNode withJust: NodeNil) noteOptimized
- 					with: (arguments at: 1) noteOptimized.
  			^true]
  		ifFalse:
  			[^false]!

Item was changed:
  ----- Method: BlockNode>>sizeForEvaluatedValue: (in category 'code generation') -----
  sizeForEvaluatedValue: encoder
  
  	^(self sizeExceptLast: encoder)
+ 		+ (statements last sizeForBlockValue: encoder)!
- 		+ (statements last sizeForValue: encoder)!

Item was added:
+ ----- Method: BlockNode>>nilReadBeforeWrittenTemps (in category 'code generation (closures)') -----
+ nilReadBeforeWrittenTemps
+ 	| visitor readBeforeWritten |
+ 	self accept: (visitor := OptimizedBlockLocalTempReadBeforeWrittenVisitor new).
+ 	readBeforeWritten := visitor readBeforeWritten.
+ 	temporaries reverseDo:
+ 		[:temp|
+ 		((readBeforeWritten includes: temp)
+ 		 and: [temp isRemote not]) ifTrue:
+ 			[statements addFirst: (AssignmentNode new variable: temp value: NodeNil)]]!

Item was changed:
  ----- Method: Encoder>>encodeVariable:sourceRange:ifUnknown: (in category 'encoding') -----
  encodeVariable: name sourceRange: range ifUnknown: action
  	| varNode |
  	varNode := scopeTable at: name
  			ifAbsent: 
  				[(self lookupInPools: name 
  					ifFound: [:assoc | varNode := self global: assoc name: name])
  					ifTrue: [varNode]
+ 					ifFalse: [^action value]].
- 					ifFalse: [action value]].
  	range ifNotNil: [
  		name first canBeGlobalVarInitial ifTrue:
  			[globalSourceRanges addLast: { name. range. false }]. ].
  
  	(varNode isTemp and: [varNode scope < 0]) ifTrue: [
  		OutOfScopeNotification signal ifFalse: [ ^self notify: 'out of scope'].
  	].
  	^ varNode!

Item was changed:
  ----- Method: LiteralNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitLiteralNode: self!
- 	aVisitor visitLiteralNode: self!

Item was added:
+ ----- Method: ParseNode>>emitForBlockValue:on: (in category 'code generation') -----
+ emitForBlockValue: stack on: aStream
+ 	"Generate code for evaluating the last statement in a block"
+ 	^self emitForValue: stack on: aStream!

Item was changed:
  ----- Method: VariableNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitVariableNode: self!
- 	aVisitor visitVariableNode: self!

Item was changed:
  ----- Method: BlockNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitBlockNode: self!
- 	aVisitor visitBlockNode: self!

Item was added:
+ ----- Method: BlockNode>>noteOptimizedIn: (in category 'code generation (closures)') -----
+ noteOptimizedIn: anOptimizedMessageNode
+ 	optimized := true.
+ 	optimizedMessageNode := anOptimizedMessageNode!

Item was added:
+ ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitAssignmentNode: (in category 'visiting') -----
+ visitAssignmentNode: anAssignmentNode
+ 	anAssignmentNode value accept: self.
+ 	anAssignmentNode variable isTemp
+ 		ifTrue:
+ 			[written ifNil: [written := IdentitySet new].
+ 			 written add: anAssignmentNode variable]
+ 		ifFalse:
+ 			[anAssignmentNode variable accept: self]!

Item was added:
+ ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitMessageNode: (in category 'visiting') -----
+ visitMessageNode: aMessageNode
+ 	| savedWritten writtenPostFirstArm |
+ 	(aMessageNode isOptimized
+ 	 and: [#(ifTrue:ifFalse: ifFalse:ifTrue: ifNil:ifNotNil: ifNotNil:ifNil:) includes: aMessageNode selector key]) ifFalse:
+ 		[^super visitMessageNode: aMessageNode].
+ 	aMessageNode receiver accept: self.
+ 	aMessageNode selector accept: self.
+ 	savedWritten := written copy.
+ 	aMessageNode argumentsInEvaluationOrder
+ 		do: [:argument|
+ 			argument isBlockNode
+ 				ifTrue: [| savedIOB |
+ 					savedIOB := inOptimizedBlock.
+ 					inOptimizedBlock := true.
+ 					[argument accept: self]
+ 						ensure: [inOptimizedBlock := savedIOB]]
+ 				ifFalse: [argument accept: self]]
+ 		separatedBy:
+ 			[writtenPostFirstArm := written.
+ 			 written := savedWritten].
+ 	(written notNil
+ 	 and: [writtenPostFirstArm notNil]) ifTrue:
+ 		[written := written intersection: writtenPostFirstArm]!

Item was added:
+ ParseNodeVisitor subclass: #OptimizedBlockLocalTempReadBeforeWrittenVisitor
+ 	instanceVariableNames: 'inOptimizedBlock readBeforeWritten written'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Compiler-Support'!
+ 
+ !OptimizedBlockLocalTempReadBeforeWrittenVisitor commentStamp: '<historical>' prior: 0!
+ Answer the set of temporary variables that are read before they are written in the visited parse tree.  Used by the compiler to detect those block-local temporaries of blocks in optimized loops that require nilling to prevent a value from a previous iteration persisting into a subsequent one.!

Item was changed:
  ----- Method: LiteralVariableNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitLiteralVariableNode: self!
- 	aVisitor visitLiteralVariableNode: self!

Item was changed:
  ----- Method: MessageNode>>transformWhile: (in category 'macro transformations') -----
  transformWhile: encoder
  	(self checkBlock: receiver as: 'receiver' from: encoder) ifFalse:
  		[^false].
  	arguments size = 0 ifTrue:  "transform bodyless form to body form"
  		[selector := SelectorNode new
  						key: (special = 10 ifTrue: [#whileTrue:] ifFalse: [#whileFalse:])
  						code: #macro.
+ 		 arguments := Array with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self).
+ 		 receiver noteOptimizedIn: self.
- 		 arguments := Array with: (BlockNode withJust: NodeNil) noteOptimized.
- 		 receiver noteOptimized.
  		 ^true].
  	^(self transformBoolean: encoder)
+ 	   and: [receiver noteOptimizedIn: self.
+ 			arguments first noteOptimizedIn: self.
- 	   and: [receiver noteOptimized.
- 			arguments first noteOptimized.
  			true]!

Item was changed:
  ----- Method: MessageNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitMessageNode: self!
- 	aVisitor visitMessageNode: self!

Item was added:
+ ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>visitTempVariableNode: (in category 'visiting') -----
+ visitTempVariableNode: aTempVariableNode
+ 	(aTempVariableNode isArg
+ 	 or: [written notNil
+ 		and: [written includes: aTempVariableNode]]) ifTrue:
+ 		[^self].
+ 	readBeforeWritten ifNil:
+ 		[readBeforeWritten := IdentitySet new].
+ 	readBeforeWritten add: aTempVariableNode!

Item was changed:
  ----- Method: CascadeNode>>accept: (in category 'visiting') -----
  accept: aVisitor
+ 	^aVisitor visitCascadeNode: self!
- 	aVisitor visitCascadeNode: self!

Item was added:
+ ----- Method: OptimizedBlockLocalTempReadBeforeWrittenVisitor>>readBeforeWritten (in category 'accessing') -----
+ readBeforeWritten
+ 	^readBeforeWritten ifNil: [IdentitySet new]!

Item was removed:
- ----- Method: BlockNode>>noteOptimized (in category 'code generation (closures)') -----
- noteOptimized
- 	optimized := true!




More information about the Squeak-dev mailing list