'From Squeak6.0alpha of 17 December 2021 [latest update: #20880] on 17 December 2021 at 1:40:40 pm'! !CompiledCode methodsFor: 'decompiling' stamp: 'mt 12/17/2021 10:54:03.922095'! decompile "Return the decompiled parse tree that represents self" | class selector | class := self methodClass ifNil: [Object]. selector := self selector ifNil: [self defaultSelector]. ^class decompilerClass new decompile: selector in: class method: self! ! !CompiledBlock methodsFor: 'decompiling' stamp: 'mt 12/17/2021 11:00:14.121095'! decompile ^ Decompiler new decompileBlockMethod: self! ! !CompiledBlock methodsFor: '*60Deprecated-decompiling' stamp: 'mt 12/17/2021 13:32:03.052095'! methodForDecompile "Deprecated hook for older implementations of MwMethodWrapper and other object-as-method mechanisms. Not needed by recent implementation of method wrappers here: https://github.com/hpi-swa/MethodWrappers" self flag: #deprecated. ^self homeMethod methodForDecompile! ! !CompiledCodeInspector methodsFor: 'fields' stamp: 'mt 12/17/2021 13:24:03.025095'! fieldSource ^ (self newFieldForType: #code key: #source) name: 'source code' translated; emphasizeName; valueGetter: [:compiledCode | '"{1}"\{2}' withCRs format: {compiledCode isCompiledMethod ifTrue: [compiledCode methodClass] ifFalse: [compiledCode method reference]. compiledCode isCompiledMethod ifTrue: [compiledCode getSource] ifFalse: [compiledCode decompile decompileString] }]; printValueAsIs; shouldStyleValue: true; yourself! ! !CompiledCodeInspector methodsFor: 'user interface - styling' stamp: 'mt 12/17/2021 13:20:41.910095'! hasBindingOf: aString self object isCompiledMethod ifTrue: [^ false "ShoutParser will use #methodClass as context"]. self object method allLiteralsDo: [:literal | (literal = aString or: [literal isVariableBinding and: [literal key = aString]]) ifTrue: [^ true]]. (self object method tempNames includes: aString) ifTrue: [^ true]. (self object methodClass allInstVarNames includes: aString) ifTrue: [^ true]. (self object methodClass classPool includesKey: aString) ifTrue: [^ true]. ^ false! ! !CompiledCodeInspector methodsFor: 'user interface - styling' stamp: 'mt 12/17/2021 13:15:02.054095'! updateStyler: aStyler requestor: anObject "Overridden to configure the styler to parse method source code correctly." | parseAMethod classOrMetaClass workspace | self selectedField ifNil: [super updateStyler: aStyler requestor: anObject] ifNotNil: [:field | (anObject knownName = #valuePane and: [field type = #code]) ifTrue: [parseAMethod := self object isCompiledMethod. classOrMetaClass := self object methodClass. workspace := self] ifFalse: [parseAMethod := false. classOrMetaClass := self doItReceiver class. workspace := nil]. aStyler environment: self environment; classOrMetaClass: classOrMetaClass; context: self doItContext; parseAMethod: parseAMethod; workspace: workspace]. ! ! !CompiledMethod methodsFor: 'decompiling' stamp: 'mt 12/17/2021 13:39'! decompileWithTemps "Return the decompiled parse tree that represents self, but with the temp names obtained either by compiling the sourcecode, or directly if the method has temps in its trailer." | class selector tempNames source | class := self methodClass ifNil: [Object]. selector := self selector ifNil: [self defaultSelector]. self holdsTempNames ifTrue: [tempNames := self tempNamesString] ifFalse: [| compiler | "No source file or no source (e.g. doits) and no temp names -- decompile without temp names " ((self fileIndex > 0 and: [(SourceFiles at: self fileIndex) isNil]) or: [(source := self getSourceFromFile) isNil]) ifTrue: [^self decompile]. compiler := class newCompiler. compiler parser encoderClass: self encoderClass. tempNames := [(compiler parse: source asString in: class notifying: nil) generate: CompiledMethodTrailer empty; schematicTempNamesString] on: SyntaxErrorNotification do: [:ex | nil]. tempNames ifNil: ["broken source, give up tempNames" ^self decompile]]. ^(self decompilerClass new withTempNames: tempNames) decompile: selector in: class method: self! ! !CompiledMethod methodsFor: 'source code management' stamp: 'mt 12/17/2021 10:54:41.699095'! getSourceFor: selector in: class "Retrieve or reconstruct the source code for this method." | trailer source | (self properties includesKey: #source) ifTrue: [^self properties at: #source]. trailer := self trailer. trailer tempNames ifNotNil: [:namesString | "Magic sources -- decompile with temp names" ^ ((class decompilerClass new withTempNames: namesString) decompile: selector in: class method: self) decompileString]. trailer sourceCode ifNotNil: [:code | ^ code ]. trailer hasSourcePointer ifFalse: [ "No source pointer -- decompile without temp names" ^ (class decompilerClass new decompile: selector in: class method: self) decompileString]. "Situation normal; read the sourceCode from the file" source := [self getSourceFromFileAt: trailer sourcePointer] on: Error "An error can happen here if, for example, the changes file has been truncated by an aborted download. The present solution is to ignore the error and fall back on the decompiler. A more thorough solution should probably trigger a systematic invalidation of all source pointers past the end of the changes file. Consider that, as time goes on, the changes file will eventually grow large enough to cover the lost code, and then instead of falling into this error case, random source code will get returned." do: [ :ex | ex return: nil]. ^source ifNil: [ "Something really wrong -- decompile blind (no temps)" (class decompilerClass new decompile: selector in: class method: self) decompileString]! ! !CompiledMethod methodsFor: '*Etoys-Squeakland-decompiling' stamp: 'mt 12/17/2021 10:54:13.851095'! decompileClass: aClass selector: selector "Return the decompiled parse tree that represents self" ^ self decompilerClass new decompile: selector in: aClass method: self! ! !CompiledMethod methodsFor: '*60Deprecated-decompiling' stamp: 'mt 12/17/2021 13:32:15.240095'! methodForDecompile "Deprecated hook for older implementations of MwMethodWrapper and other object-as-method mechanisms. Not needed by recent implementation of method wrappers here: https://github.com/hpi-swa/MethodWrappers" self flag: #deprecated. ^self! ! !Decompiler methodsFor: 'public access' stamp: 'mt 12/17/2021 10:54:26.994095'! decompile: aSelector in: aClass "See Decompiler|decompile:in:method:. The method is found by looking up the message, aSelector, in the method dictionary of the class, aClass." ^self decompile: aSelector in: aClass method: (aClass compiledMethodAt: aSelector)! ! !Decompiler methodsFor: 'public access' stamp: 'mt 12/17/2021 10:59:58.199095'! decompileBlockMethod: aCompiledBlock aCompiledBlock decompileWithTemps nodesDo: [:node| (node pc isVariableBinding and: [node pc key == aCompiledBlock]) ifTrue: [^node]]. ^self error: 'cannot find block node matching aBlock'! ! !DecompilerTests methodsFor: 'utilities' stamp: 'mt 12/17/2021 10:54:45.377095'! checkDecompileMethod: oldMethod | cls selector oldMethodNode methodNode newMethod oldCodeString newCodeString | cls := oldMethod methodClass. selector := oldMethod selector. oldMethodNode := (cls decompilerClass new withTempNames: oldMethod methodNode schematicTempNamesString) decompile: selector in: cls method: oldMethod. [oldMethodNode properties includesKey: #warning] whileTrue: [oldMethodNode properties removeKey: #warning]. oldCodeString := oldMethodNode decompileString. methodNode := [[| compiler | compiler := cls newCompiler. compiler parser encoderClass: oldMethod encoderClass. compiler compile: oldCodeString in: cls notifying: nil ifFail: []] on: SyntaxErrorNotification do: [:ex| ex errorMessage = 'Cannot store into' ifTrue: [ex return: #badStore]. ex pass]] on: OutOfScopeNotification do: [:ex| ex return: #badStore]. "Ignore cannot store into block arg errors; they're not our issue." methodNode ~~ #badStore ifTrue: [newMethod := methodNode generate. newCodeString := ((cls decompilerClass new withTempNames: methodNode schematicTempNamesString) decompile: selector in: cls method: newMethod) decompileString. "(StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: oldCodeString to: newCodeString)) openLabel: 'Decompilation Differences for ', cls name,'>>',selector" "(StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: oldMethod abstractSymbolic to: newMethod abstractSymbolic)) openLabel: 'Bytecode Differences for ', cls name,'>>',selector" self assert: (oldCodeString = newCodeString or: [(Scanner new scanTokens: oldCodeString) = (Scanner new scanTokens: newCodeString)]) description: cls name asString, ' ', selector asString resumable: true]! ! !CompiledMethod reorganize! ('accessing' defaultSelector dragLabel homeMethod method methodClass methodClass: methodClassAssociation methodClassAssociation: methodHome primitive properties properties: returnField searchForClass searchForSelector selector selector:) ('closures' containsBlockClosures embeddedBlockClosures nestedBlockMethods) ('comparing' equivalentTo: hasSameLiteralsAs:) ('decompiling' compilerClass decompileWithTemps decompilerClass methodNode methodNodeFormattedAndDecorated: parserClass) ('evaluating' valueWithReceiver:arguments:) ('file in/out' objectForDataStream: zapSourcePointer) ('literals' allLiteralsDo: anyAndAllMessages anyAndAllSelectorsDo: literalStrings) ('printing' abstractSymbolic dateMethodLastSubmitted decompileString headerDescription longPrintOn:indent: longPrintRelativeOn:indent: preamble primitiveErrorVariableName printPrimitiveOn: storeLiteralsOn:forClass: timeStamp) ('scanning' hasInstVarRef readsField: readsRef: scanForInstructionPattern: scanForInstructionSequence: writesField: writesRef:) ('source code management' checkOKToAdd:at: copyWithSourceCode: copyWithTempNames: copyWithTempsFromMethodNode: fileIndex filePosition getPreambleFrom:at: getSourceFor:in: getSourceFromFile getSourceFromFileAt: holdsTempNames linesOfCode putSource:fromParseNode:class:category:inFile:priorMethod: putSource:fromParseNode:class:category:withStamp:inFile:priorMethod: putSource:fromParseNode:inFile:withPreamble: setSourcePointer: setSourcePosition:inFile: sourceClass sourceFileStream sourcePointer sourceSelector tempNames tempNamesString) ('testing' hasReportableSlip isAbstract isBlueBookCompiled isClosureCompiled isCompiledMethod isDeprecated isDisabled isDisabled: isImplicitlyRequired isInstalled isLinkedNamedPrimitive isNamedPrimitive isQuick isReturnField isReturnSelf isReturnSpecial isSubclassResponsibility isSubclassResponsibility: usesClosureBytecodes) ('*Tools-Inspector') ('private' markerOrNil penultimateLiteral penultimateLiteral: replace:with:in:) ('accessing-pragmas & properties' hasPragma: pragmaAt: pragmas pragmasAt: propertyKeysAndValuesDo: propertyValueAt: propertyValueAt:ifAbsent: propertyValueAt:put: removeProperty: removeProperty:ifAbsent:) ('*Traits-NanoKernel' originalTraitMethod originalTraitMethod: originalTraitOrClass sameTraitCodeAs:) ('converting' withoutPrimitive) ('copying' copyWithTrailerBytes: postCopy) ('*System-Tools-debugger support' getAndForgetUnbreakpointedOriginal) ('*Tools-Debugger-support' blockExtentsToTempsMap debuggerMap startKey tempsSubSequenceFrom:) ('*Traits-testing' isConflict isExplicitlyRequired isExplicitlyRequired: isImplicitlyRequired: isProvided isProvided: isRequired isRequired: isTraitMethod) ('*45Deprecated') ('*Tools-Debugger' canonicalArgumentName) ('*Etoys-Squeakland-decompiling' decompileClass:selector: methodNodeDecompileClass:selector:) ('*Etoys-Squeakland-printing' who) ('*Compiler-support' mapFromBlockKeys:toSchematicTemps:) ('*60Deprecated-decompiling' methodForDecompile) ('*Compiler-private' newBlockStartMap) ('*60Deprecated-literals' hasLiteralThorough: refersToLiteral:) ('*Tools-Browsing' browse) ('*ast-core') ('*vivide') ('*MethodWrappers') ! !CompiledBlock reorganize! ('testing' isCompiledBlock isQuick) ('accessing' encoderClass homeMethod method methodClass methodNode numCopiedValues outerCode outerCode: primitive selector) ('printing' headerDescription longPrintOn:indent: printReferenceOn:) ('*Tools-Debugger' canonicalArgumentName) ('decompiling' decompile) ('source code management' holdsTempNames) ('accessing-pragmas & properties' pragmaAt: pragmas pragmasAt: propertyKeysAndValuesDo: propertyValueAt: propertyValueAt:ifAbsent: propertyValueAt:put: removeProperty: removeProperty:ifAbsent:) ('*Compiler-support') ('*Tools-Debugger-support' blockExtentsToTempsMap debuggerMap startKey) ('comparing' hasSameLiteralsAs:) ('literals' anyAndAllMessages codeLiteralsDo:) ('copying' postCopy) ('*60Deprecated-decompiling' methodForDecompile) ('*60Deprecated-literals' allSubLiterals) ('*vivide') ('private-copying' copyWithOuterCode:) !