'From Squeakland 3.8.5976 of 25 August 2004 [latest update: #329] on 6 October 2004 at 1:47:43 pm'! "Change Set: DecompileFixes-ls-nk Date: 6 October 2004 Author: Ned Konz This is a combination of Lex Spoon's decompFixes-ls changeset from 30 Jan 2004 with a couple of mine. Together they fix a variety of decompilation-related problems, including the one reported as Squeakland bug # 0000207. Lex's changeset: --- Change Set: decompFixes-ls Date: 30 January 2004 Author: Lex Spoon Fixes the decompiler bug posted by Ned Konz on 11 February 2003. The issue is that if the last case in a case statement returns from the method, the decompiler gets confused trying to parse the otherwise: branch. This changeset has the decompiler track all non-return exits from the case statement, so that it has enough information to do a right thing. The changeset also adds a couple of methods that the decompiler is relying on. After loading this changeset, Ned's example decompiles correctly. Also, decompiling and recompiling everything leaves a running system. The test is included for future use as [Decompiler recompileAllTest]. s0: evt evt caseOf: { [ #Entry ] -> [ self log: 's0-ENTRY;'. ^nil ]. [ #Exit ] -> [ self log: 's0-EXIT;'. ^nil ]. [ #Init ] -> [ self log: 's0-INIT;'. self initProtected: #s1:. ^nil ]. [ #e ] -> [ self log: 's0-E;'. self tran: #s211:. ^nil ]. } otherwise: [ ^#top: ] --- My changesets: Change Set: DecompileAnonymousMethodFix-nk Date: 20 February 2004 Author: Ned Konz Allows anonymous CompiledMethods (i.e. not attached to any class) to be decompiled properly. Change Set: BlockDecompileFix-nk Date: 7 September 2004 Author: Your Name I was getting walkbacks in the debugger because of blocks sometimes not decompiling right (esp. in primitives). This fixes the problem I saw. "! InstructionStream subclass: #Decompiler instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase' classVariableNames: 'ArgumentFlag CascadeFlag CaseFlag IfNilFlag' poolDictionaries: '' category: 'System-Compiler'! !Decompiler commentStamp: 'ls 1/28/2004 13:31' 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 method instVars tempVars constTable stack statements lastPc exit caseExits - stack of exit addresses that have been seen in the branches of caseOf:'s lastJumpPc lastReturnPc limit hasValue blockStackBase! !Decompiler methodsFor: 'control' stamp: 'ls 1/28/2004 13:29'! 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 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 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 == CaseFlag ifFalse: [ statements addLast: stack removeLast] ]. lastJumpPc = lastPc ifFalse: [exit _ pc]. caseExits add: exit. ^self popTo: blockPos! ! !Decompiler methodsFor: 'instruction decoding' stamp: 'ls 1/28/2004 13:27'! case: dist "statements = keyStmts CascadeFlag keyValueBlock ... keyStmts" | nextCase thenJump stmtStream elements b node cases otherBlock myExits | nextCase _ pc + dist. "Now add CascadeFlag & keyValueBlock to statements" statements addLast: stack removeLast. stack addLast: CaseFlag. "set for next pop" statements addLast: (self blockForCaseTo: nextCase). 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) == 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 size ] ] ]. myExits isEmpty ifTrue: [ thenJump := nextCase ] ifFalse: [ thenJump := myExits min ]. otherBlock _ self blockTo: thenJump. stack addLast: (constructor codeMessage: stack removeLast selector: (constructor codeSelector: #caseOf:otherwise: code: #macro) arguments: (Array with: cases with: otherBlock)). myExits isEmpty ifTrue:[ "all branches returned; pop off the statement" statements addLast: stack removeLast. ] ].! ! !Decompiler methodsFor: 'instruction decoding' stamp: 'nk 2/20/2004 11:56'! pushReceiverVariable: offset | var | (var _ instVars at: offset + 1 ifAbsent: []) == nil ifTrue: ["Not set up yet" var _ constructor codeInst: offset. instVars size < (offset + 1) ifTrue: [ instVars _ (Array new: offset + 1) replaceFrom: 1 to: instVars size with: instVars; yourself ]. instVars at: offset + 1 put: var]. stack addLast: var! ! !Decompiler methodsFor: 'public access' stamp: 'ls 1/28/2004 13:10'! decompileBlock: aBlock "Original version timestamp: sn 1/26/98 18:27 (Don't know who's sn?) " "Decompile aBlock, returning the result as a BlockNode. Show temp names from source if available." "Decompiler new decompileBlock: [3 + 4]" | startpc end homeClass blockNode tempNames home source | (home _ aBlock home) ifNil: [^ nil]. method _ home method. (homeClass _ home who first) == #unknown ifTrue: [^ nil]. constructor _ DecompilerConstructor new. method fileIndex ~~ 0 ifTrue: ["got any source code?" source _ [method getSourceFromFile] on: Error do: [:ex | ^ nil]. tempNames _ ([homeClass compilerClass new parse: source in: homeClass notifying: nil] on: (Smalltalk classNamed: 'SyntaxErrorNotification') do: [:ex | ^ nil]) tempNames. self withTempNames: tempNames]. self initSymbols: homeClass. startpc _ aBlock startpc. end _ (method at: startpc - 2) \\ 16 - 4 * 256 + (method at: startpc - 1) + startpc - 1. stack _ OrderedCollection new: method frameSize. caseExits _ OrderedCollection new. statements _ OrderedCollection new: 20. super method: method pc: startpc - 5. blockNode _ self blockTo: end. stack isEmpty ifFalse: [self error: 'stack not empty']. ^ blockNode statements first! ! !Decompiler methodsFor: 'private' stamp: 'ls 1/28/2004 13:11'! decompile: aSelector in: aClass method: aMethod using: aConstructor | block | constructor _ aConstructor. method _ aMethod. self initSymbols: aClass. "create symbol tables" method isQuick ifTrue: [block _ self quickMethod] ifFalse: [stack _ OrderedCollection new: method frameSize. caseExits _ OrderedCollection new. statements _ OrderedCollection new: 20. super method: method pc: method initialPC. block _ self blockTo: method endPC + 1. stack isEmpty ifFalse: [self error: 'stack not empty']]. ^constructor codeMethod: aSelector block: block tempVars: tempVars primitive: method primitive class: aClass! ! !Decompiler class methodsFor: 'testing' stamp: 'ls 1/29/2004 23:54'! recompileAllTest "[Decompiler recompileAllTest]" "decompile every method and compile it back; if the decompiler is correct then the system should keep running. :)" | decompiled ast compiled | SystemNavigation default allBehaviorsDo: [ :behavior | Utilities informUser: (behavior printString) during: [ behavior selectors do: [ :sel | decompiled := Decompiler new decompile: sel in: behavior. ast := Compiler new compile: decompiled in: behavior notifying: nil ifFail: [ self error: 'failed' ]. compiled := ast generate: (behavior compiledMethodAt: sel) trailer. behavior addSelector: sel withMethod: compiled. ] ] ]! ! !ParseNode methodsFor: 'testing' stamp: 'ls 1/29/2004 21:11'! isJust: node ^false! ! !ParseNode methodsFor: 'private' stamp: 'ls 1/29/2004 21:17'! ifNilReceiver "assuming this object is the receiver of an ifNil:, what object is being asked about?" ^self! ! !DecompilerConstructor methodsFor: 'constructor' stamp: 'nk 2/20/2004 11:51'! codeInst: index ^VariableNode new name: (instVars at: index + 1 ifAbsent: ['unknown', index asString]) index: index type: LdInstType! ! !MessageNode methodsFor: 'printing' stamp: 'nk 9/7/2004 12:34'! printWhileOn: aStream indent: level aStream dialect = #SQ00 ifTrue: ["Add prefix keyword" aStream withStyleFor: #prefixKeyword do: [aStream nextPutAll: (selector key == #whileTrue: ifTrue: ['While '] ifFalse: ['Until '])]. self printParenReceiver: receiver on: aStream indent: level + 1. self printKeywords: #do: arguments: arguments on: aStream indent: level prefix: true] ifFalse: [self printReceiver: receiver on: aStream indent: level. (arguments isEmpty not and: [ arguments first isJust: NodeNil]) ifTrue: [selector _ SelectorNode new key: (selector key == #whileTrue: ifTrue: [#whileTrue] ifFalse: [#whileFalse]) code: #macro. arguments _ Array new]. self printKeywords: selector key arguments: arguments on: aStream indent: level]! !