[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
|