SystemOrganization addCategory: #'OB-Debugger'! OBBrowser subclass: #ODDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 19:59'! defaultMetaNode | process context | process := OBMetaNode named: 'process'. context := OBMetaNode named: 'context'. process childAt: #shortStack put: context. ^ process! ! !ODDebugger class methodsFor: 'opening' stamp: 'lr 4/26/2007 09:07'! openProcess: aProcess ^ (self process: aProcess) open! ! !ODDebugger class methodsFor: 'opening' stamp: 'lr 4/26/2007 09:07'! openProcess: aProcess context: aContext ^ (self process: aProcess context: aContext) open! ! !ODDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 14:16'! paneCount ^ 1! ! !ODDebugger class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:09'! process: aProcess ^ self process: aProcess context: nil! ! !ODDebugger class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:05'! process: aProcess context: aContext | processNode contextNode | aProcess isSuspended ifFalse: [ self error: 'Unable to debug a running process.' ]. processNode := ODProcessNode process: aProcess. contextNode := ODContextNode parent: processNode context: (aContext ifNil: [ aProcess suspendedContext ]). ^ self root: processNode selection: contextNode! ! !ODDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 14:16'! title ^ 'Debugger'! ! !ODDebugger methodsFor: 'commands' stamp: 'lr 4/26/2007 15:34'! cmdCommands ^ ODCommand allSubclasses! ! !ODDebugger methodsFor: 'building' stamp: 'lr 4/25/2007 14:14'! defaultBackgroundColor ^ Color lightRed! ! !ODDebugger methodsFor: 'building' stamp: 'lr 4/25/2007 18:44'! initialExtent ^ 600 @ 500 ! ! OBCommand subclass: #ODCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! ODCommand subclass: #ODBrowseCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:37'! execute OBSystemBrowser openOnClass: target theClass selector: target selector! ! !ODBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:41'! group ^ #browse! ! !ODBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:37'! keystroke ^ $b! ! !ODBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:35'! label ^ 'browse'! ! ODBrowseCommand subclass: #ODHierarchyCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODHierarchyCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:38'! execute OBHierarchyBrowser openOnClass: target theClass! ! !ODHierarchyCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:43'! keystroke ^ nil! ! !ODHierarchyCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:42'! label ^ 'browse hierarchy'! ! ODBrowseCommand subclass: #ODImplementorsCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODImplementorsCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:46'! execute OBImplementorsBrowser browseRoot: target methodReference asNode! ! !ODImplementorsCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:40'! keystroke ^ $m! ! !ODImplementorsCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:40'! label ^ 'browse implementors'! ! ODBrowseCommand subclass: #ODSendersCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODSendersCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:46'! execute OBSendersBrowser browseRoot: target methodReference asNode! ! !ODSendersCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:43'! keystroke ^ $n! ! !ODSendersCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:39'! label ^ 'browse senders'! ! !ODCommand methodsFor: 'actions' stamp: 'lr 4/26/2007 09:17'! announce: anAnnouncement requestor announce: anAnnouncement! ! !ODCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! context ^ target context! ! !ODCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 19:02'! isActive ^ requestor isSelected: target! ! !ODCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! process ^ target process! ! !ODCommand methodsFor: 'actions' stamp: 'lr 4/26/2007 09:21'! update self announce: (OBChildrenChanged node: target parent). self announce: (OBSelectingNode node: target parent currentContextNode)! ! ODCommand subclass: #ODInspectCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODInspectCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! execute target context inspect! ! !ODInspectCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:47'! group ^ #inspect! ! !ODInspectCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! label ^ 'inspect context'! ! ODInspectCommand subclass: #ODInspectReceiverCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODInspectReceiverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! execute target context receiver inspect! ! !ODInspectReceiverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! label ^ 'inspect receiver'! ! ODCommand subclass: #ODIntoCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODIntoCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:34'! execute target process step: target context; stepToSendOrReturn. self update! ! !ODIntoCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:07'! label ^ 'into'! ! !ODIntoCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! ODCommand subclass: #ODOverCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODOverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:49'! execute target process completeStep: target context; stepToSendOrReturn. self update! ! !ODOverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:07'! label ^ 'over'! ! !ODOverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! ODCommand subclass: #ODProceedCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:14'! execute World allMorphs do: [ :each | each model == requestor browser ifTrue: [ each delete ] ]. target process resume! ! !ODProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:20'! icon ^ MenuIcons tryIcons: #(smallForwardIcon)! ! !ODProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:07'! label ^ 'proceed'! ! !ODProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! ODCommand subclass: #ODRestartCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODRestartCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:35'! execute self process popTo: self context; restartTop; stepToSendOrReturn. self update! ! !ODRestartCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:09'! label ^ 'restart'! ! !ODRestartCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! ODCommand subclass: #ODReturnCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODReturnCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:39'! execute | expression value | expression := OBTextRequest prompt: 'Enter expression for return value:' template: 'nil'. value := Compiler new evaluate: expression in: target context to: target context receiver. target process popTo: target context sender value: value; stepToSendOrReturn. self update! ! !ODReturnCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:15'! label ^ 'return'! ! !ODReturnCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:15'! wantsButton ^ true! ! ODCommand subclass: #ODTroughCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODTroughCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:34'! execute target process stepToHome: target context; stepToSendOrReturn. self update! ! !ODTroughCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:09'! label ^ 'trough'! ! !ODTroughCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OBNode subclass: #ODDebugNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! ODDebugNode subclass: #ODContextNode instanceVariableNames: 'parent context parseTree sourceMap selectionInterval' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODContextNode class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:05'! parent: aProcessNode context: aContext ^ self basicNew initializeParent: aProcessNode context: aContext! ! !ODContextNode methodsFor: 'comparing' stamp: 'lr 4/26/2007 14:52'! = anObject ^ self class = anObject class and: [ self context = anObject context ]! ! !ODContextNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:48'! context ^ context! ! !ODContextNode methodsFor: 'callbacks' stamp: 'lr 4/26/2007 15:07'! doItContext ^ self context! ! !ODContextNode methodsFor: 'callbacks' stamp: 'lr 4/26/2007 15:07'! doItReceiver ^ self context receiver! ! !ODContextNode methodsFor: 'comparing' stamp: 'lr 4/25/2007 19:56'! hash ^ self context hash! ! !ODContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:04'! homeContext ^ self context finalBlockHome! ! !ODContextNode methodsFor: 'initialization' stamp: 'lr 4/26/2007 14:49'! initializeParent: aProcessNode context: aContext parent := aProcessNode. context := aContext! ! !ODContextNode methodsFor: 'displaying' stamp: 'lr 4/26/2007 09:22'! name ^ self context asString! ! !ODContextNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:17'! parent ^ parent! ! !ODContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 14:50'! parseTree "Answer the parse tree representing the source code of the current context." ^ parseTree ifNil: [ parseTree := self context methodNode ]! ! !ODContextNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:48'! process ^ parent process! ! !ODContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:20'! selectionInterval "Answer the interval of the current source code." | index stop | selectionInterval ifNotNil: [ ^ selectionInterval ]. index := self sourceMap indexForInserting: (Association key: self context previousPc value: nil). index < 1 ifTrue: [ ^ selectionInterval := 0 to: 1 ]. index > self sourceMap size ifTrue: [ stop := self sourceMap detectMax: [ :each | each value last ]. ^ selectionInterval := stop + 1 to: stop ]. ^ selectionInterval := (self sourceMap at: index) value! ! !ODContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 14:52'! sourceMap "Answer a mapping from byte codes to source code ranges." ^ sourceMap ifNil: [ sourceMap := self parseTree sourceMap ]! ! !ODContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:14'! text | contents | contents := self parseTree sourceText asText. self parseTree isDoIt ifFalse: [ contents := contents makeSelectorBold ]. ^ contents! ! !ODContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:06'! text: aString | class | class := self homeContext receiver class whichClassIncludesSelector: self homeContext selector. (class compile: aString) ifNil: [ ^ false ]. self process popTo: self homeContext; restartTopWith: (class compiledMethodAt: self homeContext selector); stepToSendOrReturn. OBAnnouncer current announce: (OBChildrenChanged node: self parent); announce: (OBSelectingNode node: self parent currentContextNode). ^ true! ! !ODContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:07'! textSelection ^ self selectionInterval! ! !ODDebugNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:13'! context "Answer a suspended context." self subclassResponsibility! ! !ODDebugNode methodsFor: 'testing' stamp: 'lr 4/26/2007 15:33'! hasSelector ^ true! ! !ODDebugNode methodsFor: 'testing' stamp: 'lr 4/26/2007 15:33'! hasVersions ^ true! ! !ODDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:46'! methodReference ^ MethodReference class: self theClass selector: self selector! ! !ODDebugNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:12'! process "Answer the suspended process." self subclassResponsibility! ! !ODDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:36'! selector ^ self context selector! ! !ODDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:36'! theClass ^ self context receiver class whichClassIncludesSelector: self selector! ! ODDebugNode subclass: #ODProcessNode instanceVariableNames: 'process' classVariableNames: '' poolDictionaries: '' category: 'OB-Debugger'! !ODProcessNode class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:06'! process: aProcess ^ self basicNew initializeProcess: aProcess! ! !ODProcessNode methodsFor: 'comparing' stamp: 'lr 4/26/2007 14:52'! = anObject ^ self class = anObject class and: [ self process = anObject process ]! ! !ODProcessNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:11'! context ^ process suspendedContext! ! !ODProcessNode methodsFor: 'navigation' stamp: 'lr 4/26/2007 09:21'! currentContextNode ^ ODContextNode parent: self context: self context! ! !ODProcessNode methodsFor: 'comparing' stamp: 'lr 4/25/2007 19:48'! hash ^ self process hash! ! !ODProcessNode methodsFor: 'initialization' stamp: 'lr 4/26/2007 09:11'! initializeProcess: aProcess process := aProcess! ! !ODProcessNode methodsFor: 'navigation' stamp: 'lr 4/25/2007 20:24'! longStack ^ self stackOfSize: 1024! ! !ODProcessNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:22'! name ^ self process asString! ! !ODProcessNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:11'! process ^ process! ! !ODProcessNode methodsFor: 'navigation' stamp: 'lr 4/25/2007 20:25'! shortStack ^ self stackOfSize: 64! ! !ODProcessNode methodsFor: 'navigation' stamp: 'lr 4/26/2007 09:05'! stackOfSize: anInteger "Answer a stack of contexts of the given size." | current stack | current := self context. stack := OrderedCollection new: anInteger. [ current notNil and: [ stack size < anInteger ] ] whileTrue: [ stack addLast: (ODContextNode parent: self context: current). current := current sender ]. ^ stack! !