[squeak-dev] The Trunk: Compiler-nice.188.mcz

Levente Uzonyi leves at elte.hu
Sun Feb 13 19:54:22 UTC 2011


On Sun, 13 Feb 2011, Nicolas Cellier wrote:

> 2011/2/13 Levente Uzonyi <leves at elte.hu>:
>> On Sun, 13 Feb 2011, Nicolas Cellier wrote:
>>
>>> Yep, little collision, sorry.
>>> Could you redo it ?
>>
>> There's no collision, because I pushed my version to the Inbox. If you want
>> me to add the postscript that decompiles the senders of #repeat, then I can
>> do that.
>>
>
> Yes please, that's what I mean.
> Or does merge handle postscripts ?

I think it does, but maybe it's better to redo it.


Levente

>
> Nicolas
>
>>
>> Levente
>>
>>>
>>> 2011/2/13 Levente Uzonyi <leves at elte.hu>:
>>>>
>>>> On Sun, 13 Feb 2011, commits at source.squeak.org wrote:
>>>>
>>>>> Nicolas Cellier uploaded a new version of Compiler to project The Trunk:
>>>>> http://source.squeak.org/trunk/Compiler-nice.188.mcz
>>>>
>>>> Seems like you were a bit faster than me. I pushed my version to the
>>>> Inbox,
>>>> because if you recompile methods which send #repeat, then the
>>>> DecompilerTests will fail with an error.
>>>>
>>>>
>>>> Levente
>>>>
>>>>>
>>>>> ==================== Summary ====================
>>>>>
>>>>> Name: Compiler-nice.188
>>>>> Author: nice
>>>>> Time: 13 February 2011, 7:39:55.07 pm
>>>>> UUID: 66ccdff2-05b9-4294-9b3b-0bf2d84417fd
>>>>> Ancestors: Compiler-nice.187, Compiler-fbs.183, Compiler-nice.186
>>>>>
>>>>> Merge fbs.183 nice.186 nice.187 coming from inbox
>>>>>
>>>>> =============== Diff against Compiler-nice.187 ===============
>>>>>
>>>>> 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>>interpretNextInstructionFor: (in category
>>>>> 'private') -----
>>>>>  interpretNextInstructionFor: client
>>>>>
>>>>>        | code varNames |
>>>>>
>>>>>  "Change false here will trace all state in Transcript."
>>>>>  true ifTrue: [^ super interpretNextInstructionFor: client].
>>>>>
>>>>>        varNames := self class allInstVarNames.
>>>>>        code := (self method at: pc) radix: 16.
>>>>>        Transcript cr; cr; print: pc; space;
>>>>> +               nextPutAll: '<' , code, '>'.
>>>>> -               nextPutAll: '<' , (code copyFrom: 4 to: code size), '>'.
>>>>>        8 to: varNames size do:
>>>>>                [:i | i <= 10 ifTrue: [Transcript cr]
>>>>>                                ifFalse: [Transcript space; space].
>>>>>                Transcript nextPutAll: (varNames at: i);
>>>>>                                nextPutAll: ': '; print: (self instVarAt:
>>>>> i)].
>>>>>        Transcript endEntry.
>>>>>        ^ super interpretNextInstructionFor: client!
>>>>>
>>>>> 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]!
>>>>>
>>>>> Item was removed:
>>>>> - ----- Method: VariableNode>>canBeSpecialArgument (in category
>>>>> 'testing')
>>>>> -----
>>>>> - canBeSpecialArgument
>>>>> -       "Can I be an argument of (e.g.) ifTrue:?"
>>>>> -
>>>>> -       ^code < LdNil!
>>>>>
>>>>>
>>>>>
>>>>
>>>>
>>>
>>
>>
>>
>>
>
>


More information about the Squeak-dev mailing list