'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 23 June 2003 at 12:01:48 am'! "Change Set: InspectorEnh-ajh Date: 22 June 2003 Author: Anthony Hannan Adds #inspectorClass protocol that #inspect calls to find the appropriate inspector for the receiver. #basicInspect uses a new generic inspector called BasicInspector. CompiledMethods use a new inspector class call CompiledMethodInspector, which display mnemonic bytecode instructions and literals. An inspector will change to the appropriate class when being updated with a new receiver. String asExplorerString has been changed to print its normal printString. "! Inspector subclass: #BasicInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! Inspector subclass: #CompiledMethodInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! !Object methodsFor: 'inspecting' stamp: 'ajh 1/31/2003 15:49'! basicInspect "Create and schedule an Inspector in which the user can examine the receiver's variables. This method should not be overriden." BasicInspector openOn: self withEvalPane: false! ! !Object methodsFor: 'inspecting' stamp: 'ajh 2/3/2003 19:19'! inspect "Create and schedule an Inspector in which the user can examine the receiver's variables." self inspectorClass openOn: self withEvalPane: true! ! !Object methodsFor: 'inspecting' stamp: 'ajh 2/3/2003 19:18'! inspectorClass ^ Inspector! ! !CompiledMethod methodsFor: 'printing' stamp: 'ajh 2/9/2003 14:17'! longPrintOn: aStream "List of all the byte codes in a method with a short description of each" self longPrintOn: aStream indent: 0! ! !CompiledMethod methodsFor: 'printing' stamp: 'ajh 2/9/2003 14:20'! longPrintOn: aStream indent: tabs "List of all the byte codes in a method with a short description of each" self isQuick ifTrue: [self isReturnSpecial ifTrue: [^ aStream tabs: tabs; nextPutAll: 'Quick return ' , (#('self' 'true' 'false' 'nil' '-1' '0' '1' '2') at: self primitive - 255)]. ^ aStream nextPutAll: 'Quick return field ' , self returnField printString , ' (0-based)']. self primitive = 0 ifFalse: [ aStream tabs: tabs. self printPrimitiveOn: aStream. ]. (InstructionPrinter on: self) indent: tabs; printInstructionsOn: aStream. ! ! !CompiledMethod methodsFor: 'printing' stamp: 'ajh 3/20/2001 11:41'! symbolic "Answer a String that contains a list of all the byte codes in a method with a short description of each." | aStream | aStream _ WriteStream on: (String new: 1000). self longPrintOn: aStream. ^aStream contents! ! !CompiledMethod methodsFor: 'literals' stamp: 'ajh 2/9/2003 13:15'! headerDescription "Answer a description containing the information about the form of the receiver and the form of the context needed to run the receiver." | s | s _ '' writeStream. self header printOn: s. s cr; nextPutAll: '"primitive: '. self primitive printOn: s. s cr; nextPutAll: ' numArgs: '. self numArgs printOn: s. s cr; nextPutAll: ' numTemps: '. self numTemps printOn: s. s cr; nextPutAll: ' numLiterals: '. self numLiterals printOn: s. s cr; nextPutAll: ' frameSize: '. self frameSize printOn: s. s cr; nextPutAll: ' isClosureCompiled: '. self isClosureCompiled printOn: s. s nextPut: $"; cr. ^ s contents! ! !CompiledMethod methodsFor: 'user interface' stamp: 'ajh 2/3/2003 19:18'! inspectorClass ^ CompiledMethodInspector! ! !CompiledMethod methodsFor: 'decompiling' stamp: 'ajh 2/9/2003 13:11'! isClosureCompiled "Return true if this method was compiled with the new closure compiler, Parser2 (compiled while Preference compileBlocksAsClosures was true). Return false if it was compiled with the old compiler." ^ self header < 0! ! !Inspector methodsFor: 'accessing' stamp: 'ajh 2/3/2003 19:19'! inspect: anObject "Initialize the receiver so that it is inspecting anObject. There is no current selection." | c | c _ anObject inspectorClass. (self class ~= c and: [self class format = c format]) ifTrue: [ self primitiveChangeClassTo: c basicNew]. self initialize. object _ anObject. selectionIndex _ 0. contents _ ''! ! !BasicInspector methodsFor: 'as yet unclassified' stamp: 'ajh 1/31/2003 15:49'! inspect: anObject "Initialize the receiver so that it is inspecting anObject. There is no current selection." self initialize. object _ anObject. selectionIndex _ 0. contents _ ''! ! !CompiledMethodInspector methodsFor: 'accessing' stamp: 'ajh 1/18/2003 13:47'! fieldList | keys | keys _ OrderedCollection new. keys add: 'self'. keys add: 'all bytecodes'. keys add: 'header'. 1 to: object numLiterals do: [ :i | keys add: 'literal', i printString ]. object initialPC to: object size do: [ :i | keys add: i printString ]. ^ keys asArray ! ! !CompiledMethodInspector methodsFor: 'selecting' stamp: 'ajh 3/20/2003 00:17'! contentsIsString "Hacked so contents empty when deselected" ^ #(0 2 3) includes: selectionIndex! ! !CompiledMethodInspector methodsFor: 'selecting' stamp: 'ajh 1/18/2003 13:56'! selection | bytecodeIndex | selectionIndex = 0 ifTrue: [^ '']. selectionIndex = 1 ifTrue: [^ object ]. selectionIndex = 2 ifTrue: [^ object symbolic]. selectionIndex = 3 ifTrue: [^ object headerDescription]. selectionIndex <= (object numLiterals + 3) ifTrue: [ ^ object objectAt: selectionIndex - 2 ]. bytecodeIndex _ selectionIndex - object numLiterals - 3. ^ object at: object initialPC + bytecodeIndex - 1! ! !CompiledMethodInspector methodsFor: 'selecting' stamp: 'ajh 3/20/2001 11:56'! selectionUnmodifiable "Answer if the current selected variable is unmodifiable via acceptance in the code pane. For most inspectors, no selection and a selection of self (selectionIndex = 1) are unmodifiable" ^ true! ! !ContextVariablesInspector methodsFor: 'accessing' stamp: 'ajh 1/31/2003 15:45'! inspect: anObject "Initialize the receiver so that it is inspecting anObject. There is no current selection." self initialize. object _ anObject. selectionIndex _ 0. contents _ ''! ! !String methodsFor: 'user interface' stamp: 'ajh 9/25/2002 13:10'! asExplorerString ^ self printString! !