Posted by
commits-2 on
Feb 03, 2011; 10:26pm
URL: https://forum.world.st/The-Inbox-Compiler-nice-186-mcz-tp3259124.html
A new version of Compiler was added to project The Inbox:
http://source.squeak.org/inbox/Compiler-nice.186.mcz==================== Summary ====================
Name: Compiler-nice.186
Author: nice
Time: 3 February 2011, 11:26:04.738 pm
UUID: 9bdb53d0-56a1-4d0b-9835-f60a135dd7f6
Ancestors: Compiler-nice.184
Add both Compiler and Decompiler support for inlined #repeat.
Implementation notes:
For compilation, the repeat is implemented with a simple backward jump if ever the receiver is a block.
For decompilation, things are a bit more tedious because conditonnal loops (whileTrue/False) must be differentiated from unconditional loops (repeat).
The signature of conditional loops is that they all have their backward jump hoping over their conditional jump.
If a backward jump does not cross any conditional jump on its way back, then it must be a repeat.
The idea is thus to register the program counter of the test instruction before the conditional jump (lastJumpIfPc), and verify if the bacward jump branch after or before this instruction.
Things are a bit more complex because there can be a conditional instruction inside the repeat body.
That's why those conditional jumps must be stacked (on lastJumpIfPcStack), and unstacked once decompiled.
=============== Diff against Compiler-nice.184 ===============
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'
- instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase numLocalTemps blockStartsToTempVars tempVarCount'
classVariableNames: 'ArgumentFlag CascadeFlag CaseFlag IfNilFlag'
poolDictionaries: ''
category: 'Compiler-Kernel'!
+ !Decompiler commentStamp: 'nice 2/3/2011 22:54' prior: 0!
- !Decompiler commentStamp: 'nice 3/1/2010 19:56' 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!
- tempVarCount <Integer> number of temp vars used by the method!
Item was changed:
----- Method: Decompiler>>decompile:in:method:using: (in category 'public access') -----
decompile: aSelector in: aClass method: aMethod using: aConstructor
| block node |
constructor := aConstructor.
method := aMethod.
self initSymbols: aClass. "create symbol tables"
method isQuick
ifTrue: [block := self quickMethod]
ifFalse:
[stack := OrderedCollection new: method frameSize.
+ lastJumpIfPcStack := OrderedCollection new.
caseExits := OrderedCollection new.
statements := OrderedCollection new: 20.
numLocalTemps := 0.
super method: method pc: method initialPC.
"skip primitive error code store if necessary"
(method primitive ~= 0 and: [self willStore]) ifTrue:
[pc := pc + 2.
tempVars := tempVars asOrderedCollection].
block := self blockTo: method endPC + 1.
stack isEmpty ifFalse: [self error: 'stack not empty']].
node := constructor
codeMethod: aSelector
block: block
tempVars: tempVars
primitive: method primitive
class: aClass.
method primitive > 0 ifTrue:
[node removeAndRenameLastTempIfErrorCode].
^node preen!
Item was changed:
----- Method: Decompiler>>jump: (in category 'instruction decoding') -----
jump: dist
+ | blockBody destPc nextPC |
+ destPc := pc + dist.
+ (lastJumpIfPcStack isEmpty or: [dist < 0 and: [destPc > lastJumpIfPcStack last]])
+ ifTrue:
+ ["Rule: aBackward jump not crossing a Bfp/Btp must be a repeat"
+ nextPC := pc.
+ pc := destPc.
+ blockBody := self statementsTo: lastPc.
+ blockBody size timesRepeat: [statements removeLast].
+ pc := nextPC.
+ statements addLast:
+ (constructor
+ codeMessage: (constructor codeBlock: blockBody returns: false)
+ selector: (constructor
+ codeSelector: #repeat
+ code: #macro)
+ arguments: #()).
+ ]
+ ifFalse:
+ [exit := destPc.
+ lastJumpPc := lastPc]!
-
- exit := pc + dist.
- lastJumpPc := lastPc!
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 blockBody |
+ lastJumpIfPcStack addLast: lastPc.
+ stack last == CascadeFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]].
- stack last == CascadeFlag ifTrue: [^ self case: dist].
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:
["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 re-decompiling."
stack := saveStack.
pc := thenJump.
blockBody := self statementsTo: elsePc.
"discard unwanted statements from block"
blockBody size - 1 timesRepeat: [statements removeLast].
statements addLast:
(constructor
codeMessage: (constructor codeBlock: blockBody returns: false)
selector: (constructor
codeSelector: (sign
ifTrue: [#whileFalse:]
ifFalse: [#whileTrue:])
code: #macro)
arguments: { thenBlock }).
pc := elseStart.
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.!
- ifFalse: [statements addLast: cond]]!
Item was changed:
----- Method: MessageNode class>>initialize (in category 'class initialization') -----
+ initialize
+ "MessageNode initialize"
- initialize "MessageNode initialize"
MacroSelectors :=
#( ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
and: or:
whileFalse: whileTrue: whileFalse whileTrue
to:do: to:by:do:
caseOf: caseOf:otherwise:
+ ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:
+ repeat ).
- ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:).
MacroTransformers :=
#( transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue:
transformAnd: transformOr:
transformWhile: transformWhile: transformWhile: transformWhile:
transformToDo: transformToDo:
transformCase: transformCase:
+ transformIfNil: transformIfNil: transformIfNilIfNotNil: transformIfNotNilIfNil:
+ transformRepeat: ).
- transformIfNil: transformIfNil: transformIfNilIfNotNil: transformIfNotNilIfNil:).
MacroEmitters :=
#( emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
emitCodeForToDo:encoder:value: emitCodeForToDo:encoder:value:
emitCodeForCase:encoder:value: emitCodeForCase:encoder:value:
emitCodeForIfNil:encoder:value: emitCodeForIfNil:encoder:value:
+ emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
+ emitCodeForRepeat:encoder:value:).
- emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:).
MacroSizers :=
#( sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value:
sizeCodeForIf:value: sizeCodeForIf:value:
sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value:
sizeCodeForToDo:value: sizeCodeForToDo:value:
sizeCodeForCase:value: sizeCodeForCase:value:
+ sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value:
+ sizeCodeForRepeat:value:).
- sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value:).
MacroPrinters :=
#( printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent:
printIfOn:indent: printIfOn:indent:
printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent:
printToDoOn:indent: printToDoOn:indent:
printCaseOn:indent: printCaseOn:indent:
+ printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent:
+ printRepeatOn:indent:)!
- printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent:)!
Item was added:
+ ----- Method: MessageNode>>emitCodeForRepeat:encoder:value: (in category 'code generation') -----
+ emitCodeForRepeat: stack encoder: encoder value: forValue
+ " L1: ... Jmp(L1)"
+ | loopSize |
+ loopSize := sizes at: 1.
+ receiver emitCodeForEvaluatedEffect: stack encoder: encoder.
+ self emitCodeForJump: 0 - loopSize encoder: encoder.
+ forValue ifTrue: [encoder genPushSpecialLiteral: nil. stack push: 1]!
Item was added:
+ ----- Method: MessageNode>>printRepeatOn:indent: (in category 'printing') -----
+ printRepeatOn: aStream indent: level
+
+ self printReceiver: receiver on: aStream indent: level.
+
+ ^self printKeywords: selector key
+ arguments: (Array new)
+ on: aStream indent: level!
Item was added:
+ ----- Method: MessageNode>>sizeCodeForRepeat:value: (in category 'code generation') -----
+ sizeCodeForRepeat: encoder value: forValue
+ "L1: ... Jmp(L1) nil (nil for value only);"
+ | loopSize |
+ loopSize := (receiver sizeCodeForEvaluatedEffect: encoder) + (encoder sizeJumpLong: 1).
+ sizes := Array with: loopSize.
+ ^loopSize + (forValue ifTrue: [encoder sizePushSpecialLiteral: nil] ifFalse: [0])!
Item was added:
+ ----- Method: MessageNode>>transformRepeat: (in category 'macro transformations') -----
+ transformRepeat: encoder
+ "answer true if this #repeat message can be optimized"
+
+ ^(self checkBlock: receiver as: 'receiver' from: encoder)
+ and: [receiver noteOptimizedIn: self.
+ true]!