[squeak-dev] The Trunk: Compiler-nice.432.mczcommits at source.squeak.org commits at source.squeak.orgSun May 10 10:50:40 UTC 2020
Nicolas Cellier uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-nice.432.mcz ==================== Summary ==================== Name: Compiler-nice.432 Author: nice Time: 10 May 2020, 12:50:37.677856 pm UUID: f6faf998-9905-4fbd-9bc4-66a2e9f8bc93 Ancestors: Compiler-nice.431 Fix Decompiler after correction byteCodes generated by inlined #caseOf: and recompile all senders of caseOf: in postscript. Note: I have changed the logic a little bit: - the ancient CaseFlag is replaced by OtherwiseFlag (that's the purpose, we are trying to detect last case before otherwise:). - CascadeFlag is replaced by CaseFlag as soon as we have detected a potential caseOf:. I never put so many Halt in code before having it right. Good luck to the next one wanting to change the Decompiler... =============== Diff against Compiler-nice.431 =============== 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' + classVariableNames: 'ArgumentFlag CascadeFlag CaseFlag IfNilFlag OtherwiseFlag' - 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 changed: ----- Method: Decompiler class>>initialize (in category 'class initialization') ----- initialize CascadeFlag := 'cascade'. "A unique object" CaseFlag := 'case'. "Ditto" + OtherwiseFlag := 'otherwise'. "Ditto" ArgumentFlag := 'argument'. "Ditto" IfNilFlag := 'ifNil'. "Ditto" "Decompiler initialize"! Item was changed: ----- Method: Decompiler>>case: (in category 'instruction decoding') ----- case: dist "statements = keyStmts CascadeFlag keyValueBlock ... keyStmts" | nextCase thenJump stmtStream elements b node cases otherBlock myExits | nextCase := pc + dist. + "Now add CaseFlag & keyValueBlock to statements" - "Now add CascadeFlag & keyValueBlock to statements" statements addLast: stack removeLast. + "Trick: put a flag on the stack. + If it is the last case before otherwise: block, then + - there won't be a dup of caseOf: receiver before sending = + - there won't be a pop in the case handling block" + stack addLast: OtherwiseFlag. "set for next pop" - stack addLast: CaseFlag. "set for next pop" statements addLast: (self blockForCaseTo: nextCase). + + stack last == OtherwiseFlag - - stack last == CaseFlag ifTrue: "Last case" ["ensure jump is within block (in case thenExpr returns wierdly I guess)" stack removeLast. "get rid of CaseFlag" stmtStream := ReadStream on: (self popTo: stack removeLast). elements := OrderedCollection new. b := OrderedCollection new. [stmtStream atEnd] whileFalse: + [(node := stmtStream next) == CaseFlag - [(node := stmtStream next) == CascadeFlag ifTrue: [elements addLast: (constructor codeMessage: (constructor codeBlock: b returns: false) selector: (constructor codeSelector: #-> code: #macro) arguments: (Array with: stmtStream next)). b := OrderedCollection new] ifFalse: [b addLast: node]]. b size > 0 ifTrue: [self error: 'Bad cases']. cases := constructor codeBrace: elements. "try find the end of the case" myExits := caseExits removeLast: elements size. myExits := myExits reject: [ :e | e isNil or: [ e < 0 or: [ e > method endPC ] ] ]. thenJump := myExits isEmpty ifTrue: [ nextCase ] ifFalse: [ myExits max ]. otherBlock := self blockTo: thenJump. stack addLast: (constructor codeMessage: stack removeLast selector: (constructor codeSelector: #caseOf:otherwise: code: #macro) arguments: (Array with: cases with: otherBlock))].! Item was changed: ----- Method: Decompiler>>doDup (in category 'instruction decoding') ----- doDup + stack last == CaseFlag + ifTrue: + ["We are in the process of decompiling a caseOf:" + stack addLast: CaseFlag. + ^self]. - stack last == CascadeFlag ifFalse: ["Save position and mark cascade" stack addLast: statements size. stack addLast: CascadeFlag]. stack addLast: CascadeFlag! Item was changed: ----- Method: Decompiler>>doPop (in category 'instruction decoding') ----- doPop stack isEmpty ifTrue: ["Ignore pop in first leg of ifNil for value" ^ self]. + stack last == OtherwiseFlag - stack last == CaseFlag ifTrue: [stack removeLast] ifFalse: [statements addLast: stack removeLast].! 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 | lastJumpIfPcStack addLast: lastPc. + stack last == CaseFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]]. - 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... 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." 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) arguments: blockArgs). pc := elseStart. selector == #whileTrue: ifTrue: [self convertToDoLoop: blockBodyReadCounts]] 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: [(sign ifTrue: [{elseBlock. thenBlock}] ifFalse: [{thenBlock. elseBlock}]) in: [:args | (constructor decodeIfNilWithReceiver: ifExpr selector: #ifTrue:ifFalse: arguments: args tempReadCounts: tempReadCounts) ifNil: [constructor codeMessage: ifExpr selector: (constructor codeSelector: #ifTrue:ifFalse: code: #macro) arguments: args]]]. stack := saveStack. condHasValue ifTrue: [stack addLast: cond] ifFalse: [statements addLast: cond]]. lastJumpIfPcStack removeLast.! Item was changed: ----- Method: Decompiler>>send:super:numArgs: (in category 'instruction decoding') ----- send: selector super: superFlag numArgs: numArgs | args rcvr selNode msgNode messages | args := Array new: numArgs. (numArgs to: 1 by: -1) do: [:i | args at: i put: stack removeLast]. rcvr := stack removeLast. superFlag ifTrue: [rcvr := constructor codeSuper]. selNode := constructor codeAnySelector: selector. + rcvr == CaseFlag + ifTrue: + [| cases stmtStream elements node b | + selector == #= ifTrue: + [" = signals a case statement..." + statements addLast: args first. + stack addLast: rcvr. "restore CaseFlag" + ^ self]. + selector = #caseError ifFalse: [self error: 'unexpected message send while decompiling a caseOf:']. + stmtStream := ReadStream on: (self popTo: stack removeLast). + + elements := OrderedCollection new. + b := OrderedCollection new. + [stmtStream atEnd] whileFalse: + [(node := stmtStream next) == CaseFlag + ifTrue: + [elements addLast: (constructor + codeMessage: (constructor codeBlock: b returns: false) + selector: (constructor codeSelector: #-> code: #macro) + arguments: (Array with: stmtStream next)). + b := OrderedCollection new] + ifFalse: [b addLast: node]]. + b size > 0 ifTrue: [self error: 'Bad cases']. + cases := constructor codeBrace: elements. + + stack addLast: + (constructor + codeMessage: stack removeLast + selector: (constructor codeSelector: #caseOf: code: #macro) + arguments: (Array with: cases)). + ^self]. rcvr == CascadeFlag ifTrue: ["May actually be a cascade or an ifNil: for value." self willJumpIfFalse ifTrue: "= generated by a case macro" [selector == #= ifTrue: [" = signals a case statement..." statements addLast: args first. + stack removeLast; addLast: CaseFlag; addLast: CaseFlag. "Properly mark the case statement" - stack addLast: rcvr. "restore CascadeFlag" ^ self]. selector == #== ifTrue: [" == signals an ifNil: for value..." stack removeLast; removeLast. rcvr := stack removeLast. stack addLast: IfNilFlag; addLast: (constructor codeMessage: rcvr selector: selNode arguments: args). ^ self]] ifFalse: [(self willJumpIfTrue and: [selector == #==]) ifTrue: [" == signals an ifNotNil: for value..." stack removeLast; removeLast. rcvr := stack removeLast. stack addLast: IfNilFlag; addLast: (constructor codeMessage: rcvr selector: selNode arguments: args). ^ self]]. msgNode := constructor codeCascadedMessage: selNode arguments: args. stack last == CascadeFlag ifFalse: ["Last message of a cascade" statements addLast: msgNode. messages := self popTo: stack removeLast. "Depth saved by first dup" msgNode := constructor codeCascade: stack removeLast messages: messages]] ifFalse: [msgNode := constructor codeMessage: rcvr selector: selNode arguments: args]. stack addLast: msgNode! Item was changed: ----- Method: Decompiler>>statementsForCaseTo: (in category 'control') ----- statementsForCaseTo: 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. + Note that stack initially contains a OtherwiseFlag which will be removed by - Note that stack initially contains a CaseFlag which will be removed by a subsequent Pop instruction, so adjust the StackPos accordingly." | blockPos stackPos | blockPos := statements size. + stackPos := stack size - 1. "Adjust for OtherwiseFlag" - stackPos := stack size - 1. "Adjust for CaseFlag" [pc < end] whileTrue: [lastPc := pc. limit := end. "for performs" 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: + [stack last == OtherwiseFlag - [stack last == CaseFlag ifFalse: [ statements addLast: stack removeLast] ]. lastJumpPc = lastPc ifFalse: [exit := pc]. caseExits add: exit. ^self popTo: blockPos! Item was changed: (PackageInfo named: 'Compiler') postscript: '"below, add code to be run after the loading of this package" + "Recompile senders of caseOf:" + self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method | + (method hasLiteral: #caseOf:) + ifTrue: [behavior recompile: selector]]'! - "Make all relevant literals read-only, avoiding the recompile step, so as to avoid unbound methods" - self systemNavigation allSelect: - [:m| | b | - b := #notNil. - b := [:lit| lit isCollection ifTrue: [lit beReadOnlyObject. lit isArray ifTrue: [lit do: b "do: b do:"]]]. - m allLiteralsDo: - [:l| - (l isLiteral - and: [(l isCollection or: [l isNumber and: [l isReadOnlyObject not]]) - and: [(l isArray and: [m primitive == 117 and: [l == (m literalAt: 1)]]) not]]) ifTrue: - [b value: l]]. - false]'!
More information about the Squeak-dev mailing list |