[squeak-dev] The Trunk: Compiler-eem.353.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Apr 26 01:44:08 UTC 2017


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

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

Name: Compiler-eem.353
Author: eem
Time: 25 April 2017, 6:43:55.473745 pm
UUID: 76c9fea6-d855-42cd-aeb5-9cb0753f6f9d
Ancestors: Compiler-ul.352

Fix the order-of-evaluation bug with inlined to:[by:]do: loops.

Fix the decompiler to correctly decompile the new ordering.
Use isFoo methods instead of isMemberOf: in the new decompiler code.
Nuke some obsolete decompilation methods.

Make the postscript re3compile all senders of to:do: or to:by:do:.

=============== Diff against Compiler-ul.352 ===============

Item was changed:
  ----- Method: AssignmentNode>>toDoIncrement: (in category 'initialize-release') -----
  toDoIncrement: var
+ 	^(var = variable
+ 	   and: [value isMessageNode]) ifTrue:
+ 		[value toDoIncrement: var]!
- 	var = variable ifFalse: [^ nil].
- 	(value isMemberOf: MessageNode) 
- 		ifTrue: [^ value toDoIncrement: var]
- 		ifFalse: [^ nil]!

Item was changed:
  InstructionStream subclass: #Decompiler
+ 	instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase numLocalTemps blockStartsToTempVars tempVarCount lastJumpIfPcStack tempReadCounts'
- 	instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase numLocalTemps blockStartsToTempVars tempVarCount lastJumpIfPcStack'
  	classVariableNames: 'ArgumentFlag CascadeFlag CaseFlag IfNilFlag'
  	poolDictionaries: ''
  	category: 'Compiler-Kernel'!
  
  !Decompiler commentStamp: 'nice 2/3/2011 22:54' prior: 0!
  I decompile a method in three phases:
  	Reverser: postfix byte codes -> prefix symbolic codes (nodes and atoms)
  	Parser: prefix symbolic codes -> node tree (same as the compiler)
  	Printer: node tree -> text (done by the nodes)
  	
  
  instance vars:
  
  	constructor <DecompilerConstructor> an auxiliary knowing how to generate Abstract Syntax Tree (node tree)
  	method <CompiledMethod> the method being decompiled
  	instVars <Array of: String> the instance variables of the class implementing method
  	tempVars <String | (OrderedCollection of: String)> hold the names of temporary variables (if known)
  		NOTE: POLYMORPHISM WILL BE RESOLVED IN #initSymbols:
  	constTable <Collection of: ParseNode> parse node associated with byte encoded constants (nil true false 0 1 -1 etc...)
  	stack <OrderedCollection of: (ParseNode | String | Integer) > multipurpose...
  	statements <OrderedCollection of: ParseNode> the statements of the method being decompiled 
  	lastPc <Integer>
  	exit <Integer>
  	caseExits <OrderedCollection of: Integer> - stack of exit addresses that have been seen in the branches of caseOf:'s
  	lastJumpPc <Integer>
  	lastReturnPc <Integer>
  	limit <Integer>
  	hasValue <Boolean>
  	blockStackBase <Integer>
  	numLocaltemps <Integer | Symbol> - number of temps local to a block; also a flag indicating decompiling a block
  	blockStartsToTempVars <Dictionary key: Integer value: (OrderedCollection of: String)>
  	tempVarCount <Integer> number of temp vars used by the method
  	lastJumpIfPcStack <OrderedCollection of: Integer> the value of program counter just before the last encountered conditional jumps!

Item was removed:
- ----- Method: Decompiler>>blockScopeRefersOnlyOnceToTemp: (in category 'private') -----
- blockScopeRefersOnlyOnceToTemp: offset
- 	| nRefs byteCode extension scanner scan |
- 	scanner := InstructionStream on: method.
- 	nRefs := 0.
- 	scan := offset <= 15
- 				ifTrue:
- 					[byteCode := 16 + offset.
- 					 [:instr |
- 					  instr = byteCode ifTrue:
- 						[nRefs := nRefs + 1].
- 					  nRefs > 1]]
- 				ifFalse:
- 					[extension := 64 + offset.
- 					 [:instr |
- 					  (instr = 128 and: [scanner followingByte = extension]) ifTrue:
- 						[nRefs := nRefs + 1].
- 					   nRefs > 1]].
- 	self scanBlockScopeFor: pc from: method initialPC to: method endPC with: scan scanner: scanner.
- 	^nRefs = 1!

Item was removed:
- ----- Method: Decompiler>>convertToDoLoop (in category 'private') -----
- convertToDoLoop
- 	"If statements contains the pattern
- 		var := startExpr.
- 		[var <= limit] whileTrue: [...statements... var := var + incConst]
- 	then replace this by
- 		startExpr to: limit by: incConst do: [:var | ...statements...]"
- 	| leaveOnStack initStmt toDoStmt limitStmt |
- 	leaveOnStack := false.
- 	(stack notEmpty
- 	 and: [stack last isAssignmentNode])
- 		ifTrue:
- 			[initStmt := stack last.
- 			 (toDoStmt := statements last toDoFromWhileWithInit: initStmt) ifNil:
- 				[^self].
- 			 stack removeLast.
- 			 statements removeLast; addLast: toDoStmt.
- 			 leaveOnStack := true]
- 		ifFalse:
- 			[statements size < 2 ifTrue:
- 				[^self].
- 			initStmt := statements at: statements size-1.
- 			(toDoStmt := statements last toDoFromWhileWithInit: initStmt) ifNil:
- 				[^self].
- 			statements removeLast; removeLast; addLast: toDoStmt].
- 	initStmt variable scope: -1.  "Flag arg as block temp"
- 
- 	"Attempt further conversion of the pattern
- 		limitVar := limitExpr.
- 		startExpr to: limitVar by: incConst do: [:var | ...statements...]
- 	to
- 		startExpr to: limitExpr by: incConst do: [:var | ...statements...].
- 	The complication here is that limitVar := limitExpr's value may be used, in which case it'll
- 	be statements last, or may not be used, in which case it'll be statements nextToLast."
- 	statements size < 2 ifTrue:
- 		[leaveOnStack ifTrue:
- 			[stack addLast: statements removeLast].
- 			 ^self].
- 	limitStmt := statements last.
- 	((limitStmt isMemberOf: AssignmentNode)
- 		and: [limitStmt variable isTemp
- 		and: [limitStmt variable == toDoStmt arguments first]]) ifFalse:
- 			[limitStmt := statements at: statements size-1.
- 			((limitStmt isMemberOf: AssignmentNode)
- 				and: [limitStmt variable isTemp
- 				and: [limitStmt variable == toDoStmt arguments first]]) ifFalse:
- 					[leaveOnStack ifTrue:
- 						[stack addLast: statements removeLast].
- 					^self]].
- 
- 	(self blockScopeRefersOnlyOnceToTemp: limitStmt variable fieldOffset) ifFalse:
- 		[^self].
- 	toDoStmt arguments at: 1 put: limitStmt value.
- 	limitStmt variable scope: -2.  "Flag limit var so it won't print"
- 	statements last == limitStmt
- 		ifTrue: [statements removeLast]
- 		ifFalse: [statements removeLast; removeLast; addLast: toDoStmt]!

Item was added:
+ ----- Method: Decompiler>>convertToDoLoop: (in category 'private') -----
+ convertToDoLoop: blockBodyTempCounts
+ 	"If statements contains the pattern
+ 		var := startExpr.
+ 		[var <= limit] whileTrue: [...statements... var := var + incConst]
+ 	or
+ 		var := startExpr.
+ 		limit := limitExpr.
+ 		[var <= limit] whileTrue: [...statements... var := var + incConst]
+ 	then replace this by
+ 		startExpr to: limit by: incConst do: [:var | ...statements...]
+ 	 and answer true."
+ 	| whileStmt incrStmt initStmt limitStmt toDoStmt |
+ 	whileStmt := statements last.
+ 	incrStmt := whileStmt arguments first statements last.
+ 	incrStmt isAssignmentNode ifFalse:
+ 		[^false].
+ 	(self startAndLimitFor: incrStmt variable from: stack into:
+ 							[:startExpr :limitExpr| initStmt := startExpr. limitStmt := limitExpr])
+ 		ifTrue:
+ 			[| limitInStatements |
+ 			 limitInStatements := limitStmt isNil
+ 								    and: [statements size > 1
+ 								    and: [self startAndLimitFor: incrStmt variable from: { stack last. (statements last: 2) first } into:
+ 												[:startExpr :limitExpr| limitStmt := limitExpr]]].
+ 			(toDoStmt := statements last toDoFromWhileWithCounts: blockBodyTempCounts init: initStmt limit: limitStmt) ifNil:
+ 				[^false].
+ 			 limitInStatements
+ 				ifTrue:
+ 					[stack
+ 						removeLast;
+ 						addLast: toDoStmt.
+ 					 statements removeLast: 2]
+ 				ifFalse:
+ 					[stack
+ 						removeLast: (limitStmt ifNil: [1] ifNotNil: [2]);
+ 						addLast: toDoStmt.
+ 					 statements removeLast]]
+ 		ifFalse:
+ 			[(self startAndLimitFor: incrStmt variable from: statements allButLast into:
+ 							[:startExpr :limitExpr| initStmt := startExpr. limitStmt := limitExpr]) ifFalse:
+ 				[^false].
+ 			 (toDoStmt := statements last toDoFromWhileWithCounts: blockBodyTempCounts init: initStmt limit: limitStmt) ifNil:
+ 				[^false].
+ 			 statements
+ 				removeLast: (limitStmt ifNil: [2] ifNotNil: [3]);
+ 				addLast: toDoStmt].
+ 	self markTemp: initStmt variable asOutOfScope: -1. "Flag arg as out of scope"
+ 	initStmt variable beBlockArg.
+ 	limitStmt ifNotNil:
+ 		[self markTemp: limitStmt variable asOutOfScope: -2.
+ 		 toDoStmt arguments at: 1 put: limitStmt value]. "Flag limit as hidden"
+ 	^true!

Item was changed:
  ----- Method: Decompiler>>initSymbols: (in category 'initialize-release') -----
  initSymbols: aClass
  	constructor method: method class: aClass literals: method literals.
  	constTable := constructor codeConstants.
  	instVars := Array new: aClass instSize.
  	tempVarCount := method numTemps.
  	"(tempVars isNil
  	 and: [method holdsTempNames]) ifTrue:
  		[tempVars := method tempNamesString]."
  	tempVars isString
  		ifTrue:
  			[blockStartsToTempVars := self mapFromBlockStartsIn: method
  											toTempVarsFrom: tempVars
  											constructor: constructor.
  			 tempVars := blockStartsToTempVars at: method initialPC]
  		ifFalse:
  			[| namedTemps |
  			namedTemps := tempVars ifNil: [(1 to: tempVarCount) collect: [:i| 't', i printString]].
  			tempVars := (1 to: tempVarCount) collect:
  							[:i | i <= namedTemps size
  								ifTrue: [constructor codeTemp: i - 1 named: (namedTemps at: i)]
  								ifFalse: [constructor codeTemp: i - 1]]].
  	1 to: method numArgs do:
  		[:i|
+ 		(tempVars at: i) beMethodArg].
+ 	tempReadCounts := Dictionary new!
- 		(tempVars at: i) beMethodArg]!

Item was changed:
  ----- Method: Decompiler>>jump:if: (in category 'instruction decoding') -----
  jump: dist if: condition
  
  	| savePc sign elsePc elseStart end cond ifExpr thenBlock elseBlock
+ 	  thenJump elseJump condHasValue isIfNil saveStack |
- 	  thenJump elseJump condHasValue isIfNil saveStack blockBody blockArgs |
  	lastJumpIfPcStack addLast: lastPc.
  	stack last == CascadeFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]].
  	elsePc := lastPc.
  	elseStart := pc + dist.
  	end := limit.
  	"Check for bfp-jmp to invert condition.
  	Don't be fooled by a loop with a null body."
  	sign := condition.
  	savePc := pc.
  	self interpretJump ifNotNil:
  		[:elseDist|
  		 (elseDist >= 0 and: [elseStart = pc]) ifTrue:
  			 [sign := sign not.  elseStart := pc + elseDist]].
  	pc := savePc.
  	ifExpr := stack removeLast.
  	(isIfNil := stack size > 0 and: [stack last == IfNilFlag]) ifTrue:
  		[stack removeLast].
  	saveStack := stack.
  	stack := OrderedCollection new.
  	thenBlock := self blockTo: elseStart.
  	condHasValue := hasValue or: [isIfNil].
  	"ensure jump is within block (in case thenExpr returns)"
  	thenJump := exit <= end ifTrue: [exit] ifFalse: [elseStart].
  	"if jump goes back, then it's a loop"
  	thenJump < elseStart
  		ifTrue:
+ 			[| blockBody blockArgs savedReadCounts blockBodyReadCounts selector |
+ 			 "Must be a while loop...
- 			["Must be a while loop...
  			  thenJump will jump to the beginning of the while expr.  In the case of while's
  			  with a block in the condition, the while expr should include more than just
+ 			  the last expression: find all the statements needed by searching for the node
+ 			  with the relevant pc."
- 			  the last expression: find all the statements needed by re-decompiling."
  			stack := saveStack.
+ 			savedReadCounts := tempReadCounts copy.
  			pc := thenJump.
  			blockBody := self statementsTo: elsePc.
+ 			blockBodyReadCounts := tempReadCounts.
+ 			savedReadCounts keysAndValuesDo:
+ 				[:temp :count|
+ 				 blockBodyReadCounts at: temp put: (blockBodyReadCounts at: temp) - count].
+ 			tempReadCounts := savedReadCounts.
  			"discard unwanted statements from block"
  			blockBody size - 1 timesRepeat: [statements removeLast].
  			blockArgs := thenBlock statements = constructor codeEmptyBlock statements
  							ifTrue: [#()]
  							ifFalse: [{ thenBlock }].
+ 			selector := blockArgs isEmpty
+ 							ifTrue: [sign ifTrue: [#whileFalse] ifFalse: [#whileTrue]]
+ 							ifFalse: [sign ifTrue: [#whileFalse:] ifFalse: [#whileTrue:]].
  			statements addLast:
  				(constructor
  					codeMessage: (constructor codeBlock: blockBody returns: false)
+ 					selector: (constructor codeSelector: selector code: #macro)
- 					selector: (constructor
- 								codeSelector: (blockArgs isEmpty
- 												ifTrue:
- 													[sign
- 														ifTrue: [#whileFalse]
- 														ifFalse: [#whileTrue]]
- 												ifFalse:
- 													[sign
- 														ifTrue: [#whileFalse:]
- 														ifFalse: [#whileTrue:]])
- 								code: #macro)
  					arguments: blockArgs).
  			pc := elseStart.
+ 			selector == #whileTrue: ifTrue:
+ 				[self convertToDoLoop: blockBodyReadCounts]]
- 			self convertToDoLoop]
  		ifFalse:
  			["Must be a conditional..."
  			elseBlock := self blockTo: thenJump.
  			elseJump := exit.
  			"if elseJump is backwards, it is not part of the elseExpr"
  			elseJump < elsePc ifTrue:
  				[pc := lastPc].
  			cond := isIfNil
  						ifTrue:
  							[constructor
  								codeMessage: ifExpr ifNilReceiver
  								selector: (constructor
  											codeSelector: (sign ifTrue: [#ifNotNil:] ifFalse: [#ifNil:])
  											code: #macro)
  								arguments: (Array with: thenBlock)]
  						ifFalse:
  							[constructor
  								codeMessage: ifExpr
  								selector: (constructor codeSelector: #ifTrue:ifFalse: code: #macro)
  								arguments:	(sign
  												ifTrue: [{elseBlock. thenBlock}]
  												ifFalse: [{thenBlock. elseBlock}])].
  			stack := saveStack.
  			condHasValue
  				ifTrue: [stack addLast: cond]
  				ifFalse: [statements addLast: cond]].
  	lastJumpIfPcStack removeLast.!

Item was added:
+ ----- Method: Decompiler>>markTemp:asOutOfScope: (in category 'private') -----
+ markTemp: tempVarNode asOutOfScope: scopeFlag
+ 	tempVarNode scope: scopeFlag.
+ 	tempReadCounts removeKey: tempVarNode ifAbsent: []!

Item was changed:
  ----- Method: Decompiler>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
  popIntoTemporaryVariable: offset
  	| maybeTVTag tempVector start |
  	maybeTVTag := stack last.
  	((maybeTVTag isMemberOf: Association)
  	 and: [maybeTVTag key == #pushNewArray]) ifTrue:
  		[blockStartsToTempVars notNil "implies we were intialized with temp names."
  			ifTrue: "Use the provided temps"
  				[self assert: ((tempVector := tempVars at: offset + 1 ifAbsent: [ParseNode basicNew]) isTemp
  							 and: [tempVector isIndirectTempVector
  							 and: [tempVector remoteTemps size = maybeTVTag value size]])]
  			ifFalse: "Synthesize some remote temps"
  				[tempVector := maybeTVTag value.
  				 offset + 1 <= tempVars size
  					ifTrue:
  						[start := 2.
  						 tempVector at: 1 put: (tempVars at: offset + 1)]
  					ifFalse:
  						[tempVars := (Array new: offset + 1)
  										replaceFrom: 1
  										to: tempVars size
  										with: tempVars.
  						start := 1].
  				 start to: tempVector size do:
  					[:i|
  					tempVector
  						at: i
  						put: (constructor
  								codeTemp: numLocalTemps + offset + i - 1
  								named: 't', (tempVarCount + i) printString)].
  				tempVars at: offset + 1 put: (constructor codeRemoteTemp: offset + 1 remoteTemps: tempVector)].
  		 tempVarCount := tempVarCount + maybeTVTag value size.
  		 stack removeLast.
  		 ^self].
+ 	stack addLast: (offset >= tempVars size
+ 						ifTrue: "Handle the case of chained LiteralVariableBinding assigments"
+ 							[stack at: (offset + 1 - tempVars size)]
+ 						ifFalse: "A regular argument or temporary"
+ 							[tempVars at: offset + 1]).
+ 	self doStore: statements!
- 	self pushTemporaryVariable: offset; doStore: statements!

Item was changed:
  ----- Method: Decompiler>>pushTemporaryVariable: (in category 'instruction decoding') -----
  pushTemporaryVariable: offset
+ 	| node |
+ 	offset >= tempVars size
+ 				ifTrue: "Handle the case of chained LiteralVariableBinding assigments"
+ 					[self halt.
+ 					 node := stack at: offset + 1 - tempVars size]
+ 				ifFalse: "A regular argument or temporary"
+ 					[node := tempVars at: offset + 1.
+ 					 node isArg ifFalse: "count temp reads for the whileTrue: => to:do: transformation."
+ 						[tempReadCounts at: node put: (tempReadCounts at: node ifAbsent: [0]) + 1]].
+ 	stack addLast: node!
- 
- 	stack addLast: (offset >= tempVars size
- 		ifTrue:
- 			["Handle the case of chained LiteralVariableBinding assigments"
- 			stack at: (offset + 1 - tempVars size)]
- 		ifFalse:
- 			["A regular argument or temporary"
- 			tempVars at: offset + 1])!

Item was removed:
- ----- Method: Decompiler>>scanBlockScopeFor:from:to:with:scanner: (in category 'private') -----
- scanBlockScopeFor: refpc from: startpc to: endpc with: scan scanner: scanner
- 	| bsl maybeBlockSize |
- 	bsl := BlockStartLocator new.
- 	scanner pc: startpc.
- 	[scanner pc <= endpc] whileTrue:
- 		[refpc = scanner pc ifTrue:
- 			[scanner pc: startpc.
- 			 [scanner pc <= endpc] whileTrue:
- 				[(scan value: scanner firstByte) ifTrue:
- 					[^endpc].
- 				 (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue:
- 					[scanner pc: scanner pc + maybeBlockSize]].
- 			   ^self].
- 		 (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue:
- 			[refpc <= (scanner pc + maybeBlockSize)
- 				ifTrue: [^self scanBlockScopeFor: refpc from: scanner pc to: scanner pc + maybeBlockSize with: scan scanner: scanner]
- 				ifFalse: [scanner pc: scanner pc + maybeBlockSize]]]!

Item was added:
+ ----- Method: Decompiler>>startAndLimitFor:from:into: (in category 'private') -----
+ startAndLimitFor: incrVar from: aStack into: binaryBlock
+ 	"If incrVar matches the increment of a whileLoop at the end of statements
+ 	 evaluate binaryBlock with the init statement for incrVar and the init statement
+ 	 for the block's limit, if any, and answer true.  Otherwise answer false.  Used to
+ 	 help convert whileTrue: loops into to:[by:]do: loops."
+ 	| guard initExpr limitInit size |
+ 	((size := aStack size) >= 1
+ 	 and: [(initExpr := aStack at: size) isAssignmentNode]) ifFalse:
+ 		[^false].
+ 	initExpr variable == incrVar ifTrue:
+ 		[binaryBlock value: initExpr value: nil.
+ 		 ^true].
+ 	limitInit := initExpr.
+ 	(size >= 2
+ 	 and: [(initExpr := aStack at: size - 1) isAssignmentNode
+ 	 and: [initExpr variable == incrVar
+ 	 and: [(guard := statements last receiver) isBlockNode
+ 	 and: [guard statements size = 1
+ 	 and: [(guard := guard statements first) isMessageNode
+ 	 and: [guard receiver == incrVar
+ 	 and: [guard arguments first == limitInit variable]]]]]]]) ifTrue:
+ 		[binaryBlock value: initExpr value: limitInit.
+ 		 ^true].
+ 	^false!

Item was changed:
  ----- Method: Decompiler>>statementsTo: (in category 'control') -----
  statementsTo: end
  	"Decompile the method from pc up to end and return an array of
  	expressions. If at run time this block will leave a value on the stack,
  	set hasValue to true. If the block ends with a jump or return, set exit
  	to the destination of the jump, or the end of the method; otherwise, set
  	exit = end. Leave pc = end."
  
+ 	| encoderClass blockPos stackPos |
+ 	encoderClass := method encoderClass.
- 	| blockPos stackPos t |
  	blockPos := statements size.
  	stackPos := stack size.
  	[pc < end]
  		whileTrue:
  			[lastPc := pc.  limit := end.  "for performs"
+ 			 "If you want instrumentation replace the following statement with this one,
+ 			  and edit the implementation:
+ 				self interpretNextInstructionFor: self"
+ 			encoderClass interpretNextInstructionFor: self in: self].
- 			self interpretNextInstructionFor: self].
  	"If there is an additional item on the stack, it will be the value
  	of this block."
  	(hasValue := stack size > stackPos)
  		ifTrue:
  			[statements addLast: stack removeLast].
  	lastJumpPc = lastPc ifFalse: [exit := pc].
  	^self popTo: blockPos!

Item was changed:
  ----- Method: Decompiler>>storeIntoTemporaryVariable: (in category 'instruction decoding') -----
  storeIntoTemporaryVariable: offset
+ 	stack addLast: (offset >= tempVars size
+ 						ifTrue: "Handle the case of chained LiteralVariableBinding assigments"
+ 							[stack at: (offset + 1 - tempVars size)]
+ 						ifFalse: "A regular argument or temporary"
+ 							[tempVars at: offset + 1]).
+ 	self doStore: stack!
- 
- 	self pushTemporaryVariable: offset; doStore: stack!

Item was removed:
- ----- Method: DecompilerConstructor>>codeArguments:block: (in category 'constructor') -----
- codeArguments: args block: block
- 
- 	^block arguments: args!

Item was changed:
  ----- Method: MessageNode>>emitCodeForToDo:encoder:value: (in category 'code generation') -----
  emitCodeForToDo: stack encoder: encoder value: forValue 
  	" var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: "
  	| loopSize initStmt limitInit test block incStmt blockSize |
  	initStmt := arguments at: 4.
  	limitInit := arguments at: 7.
  	test := arguments at: 5.
  	block := arguments at: 3.
  	incStmt := arguments at: 6.
  	blockSize := sizes at: 1.
  	loopSize := sizes at: 2.
- 	limitInit == nil
- 		ifFalse: [limitInit emitCodeForEffect: stack encoder: encoder].
  		
  	"This will return the receiver of to:do: which is the initial value of the loop"
  	forValue
+ 		ifTrue: [initStmt emitCodeForValue: stack encoder: encoder]
- 		ifTrue: [initStmt emitCodeForValue: stack encoder: encoder.]
  		ifFalse: [initStmt emitCodeForEffect: stack encoder: encoder].
+ 	limitInit ifNotNil:
+ 		[limitInit emitCodeForEffect: stack encoder: encoder].
  	test emitCodeForValue: stack encoder: encoder.
  	self emitCodeForBranchOn: false dist: blockSize pop: stack encoder: encoder.
  	pc := encoder methodStreamPosition.
  	block emitCodeForEvaluatedEffect: stack encoder: encoder.
  	incStmt emitCodeForEffect: stack encoder: encoder.
+ 	self emitCodeForJump: 0 - loopSize encoder: encoder!
- 	self emitCodeForJump: 0 - loopSize encoder: encoder.!

Item was added:
+ ----- Method: MessageNode>>toDoFromWhileWithCounts:init:limit: (in category 'decompiling') -----
+ toDoFromWhileWithCounts: blockBodyTempCounts init: incrInit limit: limitInitOrNil
+ 	"If the receiver, a whileTrue: loop, represents a to:[by:]do: loop
+ 	 then answer the replacement to:[by:]do:, otherwise answer nil."
+ 	| variable increment limit toDoBlock body test |
+ 	self assert: (selector key == #whileTrue:
+ 				and: [incrInit isAssignmentNode]).
+ 	(limitInitOrNil notNil "limit should not be referenced within the loop"
+ 	  and: [(blockBodyTempCounts at: limitInitOrNil variable ifAbsent: [0]) ~= 1]) ifTrue:
+ 		[^nil].
+ 	body := arguments last statements.
+ 	(variable := incrInit variable) isTemp ifFalse:
+ 		[^nil].
+ 	(increment := body last toDoIncrement: variable) ifNil:
+ 		[^nil].
+ 	receiver statements size ~= 1 ifTrue:
+ 		[^nil].
+ 	test := receiver statements first.
+ 	"Note: test should really be checked that <= or >= comparison
+ 	jibes with the sign of the (constant) increment"
+ 	(test isMessageNode
+ 	 and: [(limit := test toDoLimit: variable) notNil]) ifFalse:
+ 		[^nil].
+ 	"The block must not overwrite the limit"
+ 	(limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) ifTrue:
+ 		[^nil]. 
+ 	toDoBlock := BlockNode statements: body allButLast returns: false.
+ 	toDoBlock arguments: {variable}.
+ 	^MessageNode new
+ 		receiver: incrInit value
+ 		selector: (SelectorNode new key: #to:by:do: code: #macro)
+ 		arguments: (Array with: limit with: increment with: toDoBlock)
+ 		precedence: precedence!

Item was removed:
- ----- Method: MessageNode>>toDoFromWhileWithInit: (in category 'macro transformations') -----
- toDoFromWhileWithInit: initStmt
- 	"Return nil, or a to:do: expression equivalent to this whileTrue:"
- 	| variable increment limit toDoBlock body test |
- 	(selector key == #whileTrue:
- 	 and: [initStmt isAssignmentNode
- 	 and: [initStmt variable isTemp]]) ifFalse:
- 		[^nil].
- 	body := arguments last statements.
- 	variable := initStmt variable.
- 	increment := body last toDoIncrement: variable.
- 	(increment == nil
- 	 or: [receiver statements size ~= 1]) ifTrue:
- 		[^nil].
- 	test := receiver statements first.
- 	"Note: test chould really be checked that <= or >= comparison
- 	jibes with the sign of the (constant) increment"
- 	(test isMessageNode
- 	 and: [(limit := test toDoLimit: variable) notNil]) ifFalse:
- 		[^nil].
- 	"The block must not overwrite the limit"
- 	(limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]])
- 		ifTrue: [^nil]. 
- 	toDoBlock := BlockNode statements: body allButLast returns: false.
- 	toDoBlock arguments: (Array with: variable).
- 	variable scope: -1.
- 	variable beBlockArg.
- 	^MessageNode new
- 		receiver: initStmt value
- 		selector: (SelectorNode new key: #to:by:do: code: #macro)
- 		arguments: (Array with: limit with: increment with: toDoBlock)
- 		precedence: precedence!

Item was added:
+ ----- Method: MessageNode>>toDoFromWhileWithInit:withLimit: (in category 'decompiling') -----
+ toDoFromWhileWithInit: incrInit withLimit: limitInitOrNil
+ 	"If the receiver, a whileTrue: loop, represents a to:[by:]do: loop
+ 	 then answer the replacement to:[by:]do:, otherwise answer nil."
+ 	| variable increment limit toDoBlock body test |
+ 	self assert: (selector key == #whileTrue:
+ 				and: [incrInit isAssignmentNode]).
+ 	body := arguments last statements.
+ 	(variable := incrInit variable) isTemp ifFalse:
+ 		[^nil].
+ 	(increment := body last toDoIncrement: variable) ifNil:
+ 		[^nil].
+ 	receiver statements size ~= 1 ifTrue:
+ 		[^nil].
+ 	test := receiver statements first.
+ 	"Note: test should really be checked that <= or >= comparison
+ 	jibes with the sign of the (constant) increment"
+ 	(test isMessageNode
+ 	 and: [(limit := test toDoLimit: variable) notNil]) ifFalse:
+ 		[^nil].
+ 	"The block must not overwrite the limit"
+ 	(limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) ifTrue:
+ 		[^nil]. 
+ 	toDoBlock := BlockNode statements: body allButLast returns: false.
+ 	toDoBlock arguments: {variable}.
+ 	^MessageNode new
+ 		receiver: incrInit value
+ 		selector: (SelectorNode new key: #to:by:do: code: #macro)
+ 		arguments: (Array with: limit with: increment with: toDoBlock)
+ 		precedence: precedence!

Item was changed:
  ----- Method: MessageNode>>toDoIncrement: (in category 'testing') -----
  toDoIncrement: variable
+ 	^(receiver = variable
+ 	   and: [selector key = #+
+ 	   and: [arguments first isConstantNumber]]) ifTrue:
+ 		[arguments first]!
- 	(receiver = variable and: [selector key = #+]) 
- 		ifFalse: [^ nil].
- 	arguments first isConstantNumber
- 		ifTrue: [^ arguments first]
- 		ifFalse: [^ nil]!

Item was changed:
  ----- Method: MessageNode>>toDoLimit: (in category 'testing') -----
  toDoLimit: variable
+ 	^(receiver = variable
+ 	   and: [selector key = #<= or: [selector key = #>=]]) ifTrue:
+ 		[arguments first]!
- 	(receiver = variable and: [selector key = #<= or: [selector key = #>=]]) 
- 		ifTrue: [^ arguments first]
- 		ifFalse: [^ nil]!

Item was changed:
+ (PackageInfo named: 'Compiler') postscript: '"below, add code to be run after the loading of this package"
+ "Make sure all methods using to:do: and to:by:do: are recompiled"
- (PackageInfo named: 'Compiler') postscript: '"Make sure all affected methods are recompiled"
  UIManager default
+ 	informUser: ''Recompiling methods sending to:do: and to:by:do:''
- 	informUser: ''Recompiling affected methods''
  	during: 
  		[(self systemNavigation allMethodsSelect:
+ 			[:m|
+ 			#(to:do: to:by:do:) anySatisfy: [:l| m refersToLiteral: l]]) do:
+ 			[:mr| mr actualClass recompile: mr selector]]'!
- 			[:m| | ebc | "All affected methods send one of these optimized selectors..."
- 			(#(to:do: to:by:do: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:) anySatisfy: [:l| m refersToLiteral: l])
- 			"but the textDomain properties confuse method comparison below..."
- 			and: [(m propertyValueAt: #textDomain ifAbsent: nil) isNil
- 			and: [m numTemps > m numArgs "and have non-argument temporaries in them..."
- 				  or: [(ebc := m embeddedBlockClosures) notEmpty
- 					and: [ebc anySatisfy: [:bc| bc numTemps > bc numArgs]]]]]]) do:
- 			[:mr| | old new |
- 			old := mr compiledMethod.
- 			"do a test recompile of the method..."
- 			new := (mr actualClass compile: old getSource asString notifying: nil trailer: old trailer ifFail: nil) method.
- 			"and if it changed, report it to the transcript and really recompile it..."
- 			old ~= new ifTrue:
- 				[Transcript cr. old printReferenceOn: Transcript. Transcript flush.
- 				 mr actualClass recompile: old selector]]]'!



More information about the Squeak-dev mailing list