From VisualWorks®, 7.6 of February 8, 2008 on March 3, 2008 at 9:43:56 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>DebuggerService</name> <environment>CraftedSmalltalk</environment> <super>UI.Model</super> <private>false</private> none processHandle oldCursor receiverInspector contextInspector stackInspector sourceMap currentContext pendingEvents continueInDebuggerCtx finishBlock selector tags stepProbes label serviceProcess selectionRange contextStackPolicy dontUpdateInspectors doSend doSendLoop doStepIntoBlock debugOperationIsActive doItProcess <imports></imports> <category>Tools-Programming</category> <attributes> <package>Debugger-Support</package> </attributes> </class> <comment> CraftedSmalltalk.DebuggerService
DebuggerService is the service portion of the debugger. The debugger service is responsible for controlling the execution of the process being debugged and providing the context stack to the debugger client. Public API The public commands for performing debug operations are found in the "debug commands" protocol. At the conclusion of performing a command the debugger service may perform several "self changed:" sends. Each changed send will indicate what aspect of the debugger has changed. The method #eventOrder contains an array specifying the sequence in which the aspect changes will be broadcast, also see #processEvents. Instance Variables: contextInspector <ContextInspector> contextStackPolicy <ContextListPolicy> loopControlContext <WeakArray of: Context> The context is used in the "nextLoop" debug command as the guard context. Execution of a loop may continue as long as the context does not exit. currentContext <Context> The currently selected context. dontUpdateInspectors <Boolean> This is used by the debugger to prevent the inspectors from being updated when stepping into a block. Normally, the inspectors are updated when the current context changes, however when stepping into a block the current context may change before the operation has completed. This prevents the inspectors from flashing while the operation is still being performed. finishBlock <BlockClosure> The finish block is used to finish debug operations. label <String> A string used as the window title for the debugger. oldCursor <Cursor> The active cursor at the time the debugger is opened on a process. When the process is resumed this cursor is restored. pendingEvents <(Collection of: (Symbol | Array))> This is a collection of the events that must be forwarded to the client. processHandle <ProcessHandle> The process handle of the process being debugged. receiverInspector <PrimitiveObjectInspector> selectionRange <(SequenceableCollection of: Interval)> The selection interval used to insert or select a probe. selector <Symbol> The selector of the selected context. serviceProcess <Process> The process used to perform execution of a debug command. sourceMap <(SortedCollection of: SourceMapEntry)> The source map of the selected method context. This maps the context pc to character position in the source code. stackInspector <StackInspector> stepProbes <OrderedCollection of: CodeProbe> A collection of probes used to stop execution of the "run to caret" command. This really should be a single probe and not a collection. tags <(PDPWeakCollection of: Context)> A collection of bookmarked contexts. doSend <Boolean> doSendLoop <Boolean> doStepIntoBlock <Boolean> debugOperationIsActive <Boolean> doItProcess <Process>
</comment> <name>EventFaithfulDebugging</name> <environment>CraftedSmalltalk.DebuggerService</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Debugger-Support</package> </attributes> <name>DefaultToPermanentProbe</name> <environment>CraftedSmalltalk.DebuggerService</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Debugger-Support</package> </attributes> <name>TempMethods</name> <environment>CraftedSmalltalk.DebuggerService</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Debugger-Support</package> </attributes> <methods> CraftedSmalltalk.DebuggerService <category>private-stack manipulation</category>
byteStep "Steps the context one instruction. Returns true if the context did not change, otherwise it returns false." | currContext | currContext := currentContext pdpCompleteCallee: currentContext step. currContext == currentContext ifTrue: [^true]. self resetContext: currContext. ^false
cutbackTo: aContext finishWith: aBlock | resumeContext unwindContext | resumeContext := processHandle topContext. (resumeContext == aContext or: [(resumeContext hasSender: aContext) not]) ifTrue: [^aBlock value.]. "Don't do unwind." processHandle prepareForSimulation. unwindContext := [self unwind: resumeContext to: aContext] newContext. unwindContext stepUntilVisibleEffect. unwindContext sender: resumeContext. self performDebugOperation: [self forceResetContext: unwindContext. "Do the unwind. We use simulation because if a non-local return is done by an unwind the sending chain is terminated, whereas when done by simulation it is not terminated." self privateSimulateStepIntoBlock. (currentContext hasSender: aContext) ifTrue: [finishBlock := aBlock.]. nil].
finishStep "Step until reaching the next map entry. Update code highlight and inspectors." | stopPC ctx | stopPC := self stopPC. [stopPC == currentContext pc ifTrue: [true] ifFalse: [ctx := currentContext pdpStepUntilPC: stopPC. ctx == currentContext ifFalse: [self resetContext: ctx. ^self finishStep]. stopPC == currentContext pc]] whileFalse: [self byteStep. stopPC := self stopPC]. self schedulePCUpdate. self scheduleInspectorUpdate
forceResetContext: aContext "Makes aContext the top context. This differs from #resetContext: because it forces the source code to be reaquired and it forces the context list to be regenerated. This is necessary if the aContext was already the top context but it was changed in some important aspect." processHandle topContext: aContext. self context: aContext. self scheduleContextListUpdate.
getContinueInDebugCtx | ctx | ctx := continueInDebuggerCtx at: 1. (ctx isNil | (ctx == 0) or: [(processHandle topContext hasSender: ctx) not]) ifTrue: [continueInDebuggerCtx at: 1 put: (ctx := currentContext)]. ^ctx
homeContext | ctx | (ctx := currentContext supposedHome) == nil ifFalse: [^ctx]. self error: (#BlockHomeNotOnStack << #pdp >> 'Block''s home context is not on the current process''s stack.'). ^currentContext
homeContextForCutback ^self homeContextForCutbackOf: currentContext
homeContextForCutbackOf: aContext | ctx | ((ctx := aContext supposedHome) notNil and: [ctx == aContext or: [aContext hasSender: ctx]]) ifTrue: [^ctx]. self error: (#UnableToRestartHomeNotOnStack << #pdp >> ' Unable to restart: block''s home context not on the current process''s stack.'). ^aContext
makeContextProceedable currentContext := currentContext stepUntilProceedable.
resetContext: aContext "Used when a new context becomes top-of-stack, for instance when the method of the selected context is re-compiled, or the simulator steps or returns to a new method." processHandle topContext == aContext ifTrue: [^self]. processHandle topContext: aContext. currentContext == aContext ifFalse: [self context: aContext]. self scheduleContextListUpdate.
resumeProcess oldCursor show. processHandle topContext: currentContext. processHandle resumeProcess.
revertBlock "If the selected context is a block, then restart from beginning of the block or its home." | index | currentContext isBlockContext ifFalse: [^true]. index := Dialog choose: (#IWillRestartFromTheBeginningOf << #pdp >> 'I will restart from the beginning of') labels: (Array with: (#TheBlock << #pdp >> 'The Block') with: (#TheMethod << #pdp >> 'The Method') with: (#Cancel << #pdp >> 'Cancel')) values: #(#method #block #cancel) default: #method for: self interfaceWindow. index = #method ifTrue: [^true]. index = #block ifTrue: [self context: self homeContextForCutback. ^true]. ^false
selectContext: aContext currentContext == aContext ifTrue: [^self]. (aContext isNil or: [self isTerminated or: [processHandle topContext == aContext or: [processHandle topContext hasSender: aContext]]]) ifFalse: [^tags remove: aContext ifAbsent: []]. self context: aContext.
unwind: resumeContext to: aContext [resumeContext unwindUpTo: aContext] ensure: [resumeContext terminateTo: aContext]
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private</category>
basicResetOnMethodChange: newSelector in: classOfMethod context: aContext "Get a new compiled method for aContext and cut the execution stack back to aContext." | newMethod newContext oldHomeContext savContext | newMethod := classOfMethod compiledMethodAt: newSelector. oldHomeContext := self homeContextForCutbackOf: aContext. self cutbackTo: oldHomeContext finishWith: [self performDebugOperation: [newContext := oldHomeContext resizedWith: newMethod. savContext := currentContext. processHandle interrupted: true. self forceResetContext: newContext. (newContext hasSender: savContext) ifTrue: [self context: savContext]. "restore selected context" self scheduleTextUpdate. self resetPCSelection.]].
findOldestContextUsing: oldMethods | ctx oldestContext origOldMethods | origOldMethods := oldMethods collect: [:meth | meth originalMethod]. ctx := processHandle topContext. [ctx == nil] whileFalse: [ctx isBlockContext ifFalse: [(origOldMethods includes: ctx method originalMethod) ifTrue: [oldestContext := ctx]]. ctx := ctx sender]. ^oldestContext
finishRequest self processEvents. self requestComplete. serviceProcess := nil.
performDebugOperation: operationBlock | exp debugBlock finBlock | "Handle recursive calls, this can get us into trouble if we are not careful." Processor activeProcess hasActiveDebugOperation ifTrue: [^operationBlock value]. [currentContext == nil ifTrue: [^self]. debugBlock := [ [ [operationBlock value.] on: ControlInterrupt , ContextEmergencyError do: [:ex | self emergencyRestart: ex]. ] on: Error do: [:ex | exp := ex. self class openOnException: exp]. ]. debugOperationIsActive := true. (processHandle performDebugOperation: debugBlock) ifFalse: [debugOperationIsActive := false. ^self scheduleCloseAction]. debugOperationIsActive := false. finishBlock notNil ifTrue: [finBlock := finishBlock. finishBlock := nil. "Prevent looping in case block resends this method" finBlock value]. exp isNil ifTrue: [^self]. (Dialog confirm: (#SimulationErrorRestartQ << #pdp >> 'Simulation error. Restart the method?') for: nil) ifTrue: [currentContext restart.] ifFalse: [self class openOnException: exp]. exp := nil. ] repeat.
performDebugRequest: aSym self isTerminated ifTrue: [^self finishRequest]. serviceProcess := [Processor activeProcess debugger: self. self perform: aSym. self finishRequest] fork.
performDebugRequest: aSym withArguments: anArray self isTerminated ifTrue: [^self finishRequest]. serviceProcess := [Processor activeProcess debugger: self. self perform: aSym withArguments: anArray. self finishRequest] fork.
resetOnMethodChange: newSelector in: classOfMethod context: aContext "Get a new compiled method for aContext and cut the execution stack back to aContext." self performDebugRequest: #basicResetOnMethodChange:in:context: withArguments: (Array with: newSelector with: classOfMethod with: aContext)
</methods> <methods> CraftedSmalltalk.DebuggerService <category>probes</category>
addBreakpointAt: anInterval | status | selectionRange := anInterval. status := self basicAddProbe: (ProbeCreationSpec type: #Breakpoint conditional: false permanent: self selectedMethod isPartiallyBound & DefaultToPermanentProbe) using: nil. status key ifTrue: [PDPManager changedMethodFrom: self selectedMethod to: self selectedMethod by: self. self removePCUpdate] ifFalse: [status value notNil ifTrue: [self scheduleMessage: status value]]. self processEvents.
addProbeAt: anInterval | status | selectionRange := anInterval. status := self basicAddProbe: nil using: nil. status key ifTrue: [PDPManager changedMethodFrom: self selectedMethod to: self selectedMethod by: self. self removePCUpdate] ifFalse: [status value notNil ifTrue: [self scheduleMessage: status value]]. self processEvents.
addStepProbe: aProbe with: aContext stepProbes add: aProbe -> aContext
basicAddProbe: aProbeSpec using: aProbeRecord ^DebugProbeInserter addProbe: aProbeSpec using: aProbeRecord for: self
findSelectedProbeEmphasisIn: aText ^PDPManager findSelectedProbeEmphasisIn: (aText copyFrom: selectionRange first to: selectionRange last + 1)
modifyProbeAt: anInterval from: aText | emphasis probedMethod | selectionRange := anInterval. probedMethod := self selectedMethod. probedMethod isProbed ifFalse: [^self]. emphasis := self findSelectedProbeEmphasisIn: aText. emphasis isNil ifTrue: [^self scheduleMessage: (#ReselectBreakpointAndReissue << #pdp >> 'Reselect breakpoint and reissue command.')]. emphasis value modifyIn: probedMethod.
removeAllProbes "Removes all the probes from the selected method." | probedMethod allProbes oldOriginal | probedMethod := self selectedMethod. probedMethod isProbed ifFalse: [^self]. allProbes := OrderedCollection new. probedMethod allProbesDo: [:p | allProbes add: p]. (DebugProbeInserter for: self) removeAllProbes: allProbes from: currentContext. oldOriginal := (self selectedClass compiledMethodAt: selector) originalMethod. self selectedClass addSelector: selector withMethod: oldOriginal. PDPManager changedMethodFrom: probedMethod to: oldOriginal by: self. self processEvents.
removeProbeAt: anInterval from: aText | emphasis probedMethod | selectionRange := anInterval. probedMethod := self selectedMethod. probedMethod isProbed ifFalse: [^self]. emphasis := self findSelectedProbeEmphasisIn: aText. emphasis isNil ifTrue: [^self scheduleMessage: (#ReselectBreakpointAndReissue << #pdp >> 'Reselect breakpoint and reissue command.')]. (DebugProbeInserter for: self) basicRemoveProbe: emphasis value. "The following is necessary because apparently the method cache is not completely flushed." ObjectMemory quickGC. PDPManager changedMethodFrom: probedMethod to: probedMethod by: self. self resetPCSelection. self removePCUpdate. self processEvents.
removeStepProbes (DebugProbeInserter for: self) removeStepProbes: stepProbes. stepProbes := OrderedCollection new.
tempMethods ^TempMethods
</methods> <methods> CraftedSmalltalk.DebuggerService <category>testing</category>
areTextProbeCommandsLegal ^selector notNil
contextHasHome ^currentContext home notNil
doesContextHaveInterimValues ^currentContext hasInterimValues
hasActiveDebugOperation ^debugOperationIsActive
hasHomeContextStepped ^currentContext home ~~ currentContext or: [(sourceMap at: 1) key < currentContext pc]
hasLoopControlContext | ctx | ctx := continueInDebuggerCtx at: 1. ^ctx notNil and: [ctx ~~ 0 and: [processHandle topContext == ctx or: [processHandle topContext hasSender: ctx]]]
hasSuspendedOperations | context receiverClass | context := processHandle topContext. [context isNil] whileFalse: [receiverClass := self _objectClass: context homeReceiver. ((receiverClass includesBehavior: DebuggerService) and: [processHandle isInDebugSession]) ifTrue: [^true]. context := context sender]. ^false
isDebugger ^true
isFullStack ^contextStackPolicy isFullStack
isInstalledMethodSourceOutOfSync | meth inMeth | meth := self selectedMethod. inMeth := meth mclass compiledMethodAt: selector ifAbsent: [^false]. ^inMeth getSource ~= meth getSource
isMethodContextSelected ^currentContext home == currentContext
isProbedMethod ^currentContext method isProbed
isStoreLoaded ^#{Store.DbRegistry} isDefined
isTerminated ^processHandle isTerminated
isTopContextSelected ^currentContext == self interruptedContext
</methods> <methods> CraftedSmalltalk.DebuggerService <category>context list</category>
context: aContext "Set aContext to be the currently viewed context. This involves resetting all the inspectors, the viewed source code, and the exception handling signals." | oldContext | oldContext := currentContext. currentContext := aContext. currentContext == nil ifTrue: [self refreshInspectorsFromCurrentContext. self scheduleTextUpdate. selector := nil. ^self]. selector := currentContext method isProbed ifTrue: [currentContext method homeMethod selector] ifFalse: [currentContext selector]. [(oldContext == nil or: [oldContext method ~~ currentContext method]) ifTrue: [sourceMap := [currentContext sourceMap. "will compute tempNames"] on: Error do: [:x | x return: SortedCollection new]]. ] on: Metaclass obsoleteSignal do: [:ex | ]. dontUpdateInspectors ifFalse: [self refreshInspectorsFromCurrentContext]. self scheduleTextUpdate. self schedulePCUpdate. currentContext == processHandle topContext ifFalse: [^self]. currentContext atEnd ifTrue: [^self]. "The following only has an effect when the context is entered. It positions the pc just before the first/next executable statement." currentContext pc = self stopPC ifTrue: [^self]. self performDebugOperation: [self privateStep].
refreshInspectorsFromCurrentContext | receiver | receiver := currentContext isNil ifTrue: [nil] ifFalse: [currentContext intendedReceiver]. (self _object: receiver eqeq: nil) ifTrue: [receiverInspector setObject: nil. receiverInspector empty] ifFalse: [receiverInspector setObject: receiver]. contextInspector inspect: currentContext. stackInspector context: currentContext isTop: currentContext == processHandle topContext. self scheduleResetInspectorFields
selectContextAt: anIndex self selectContext: (contextStackPolicy contextSelectedAt: anIndex). self processEvents.
</methods> <methods> CraftedSmalltalk.DebuggerService <category>tags</category>
addTag (tags includes: currentContext) ifTrue: [^self]. tags add: currentContext.
hasTags ^tags size > 0
isCurrentContextTagged ^tags includes: currentContext
isTagged: aString tags detect: [:c | c printString = aString] ifNone: [^false]. ^true
removeTag tags remove: currentContext ifAbsent: []
selectTag: aString | ctx | ctx := tags detect: [:c | c printString = aString] ifNone: [^self]. self selectContext: ctx. self scheduleContextListSelectionUpdate. self processEvents.
tagMenuList | col | col := tags asSortedCollection: [:a :b | a hasSender: b]. col := col reject: [:ctx | ctx hasExited]. tags := PDPWeakCollection withAll: col. ^col collect: [:ctx | ctx printString].
</methods> <methods> CraftedSmalltalk.DebuggerService <category>accessing</category>
clearDoSend doSend := false.
clearDoSendLoop doSendLoop := false.
context "Answer the currently viewed context." ^currentContext
contextInspector ^contextInspector
contextList ^contextStackPolicy contextList
contextListForUI ^contextStackPolicy filteredStack
indexOfCurrentContext ^contextStackPolicy indexOfCurrentContext
interfaceWindow ^nil
interruptedContext "Answer the suspended context of the interrupted process." ^processHandle topContext
isSend ^doSend
isSendLoop ^doSendLoop
isStepIntoBlock ^doStepIntoBlock
label self isTerminated ifTrue: [^(#TerminatedProcess << #pdp >> 'Terminated Process') asString]. ^label
label: aString label := aString
mayProceed ^true
pcRange ^CompiledCode nPCMapErrorSignal handle: [:ex | false -> ex errorString] do: [true -> self privatePcRange].
receiverInspector ^receiverInspector
selectedClass "Answer the class object that is currently selected." ^ currentContext == nil ifTrue: [nil] ifFalse: [currentContext mclass]
selectedMethod | ctx | currentContext isNil ifTrue: [^nil]. ctx := currentContext supposedHome. ctx isNil ifTrue: [^currentContext method homeMethod]. ^ctx method
selectionRange ^selectionRange
selector ^selector
setDoSend doSend := true.
setDoSendLoop doSendLoop := true.
stackFilterPatterns: patternArrays convertSelector: convertSym matchSelector: matchSym displayAllLimit: aNumber contextStackPolicy patterns: patternArrays. contextStackPolicy conversionSymbol: convertSym. contextStackPolicy matchSymbol: matchSym. contextStackPolicy displayAllLimit: aNumber.
stackInspector ^stackInspector
text | theText meth | currentContext isNil ifTrue: [^Text new]. ^[theText := currentContext sourceCode asText. currentContext method homeMethod usuallyHasSelector ifTrue: [theText makeSelectorBoldIn: currentContext mclass]. (meth := self selectedMethod) isProbed ifTrue: [meth highlightProbesIn: theText]. theText] on: MethodDictionary keyNotFoundSignal do: [:ex | ((#noSourceCodeFor1s << #pdp >> 'no source code for <1s>') expandMacrosWith: currentContext printString) asText emphasizeAllWith: #italic; yourself].
topContext ^processHandle topContext
</methods> <methods> CraftedSmalltalk.DebuggerService <category>return commands</category>
evaluateExpressionInReceiver: string | status object | status := true. object := currentContext receiver class evaluatorClass new evaluate: string in: currentContext receiver: currentContext receiver notifying: nil ifFail: [status := false]. ^status -> object
returnLastDoIt: rtnMsg self completeReturn: rtnMsg with: processHandle proceedValue
returnNewExpr: rtnMsg with: object self completeReturn: rtnMsg with: object
returnSelf: rtnMsg self completeReturn: rtnMsg with: currentContext receiver
returnTOS: rtnMsg self completeReturn: rtnMsg with: currentContext top
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private-reflection protocol</category>
_object: anObject eqeq: anOtherObject "Answer true if the arguments are actually the same object." <primitive: 210> ^self primitiveFailed
_objectClass: anObject "Answer the object which is the argument's class.." <primitive: 211> ^self primitiveFailed
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private-event processing</category>
changedLabel self changed: #windowLabel with: label
changedPC | range | range := self pcRange. range key ifFalse: [^self changed: #showMessage with: range value]. self changed: #pcRange with: range.
closeDebugger self changed: #closeDebugger
debuggerSelectedTopContext self changed: #debuggerSelectedTopContext
eventOrder ^#(#changedLabel #updateContextList #updateContextListSelection #updateText #changedPC #resetInspectorFields #updateInspectors #closeDebugger #debuggerSelectedTopContext)
processEvents self eventOrder do: [:event | (pendingEvents remove: event ifAbsent: [nil]) == nil ifFalse: [self perform: event]]. pendingEvents do: [:ar | self perform: (ar at: 1) with: (ar at:2)]. "Presently, this is for #showMessage only." pendingEvents := Set new.
removePCUpdate pendingEvents remove: #changedPC ifAbsent: []
requestComplete self changed: #requestComplete
scheduleCloseAction pendingEvents add: #closeDebugger
scheduleContextListSelectionUpdate pendingEvents add: #updateContextListSelection.
scheduleContextListUpdate pendingEvents add: #updateContextList.
scheduleInspectorUpdate pendingEvents add: #updateInspectors
scheduleLabelUpdate pendingEvents add: #changedLabel.
scheduleMessage: aString pendingEvents add: (Array with: #showMessage: with: aString asString).
schedulePCUpdate pendingEvents add: #changedPC
scheduleResetInspectorFields pendingEvents add: #resetInspectorFields
scheduleTextUpdate pendingEvents add: #updateText. pendingEvents add: #changedPC
showMessage: aString self changed: #showMessage with: aString.
updateContextList contextStackPolicy computeContextList. self changed: #contextList with: self indexOfCurrentContext
updateContextListSelection self changed: #contextSelection with: self indexOfCurrentContext
updateText self changed: #text
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private-menu messages</category>
basicContinue "Continue execution from the interrupted state of the top context." currentContext := processHandle topContext. processHandle interrupted not ifTrue: [currentContext pc. currentContext push: processHandle proceedValue]. self performDebugOperation: [self makeContextProceedable]. self resumeProcess.
basicFirstLoop self performDebugOperation: [self privateFirstLoop].
basicJumpToCaret "Finds the closest proper point before the caret and causes the context to jump to it, then completely pops the context stack. Proper jump points cannot be inside a loop, or cannot be after loop preperation, and must have a stack depth of 0. Also, jumps into or out of blocks are not permitted." | probeRecord theContext | self checkContextSelection. currentContext sourceInfo: [:nodeHolder :i | probeRecord := nodeHolder node jumpRecordFor: selectionRange blkIndex: currentContext method blockMethodIndex]. probeRecord isNil ifTrue: [^self scheduleMessage: (#JumpPointIsNotInBlock << #pdp >> 'Jump point is not in the same block. Try again.')]. currentContext == processHandle topContext ifFalse: [(Dialog confirm: (#TopSendNotSelected << #pdp >> 'You do not have the top message send selected. Abandon the message sends from the selection up to the top message send and proceed with the jump operation?') initialAnswer: false) ifFalse: [^self]]. currentContext == processHandle topContext ifTrue: [self performDebugOperation: [self finishJumpToCaretUsing: probeRecord]] ifFalse: ["Simulate a return from context that has 'context' as its immediate sender, and unwind all child active sends." theContext := currentContext. self cutbackTo: theContext finishWith: [self performDebugOperation: [theContext push: nil. "simulate a return value" processHandle interrupted: true. self resetContext: theContext. self finishStep. self finishJumpToCaretUsing: probeRecord]]]. self schedulePCUpdate. self scheduleInspectorUpdate.
basicMakeFullMethod self performDebugOperation: [self privateMakeFullMethod].
basicMoreStack contextStackPolicy moreStack ifFalse: [^self]. self scheduleContextListUpdate.
basicNextLoop self performDebugOperation: [self privateNextLoop].
basicPause "Continue execution from the interrupted state of the top context." currentContext := processHandle topContext. processHandle interrupted not ifTrue: [currentContext pc. currentContext push: processHandle proceedValue]. self performDebugOperation: [self makeContextProceedable]. processHandle topContext: currentContext. processHandle pauseProcess. self scheduleCloseAction.
basicProceed "Proceed from the interrupted state of the currently selected context. Instructions pending execution in methods entered after the selected context are not executed." | pushValue theContext | self checkContextSelection. pushValue := (currentContext ~= processHandle topContext) | (processHandle interrupted not). theContext := currentContext. self cutbackTo: theContext finishWith: [pushValue ifTrue: [theContext pc. theContext push: processHandle proceedValue]. processHandle topContext: theContext. currentContext := theContext. self performDebugOperation: [self makeContextProceedable. nil]. self resumeProcess].
basicReenter "Reset to the initial state of the currently selected context, i.e. as if the context had just been entered." | theContext | self checkContextSelection. self revertBlock ifFalse: [^self]. theContext := currentContext. self cutbackTo: theContext finishWith: [self performDebugOperation: [theContext restart. processHandle interrupted: true. self forceResetContext: theContext. theContext pdpStepUntilPC: self stopPC. self schedulePCUpdate. nil]].
basicRestart "Proceed from the initial state of the currently selected context. The argument is a controller on a view of the receiver. That view is closed." | theContext | self checkContextSelection. self revertBlock ifFalse: [^self]. theContext := currentContext. self cutbackTo: theContext finishWith: [theContext restart. processHandle interrupted: true. processHandle topContext: theContext. currentContext := theContext. self performDebugOperation: [self makeContextProceedable. nil]. processHandle topContext: currentContext. self resumeProcess].
basicSelectHomeContext | ctx | ctx := currentContext supposedHome. ctx isNil ifTrue: [^self scheduleMessage: (#TheHomeContextIsNotOnTheStack << #pdp >> 'The home context is not on the stack.')]. self context: ctx. self scheduleContextListSelectionUpdate. self processEvents.
basicSend self performDebugOperation: [self privateSend].
basicSkipToCaret self performDebugOperation: [self privateSkipToCaret].
basicStep self performDebugOperation: [self privateStep].
basicStepIntoBlock self performDebugOperation: [self privateStepIntoBlock].
finishJumpToCaretUsing: probeRecord | targetPC | processHandle prepareForSimulation. currentContext pc = 1 ifTrue: [self resetContext: currentContext. "In case of restart, set the context to be the top."]. currentContext clearStack. "This statement must preceed the 'AuxCode...' depth test stmt." targetPC := probeRecord insertionPC. "On the surface the following looks incomplete. However, the obtained targetPC is always at the beginning of a statement. The only way the stack depth at the beginning of a statement cannot be 0 is if it was preceeded by a popPush code." (targetPC > 1 and: [currentContext isPopPushAt: targetPC - 1]) ifTrue: [((AuxCodeInfoExtractor on: currentContext method) depthAt: targetPC) ~= currentContext stackP ifTrue: [currentContext push: nil. "push dummy onto stack" targetPC := targetPC - 1]]. currentContext jump: targetPC - currentContext pc. currentContext pc = self stopPC ifFalse: [self privateStep].
privateFirstLoop "Sets the controlling context to the selected context and executes continually in the debugger until an break occurs or the method returns." self checkContextSelection. self setLoopControlContext. self privateNextLoop.
privateMakeFullMethod "This method assumes the selected context is a method context. It cuts back the context stack to the context and replaces the context's method with a temporary new full probed method." | tempMethod newMethod newContext theContext | tempMethod := TempMethods at: currentContext ifAbsent: []. newMethod := (currentContext method mclass compiledMethodAt: selector) newTempFullProbedMethod. tempMethod notNil ifTrue: [tempMethod allProbesDo: [:aProbe | aProbe isTemporary ifTrue: [aProbe reinsertInto: newMethod]]]. theContext := currentContext. self cutbackTo: theContext finishWith: [self performDebugOperation: [newContext := theContext resizedWith: newMethod. TempMethods at: newContext put: newMethod. sourceMap := newContext visibleSourceMap. processHandle interrupted: true. self forceResetContext: newContext. nil]].
privateNextLoop "Executes continually in the debugger until an break occurs or the method returns." | currContext parentContext | self checkContextSelection. processHandle prepareForSimulation. currentContext pc = 1 ifTrue: [self resetContext: currentContext. "In case of restart, set the context to be the top."]. currContext := parentContext := self getContinueInDebugCtx. currContext == processHandle topContext ifFalse: [currContext := currContext pdpCompleteCallee: processHandle topContext]. currContext == parentContext ifTrue: [currContext := currContext stepForever]. currContext == processHandle topContext ifTrue: [self context: currContext] ifFalse: [self resetContext: currContext]. self scheduleInspectorUpdate.
privateRunTillBreak | currContext homeContext | homeContext := currentContext supposedHome. currContext := currentContext. [currentContext == processHandle topContext ifFalse: [currContext := currentContext pdpCompleteCallee: processHandle topContext]. currContext == currentContext ifTrue: [ [currContext := currContext stepForever. (currContext supposedHome == homeContext and: [currContext willExitMethod]) not and: [currContext hasSender: homeContext]] whileTrue: [currContext := currContext pdpCompleteCallee: currContext step]]. self removeStepProbes] on: ControlInterrupt , ContextEmergencyError do: [:ex | ex restartDo: [self emergencyRestart: ex. self removeStepProbes. self scheduleTextUpdate. ^true]]. ^false
privateSend "The top context on the stack must be selected. This being so, either some message is about to be sent in that context, or that context is about to return. Send is only effective in the former case. It will cause the next message to be sent. The send is actually simulated, so that the debugger will regain control at the beginning of the method which is invoked (unless it is a primitive). In this way, you can step your way deeper into a computation" | newCtx | self checkContextSelection. currentContext ~~ processHandle topContext ifTrue: [^self]. processHandle prepareForSimulation. newCtx := currentContext pdpStepUntilVisibleEffect. newCtx := newCtx == currentContext ifTrue: [currentContext send] ifFalse: [currentContext pdpCompleteCallee: newCtx]. newCtx == currentContext ifTrue: [^self finishStep]. self resetContext: newCtx. currentContext pdpStepUntilPC: self stopPC. self schedulePCUpdate.
privateSimulateStepIntoBlock "The top context on the stack must be selected. Keep sending until a child block of the selected context's home method is entered." | newCtx | newCtx := currentContext sendIntoBlockStartingWithCallee: processHandle topContext pdpStepUntilVisibleEffect. self forceResetContext: newCtx. self finishStep
privateSkipToCaret "Executes and stops at the beginning of a statement that the user indicates by a caret. The breakPC is one after the last executed pc." | currContext probeRecord breakMethod probe stopPC status | self checkContextSelection. processHandle prepareForSimulation. currentContext pc = 1 ifTrue: [self resetContext: currentContext. "In case of restart, set the context to be the top."]. probeRecord := currentContext sourceInfo: [:nodeHolder :i | nodeHolder node probeRecordFor: selectionRange]. breakMethod := currentContext method homeMethod blockAt: probeRecord blockMethodIndex. breakMethod == currentContext method ifTrue: [currContext := currentContext. currentContext == processHandle topContext ifFalse: [currContext := currentContext pdpCompleteCallee: processHandle topContext]. stopPC := probeRecord insertionPC. currContext == currentContext ifTrue: [currContext := currContext stepUntilSkipPC: stopPC]] ifFalse: [breakMethod homeMethod isProbeable ifFalse: [^self scheduleMessage: (#CannotInsertProbeIntoThisMethodType << #pdp >> 'Sorry, probes cannot be inserted into this method type.')]. status := self basicAddProbe: (ProbeCreationSpec type: #Breakpoint conditional: false permanent: false) setIsAutoProbe using: probeRecord. status key ifFalse: [^self scheduleMessage: status value]. probe := status value. self addStepProbe: probe with: currentContext supposedHome. self privateRunTillBreak ifTrue: [^self]]. currContext == processHandle topContext ifTrue: [self context: currContext] ifFalse: [self resetContext: currContext]. self scheduleInspectorUpdate
privateStep "Step will cause the next message to be sent, or the expression to be assigned, or the return to be executed. In either case, the debugger regains control so that you can step your way down through a method, and out to the caller when it returns." self checkContextSelection. processHandle prepareForSimulation. currentContext pc = 1 ifTrue: ["In case of restart, set the context to be the top." self resetContext: currentContext]. currentContext == processHandle topContext ifTrue: [self byteStep] ifFalse: [self resetContext: (currentContext pdpCompleteCallee: processHandle topContext)]. self finishStep.
privateStepIntoBlock | closures origMethod | self checkContextSelection. processHandle prepareForSimulation. currentContext pc = 1 ifTrue: [self resetContext: currentContext "In case of restart, set the context to be the top."]. (currentContext ~~ processHandle topContext or: [currentContext supposedHome isNil]) ifTrue: [^self privateSimulateStepIntoBlock]. origMethod := currentContext method homeMethod originalMethod. closures := currentContext messageObjects select: [:obj | (obj isKindOf: BlockClosure) and: [obj method homeMethod originalMethod == origMethod]]. closures do: [:cl | cl changeClassTo: DebugStepIntoBlockClosure]. [| startContext currContext | doStepIntoBlock := true. dontUpdateInspectors := true. startContext := currentContext. self byteStep. self finishStep. currContext := startContext stepToCtxtWithSameParentAs: currentContext. currContext == currentContext ifFalse: [self resetContext: currContext]. dontUpdateInspectors := false. self refreshInspectorsFromCurrentContext] on: ControlInterrupt , ContextEmergencyError do: [:ex | ex restartDo: [closures do: [:cl | cl changeClassTo: BlockClosure]. doStepIntoBlock := false. self emergencyRestart: ex. dontUpdateInspectors := false. self refreshInspectorsFromCurrentContext. self scheduleTextUpdate]]. doStepIntoBlock := false. closures do: [:cl | cl changeClassTo: BlockClosure]
setLoopControlContext ^continueInDebuggerCtx at: 1 put: currentContext
</methods> <methods> CraftedSmalltalk.DebuggerService <category>doIt/accept/explain</category>
abortDoIt doItProcess isNil ifTrue: [^self]. [doItProcess interruptWith: [Object userInterruptSignal interruptWith: thisContext sender sender errorString: (#OperationAborted << #pdp >> 'Operation aborted') asString]] on: Error do: [:ex | ] "Ignore error"
acceptTextFrom: textController | result | result := self compileText: textController text from: textController. result isNil ifTrue: [^nil]. self methodChanged: result key selector: result value. ^true
basicMethodChanged: newMethod selector: aSelector | classOfMethod newContext | classOfMethod := currentContext mclass. newContext := self homeContextForCutback. self cutbackTo: newContext finishWith: [self performDebugOperation: [newContext := newContext resizedWith: newMethod. (classOfMethod compiledMethodAt: aSelector) == newMethod ifFalse: [TempMethods at: newContext put: newMethod]. sourceMap := newContext visibleSourceMap. processHandle interrupted: true. self forceResetContext: newContext]]. self scheduleTextUpdate. self processEvents. ^true
browseMethod "Ideally, this should be inlined, left for now to support the Diggy plugin." self browseSelectedContext
compileDoItFrom: textController "Compile the current text selection as an expression and answer the resulting method. Signal CompilationError if compilation fails." | compiler strm | strm := ReadStream on: textController text asString from: textController selectionStartIndex to: textController selectionStopIndex - 1. compiler := self doItReceiver class evaluatorClass new. ^compiler compile: strm in: self doItContext allowReceiver: true class: self doItReceiver class environment: self doItEnvironment noPattern: true notifying: textController ifFail: [CompilationError raise] handler: (compiler interactiveCompilerErrorHandlerClass new editor: textController)
compileText: theText from: textController | oldMethod classOfMethod newSelector newMethod package previousNamespace | oldMethod := self selectedMethod. classOfMethod := oldMethod mclass. package := Store.Registry containingPackageForSelector: oldMethod selector class: classOfMethod. previousNamespace := package environmentFor: oldMethod selector in: classOfMethod. Store.Policies packagePolicy forcePackage: package while: [ newSelector := classOfMethod compile: theText classified: ClassOrganizer defaultProtocol notifying: textController environment: previousNamespace]. newSelector == nil ifTrue: [^nil]. "must fix this, nothing happens" newMethod := classOfMethod compiledMethodAt: newSelector. newSelector ~~ selector ifTrue: [self spawnBrowserOnMethod: newMethod. self context: currentContext. "Reselect current context and refresh display" self processEvents. ^nil]. oldMethod isProbed ifTrue: [newMethod := PDPManager reinsertProbesAfterMethod: newMethod recompileFor: theText]. PDPManager changedMethodFrom: oldMethod to: newMethod by: self. ^newMethod -> newSelector
debugFrom: textController | code rcvr proc | [code := self compileDoItFrom: textController] on: CompilationError do: [:ex | ^self]. rcvr := self doItReceiver. proc := [rcvr performMethod: code with: currentContext.] newProcess. "The following is executed in another process because the 'send' message will use the process debugger ivar and in this case we don't want it use the one from the active process." [| ctx | ctx := proc suspendedContext. ctx receiver pushCopiedValues: ctx. [ctx method == code] whileFalse: [ctx := ctx send]. proc suspendedContext: ctx.] forkAt: Processor activeProcess priority + 1. Notifier developmentNotifier openOnProcess: proc interrupted: true label: (#DebugIt << #pdp >> 'Debug It').
doItContext "Answer the context in which a text selection can be evaluated." ^currentContext
doItEnvironment "Answer the object that should be informed of the result of evaluating a text selection." currentContext == nil ifTrue: [^ nil]. ^currentContext method environment
doItReceiver "Answer the object that should be informed of the result of evaluating a text selection." currentContext == nil ifTrue: [^ nil]. ^currentContext homeReceiver
doItValue: anObject "Set the value to be returned when the interrupted process proceeds." processHandle proceedValue: anObject
evaluateTextFrom: textController action: aSymbol | code | [code := self compileDoItFrom: textController] on: CompilationError do: [:ex | ^self requestComplete]. doItProcess := [| result | [result := self doItReceiver performMethod: code with: currentContext. self doItValue: result. self changed: #evaluationResult with: (Array with: aSymbol with: result)] ensure: [self requestComplete. doItProcess := nil]] fork.
explainFor: aController "Try to shed some light on what kind of entity the controller's current selection is. The selection must be a single token or construct." Explainer explain: aController selection string class: self selectedClass selector: selector methodText: self text for: self
explainSpecial: string for: explainer "Answer with a string explaining the code view selection if it is displaying one of the special edit functions." ^nil
formatFor: aController | theText | theText := (Refactory.Browser.RBParser parseMethod: aController text onError: [:aString :position | ^aController insertAndSelect: (#x1s << #pdp >> '<1s> -%>' expandMacrosWith: aString) at: position]) formattedCode. theText isNil ifTrue: [^nil]. theText := theText asText makeSelectorBoldIn: currentContext mclass. aController selectFrom: 1 to: aController text size; deselect; replaceSelectionWith: theText asText; selectAt: 1. aController view selectionStopIndex: aController text size + 1. aController view invalidate
methodChanged: newMethod selector: aSelector self performDebugRequest: #basicMethodChanged:selector: withArguments: (Array with: newMethod with: aSelector)
spawnBrowserOnMethod: aMethod Refactory.Browser.RefactoringBrowser openOnEnvironment: (Refactory.Browser.SelectorEnvironment onMethods: (Array with: (Refactory.Browser.RBMethodDefinition class: aMethod mclass selector: aMethod selector)))
</methods> <methods> CraftedSmalltalk.DebuggerService <category>must fix</category>
changedMethodFrom: oldMethod to: newMethod by: aBrowser "This message notifies the receiver that the method text for some method has changed and should be updated." | oldestContext message answer aSelector aClass | self isTerminated ifTrue: [^self]. serviceProcess notNil "If not nil then we are executing a debug operation." ifTrue: [^self]. (oldMethod isNil or: [processHandle isInDebugSession not]) ifTrue: [^self]. aSelector := newMethod selector. aClass := newMethod mclass. (aBrowser == self and: [aClass == self selectedClass and: [aSelector == self selector]]) ifTrue: [self scheduleTextUpdate. ^self resetPCSelection]. (oldestContext := self findOldestContextUsing: (Array with: oldMethod originalMethod)) == nil ifTrue: [^self]. message := (#Method1sInClass2sChangedWhatToDo << #pdp >> 'The method <1s> in class <2s> has changed, and is in the debugger sender chain.<n>What do you want to do?') expandMacrosWith: aSelector with: aClass shortName. answer := Dialog choose: message asParagraph centered labels: (Array with: (#ExitDebugger << #pdp >> 'Exit Debugger') with: (#IgnoreChange << #pdp >> 'Ignore Change') with: (#ResendMessage << #pdp >> 'Resend Message')) values: #(0 1 2) default: 0. answer = 0 ifTrue: [^self closeDebugger]. self scheduleContextListUpdate. answer = 2 ifTrue: [self resetOnMethodChange: aSelector in: aClass context: oldestContext]. self processEvents
makeProbeTyped: probeType using: aProbeRecord at: anInterval method: probedMethod "Prompts the user to select a probe and returns an Association where the key is the probe and the value is the conditional flag." | probe probeRecord | probeRecord := aProbeRecord isNil ifTrue: [probedMethod probeRecordFor: anInterval] ifFalse: [aProbeRecord]. probeType == #Breakpoint ifTrue: [probe := CodeProbe new]. probeType == #Variable ifTrue: [probe := self promptForProbeVariableClass: self selectedClass method: probedMethod record: probeRecord. probe isNil ifTrue: [^nil]]. probeType == #Expression ifTrue: [probe := DisplayActionProbe new]. probe record: probeRecord. ^probe
promptForProbeVariableClass: aClass method: probedMethod record: probeRecord "Prompts the user to select a probe and returns an Association where the key is the probe and the value is the conditional flag." | legalTempNames legalTemps ivarNames dialog aBuilder ivar tmpVar windoe wVar varType | windoe := self interfaceWindow. wVar := ValueHolder newString. legalTemps := OrderedCollection new. (probedMethod variableMapAt: probeRecord blockMethodIndex) temps do: [:var | (var key first == $. or: [legalTemps contains: [:lvar | lvar key = var key]]) ifFalse: [legalTemps add: var]]. legalTempNames := legalTemps collect: [:ac | ac key]. ivarNames := aClass allInstVarNames. dialog := SimpleDialog new. dialog initializeBuilderFor: windoe. aBuilder := dialog builder. aBuilder aspectAt: #TOS put: [varType := #tos. wVar value: 'Top of Stack']. aBuilder aspectAt: #iVar put: [ivar := (Menu labelArray: ivarNames values: ivarNames) startUp. ivar ~~ 0 ifTrue: [wVar value: ivar. varType := #inst]]. aBuilder aspectAt: #tVar put: [tmpVar := (Menu labelArray: legalTempNames values: legalTemps) startUp. tmpVar ~~ 0 ifTrue: [wVar value: tmpVar key. varType := #tmp]]. aBuilder aspectAt: #wVar put: wVar. dialog builder add: (UISpecification from: self class watchVarSpec). dialog initializeWindowFor: windoe. ivarNames isEmpty ifTrue: [(aBuilder componentAt: #IvarSwitch) disable]. legalTemps isEmpty ifTrue: [(aBuilder componentAt: #TempSwitch) disable]. dialog preOpen. dialog builder openDialogWithExtent: dialog builder window displayBox extent. dialog accept value ifFalse: [^nil]. varType == nil ifTrue: [^nil]. varType == #tos ifTrue: [^DisplayTOSProbe new]. varType == #inst ifTrue: [^DisplayInstanceVarProbe name: ivar index: (ivarNames indexOf: ivar)]. ^DisplayMethodVarProbe slot: tmpVar
</methods> <methods> CraftedSmalltalk.DebuggerService <category>debug commands</category>
abortDebugOperation doItProcess notNil ifTrue: [^self abortDoIt]. serviceProcess isNil ifTrue: [^self]. processHandle abortDebugOperation.
abortDebugOperationInProcess: proc self abortDebugOperation.
continue self performDebugRequest: #basicContinue.
ctrlyAbort self abortDebugOperation
firstLoop self performDebugRequest: #basicFirstLoop.
jumpToCaretAt: selectionInterval selectionRange := selectionInterval. self performDebugRequest: #basicJumpToCaret
makeFullMethod self performDebugRequest: #basicMakeFullMethod.
moreStack self performDebugRequest: #basicMoreStack.
nextLoop self performDebugRequest: #basicNextLoop.
pause self performDebugRequest: #basicPause.
proceed self performDebugRequest: #basicProceed.
reenter self performDebugRequest: #basicReenter.
restart self performDebugRequest: #basicRestart.
return self performDebugRequest: #basicReturn.
selectHomeContext self performDebugRequest: #basicSelectHomeContext.
send self performDebugRequest: #basicSend.
skipToCaretAt: selectionInterval selectionRange := selectionInterval. self performDebugRequest: #basicSkipToCaret.
step self performDebugRequest: #basicStep.
stepIntoBlock self performDebugRequest: #basicStepIntoBlock.
terminate processHandle terminate
</methods> <methods> CraftedSmalltalk.DebuggerService <category>spelling correction</category>
basicDefineMethod | contextSelector | contextSelector := self context selector. contextSelector == #doesNotUnderstand: ifTrue: [^self defineMethodForDoesNotUnderstand]. contextSelector == #subclassResponsibility ifTrue: [^self defineMethodForSubclassResponsibility]. Dialog warn: (#UnhandledSelectorForDefineIt << #pdp >> 'Unhandled selector "<1p>" for Define It' expandMacrosWith: contextSelector)
canCorrectSpelling "Spelling can be corrected if the context above the selected context is #doesNotUnderstand and selected context is not sending a special messge and the selected context is also not #doesNotUnderstand." | ctx sel | ctx := self contextFirstSendingDNU. ctx == self topContext ifTrue: [^false]. sel := self getSentSelectorFor: ctx. ^(#(#doesNotUnderstand: #perform: #perform:with: #perform:with:with: #perform:with:with:with: #perform:withArguments: #_object:perform:withArguments:) includes: sel) not
canDefineMethod ^#(doesNotUnderstand: subclassResponsibility) includes: self topContext selector
compileTemplate: aSelector inClass: aClass | keyWords strm nArg | keyWords := aSelector keywords. strm := WriteStream on: (String new: 64). nArg := 1. keyWords do: [:str | strm nextPutAll: str. str last = $: ifTrue: [strm space. strm nextPutAll: 'arg'. nArg printOn: strm]. nArg := nArg + 1] separatedBy: [strm space]. strm nextPutAll: ' "Dummy method template. This was installed by the debugger define method command." ^self halt'. aClass compile: strm contents classified: ClassOrganizer defaultProtocol notifying: nil.
contextFirstSendingDNU ^contextStackPolicy contextList detect: [:ctx | ctx selector ~~ #doesNotUnderstand: ] ifNone: [nil].
correctDNUWith: guess self performDebugRequest: #privateCorrectDNUWith: withArguments: (Array with:guess)
correctTextWith: guess | text msgRange nuSelectorStream offset positions tStream start partStart | text := self text. msgRange := self pcRange value. nuSelectorStream := ReadStream on: guess keywords. offset := msgRange first. positions := Parser new keywordPositionsIn: (text copyFrom: offset to: msgRange last). offset := offset - 1. "because positions are based on 1 we must adjust offset" tStream := TextStream on: (String new: text size). start := 1. positions isNil ifTrue: [positions := Array with: 1 -> msgRange size]. positions do: [:ac | partStart := ac key + offset. tStream nextPutAllText: (text copyFrom: start to: partStart - 1). tStream nextPutAllText: nuSelectorStream next asText. start := partStart + ac value]. " a probe in the selector will get lost." tStream nextPutAllText: (text copyFrom: start to: text size). ^tStream contents.
defineMethod self performDebugRequest: #basicDefineMethod.
defineMethodForDoesNotUnderstand | message newContext | message := self context localAt: 1. self context homeReceiverClass compile: message methodStubSource. newContext := MethodContext sender: self context receiver: self context receiver method: (self context homeReceiverClass compiledMethodAt: message selector) arguments: message arguments. newContext stepUntilVisibleEffect. processHandle topContext: newContext. self selectContext: newContext. self updateContextList
defineMethodForSubclassResponsibility | message contextSendingSubclassResponsibility arguments newContext | contextSendingSubclassResponsibility := self context sender. arguments := (1 to: contextSendingSubclassResponsibility method numArgs) collect: [:i| contextSendingSubclassResponsibility localAt: i]. message := Message selector: contextSendingSubclassResponsibility method selector arguments: arguments. contextSendingSubclassResponsibility homeReceiverClass compile: message methodStubSource classified: contextSendingSubclassResponsibility method definition protocol. newContext := MethodContext sender: contextSendingSubclassResponsibility sender receiver: contextSendingSubclassResponsibility receiver method: (contextSendingSubclassResponsibility homeReceiverClass compiledMethodAt: message selector) arguments: arguments. newContext stepUntilVisibleEffect. processHandle topContext: newContext. self selectContext: newContext. self updateContextList
defineMethodStubAndAdvance "Define a method body for the message which is not understood in the class of the receiver, containing a single self halt statement. Then proceed to the halt." "nil zork" "nil zork: 1" "nil zork: 1 zork: $1" "nil zork: 1 zork: 1 zork: 1" | client | self class clientClass openFullViewOn: self label: (#errHalt << #dialogs >> 'Halt encountered.') clientInto: [:theClient| client := theClient]. client defineMethod
dnuSelector ^(processHandle topContext localAt: 1) selector
getSentSelectorFor: aContext "We get the selector this way instead of getting from the message held by the dnu context because we want the actual message sent. In the case of a #perform: we want the #perform:, not its argument." | presendPC pc sel | presendPC := self presendPCFor: aContext. pc := aContext pc. aContext jump: presendPC - pc. sel := aContext peekForSelector. aContext jump: pc - presendPC. ^sel
possibleDNUCorrections | oldSelector oldFirst oldArgs selectors | oldSelector := self dnuSelector. oldFirst := oldSelector first. oldArgs := oldSelector numArgs. selectors := (self _objectClass: processHandle topContext receiver) allSelectors select: [:sel | sel first = oldFirst and: [sel numArgs = oldArgs and: [(sel spellAgainst: oldSelector) > 10]]]. ^selectors
prepareDNUForResend | theContext | theContext := self contextFirstSendingDNU. theContext restackMessage: (processHandle topContext localAt: 1) to: processHandle topContext receiver. theContext jump: (self presendPCFor: theContext) - theContext pc. self forceResetContext: theContext. processHandle interrupted: true. ^theContext.
presendPCFor: aContext "Find the pc before the message send." | pc i size map | map := currentContext == aContext ifTrue: [sourceMap] ifFalse: [aContext sourceMap]. pc:= aContext pc. "When selecting a context in middle of the stack, the pc points to the byte code after the send." i := 1. size := map size. [i <= size and: [(map at: i) key < pc]] whileTrue: [i := i + 1]. i > 1 ifTrue: [pc := (map at: i - 1) key]. pc := pc - 1. i := map indexForInserting: (Association key: pc value: nil). i < 1 ifTrue: [^0]. i > map size ifTrue: [^0]. ^(map at: i) key
privateCorrectDNUWith: guess | newText methodAndSelector oldMethod blockIndex method | self selectContext: self contextFirstSendingDNU. newText := self correctTextWith: guess. methodAndSelector := self compileText: newText from: nil. methodAndSelector isNil ifTrue: [^false]. method := currentContext method. oldMethod := method homeMethod. self prepareDNUForResend. blockIndex := method blockMethodIndex. (DebugProbeInserter for: self) adjustDynamicsReplacing: oldMethod with: methodAndSelector key from: blockIndex atPC: currentContext pc addProbe: false originalPCMap: (oldMethod sourceMapAt: blockIndex).
</methods> <methods> CraftedSmalltalk.DebuggerService <category>stack manipulation</category>
checkContextSelection "Determine whether the currently selected context has been set, and if not, set it." currentContext == nil ifTrue: [currentContext := processHandle topContext]
emergencyRestart: exp "Respond to an Context>>emergencySignal arising during simulation." | aContext anException sender cMClass | anException := exp. exp creator == ContextEmergencyError ifTrue: [anException := exp parameter]. (ControlInterrupt handles: anException) ifTrue: [(aContext := anException parameter) isNil ifTrue: [aContext := anException initialContext]. label := anException errorString] ifFalse: [aContext := anException initialContext. label := #UnhandledExceptionC1s << #pdp >> 'Unhandled exception: <1s>' expandMacrosWith: anException errorString]. (StepIntoBlockNotification handles: anException) ifTrue: [sender := aContext sender. cMClass := sender mclass. [sender mclass == cMClass] whileTrue: [sender := sender sender]. aContext sender: sender]. "undo all grabs for event driven" InputState default ungrabBecauseOfError. self scheduleLabelUpdate. processHandle topContext: aContext. processHandle interrupted: (UserInterrupt , StepIntoBlockNotification handles: anException). self context: aContext. self scheduleContextListUpdate. (StepIntoBlockNotification handles: anException) ifFalse: [anException initialContext == aContext ifFalse: [anException initialContext unwindUpTo: aContext]]. currentContext pc = self stopPC ifTrue: [^self]. self step
</methods> <methods> CraftedSmalltalk.DebuggerService <category>actions</category>
browseClass "Ideally, this should be inlined, left for now to support the Diggy plugin." self browseSelectedContext
browseSelectedContext "Open a browser on the current receiver object. Select the method. If we find that the method is further up the heirarhcy, but not in object, select that class (doing so after the fact leaves the hierarchy receiver centered) and the method there." | state receiverClass browser implementingClass | state := Refactory.Browser.NavigatorState new. receiverClass := currentContext _objectClass: currentContext homeReceiver. state classOrNameSpace: receiverClass. state selector: self selectedMethod selector. browser := Refactory.Browser.RefactoringBrowser openHierarchyWithSelection: state. implementingClass := self selectedMethod mclass. (implementingClass ~= receiverClass and: [implementingClass ~= Object or: [(Store.Registry containingPackageForSelector: self selectedMethod selector class: Object) ~= (Store.Registry containingPackageForClass: Object)]]) ifTrue: [(browser navigator) selectClass: implementingClass; setSelector: self selectedMethod selector]
correctSpelling "Attempt to correct the spelling of the not-understood message and resend." | oldSelector oldFirst oldArgs selectors guess msg | processHandle topContext selector == #doesNotUnderstand: ifFalse: [^self]. msg := processHandle topContext localAt: 1. oldSelector := msg selector. oldFirst := oldSelector first. oldArgs := oldSelector numArgs. selectors := (self _objectClass: processHandle topContext receiver) allSelectors select: [:sel | sel first = oldFirst and: [sel numArgs = oldArgs and: [(sel spellAgainst: oldSelector) > 10]]]. selectors isEmpty ifTrue: [^Dialog warn: (#CouldntCorrect << #pdp >> 'Couldn''t correct')]. selectors := selectors asArray. guess := Dialog choose: (#CorrectToDots << #pdp >> 'Correct to...') fromList: selectors values: selectors lines: 8 cancel: [^''] for: nil. (Dialog confirm: ((#RetryWithSelectorCnt1s << #pdp >> 'Retry with Selector:<nt><1s>') expandMacrosWith: guess) for: nil) ifFalse: [^self]. msg setSelector: guess arguments: msg arguments. ^self basicProceed
inspectCurrentContext currentContext inspect
revert | mclass oldMethod newMethod | mclass := self selectedClass. selector isNil | mclass isNil ifTrue: [^false]. Store.DbRegistry doIfOnlineImage: [oldMethod := self selectedMethod. (Store.XChangeSet current revertSelector: selector class: mclass) ifFalse: [^false]. newMethod := mclass compiledMethodAt: selector. PDPManager changedMethodFrom: oldMethod to: newMethod by: self. self methodChanged: newMethod selector: selector]. ^true
stackForCopy | cp | cp := ContextDumpPolicy new. cp stack: contextStackPolicy contextList. cp errorMessage: label. ^cp copyStackString
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private-inspectors</category>
openInspectors "Further initialization when opening notify view to debug view" receiverInspector := PrimitiveObjectInspector inspect: nil. contextInspector := ContextInspector inspect: nil. stackInspector := StackInspector inspect: nil.
resetInspectorFields receiverInspector resetFieldsForDebugger. contextInspector resetFields. stackInspector resetFields.
updateInspectors receiverInspector update. contextInspector update. stackInspector updateAsTop: currentContext == processHandle topContext.
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private-pc selection</category>
privatePcRange "Answer the indices in the source code for the method corresponding to the selected context's program counter value." | pc i size end | self context == nil ifTrue: [^1 to: 0]. (sourceMap == nil or: [sourceMap size = 0]) ifTrue: [^1 to: 0]. pc:= self context pc. (self context == processHandle topContext and: [processHandle interrupted]) ifFalse: "When selecting a context in middle of the stack or the context 'halt', the pc points to the byte code after the send." [i := 1. size := sourceMap size. [i <= size and: [(sourceMap at: i) key < pc]] whileTrue: [i := i + 1]. i > 1 ifTrue: [pc := (sourceMap at: i - 1) key]]. pc := pc - 1. i := sourceMap indexForInserting: (Association key: pc value: nil). i < 1 ifTrue: [^1 to: 0]. i > sourceMap size ifTrue: [end := sourceMap inject: 0 into: [:prev :this | prev max: this value last]. ^ end+1 to: end]. ^(sourceMap at: i) value
resetPCSelection sourceMap := currentContext visibleSourceMap. self schedulePCUpdate.
stopPC "Returns the next pc in the map." | i | i := sourceMap indexForInserting: (currentContext pc - 1) -> nil. ^(i > sourceMap size ifTrue: [currentContext method bytesSize] ifFalse: [(sourceMap at: i) key])
</methods> <methods> CraftedSmalltalk.DebuggerService <category>initialize-release</category>
basicPrepareTopContext self context: processHandle topContext. pendingEvents add: #debuggerSelectedTopContext.
initialize pendingEvents := Set new. continueInDebuggerCtx := WeakArray new: 1. tags := PDPWeakCollection new. stepProbes := OrderedCollection new. debugOperationIsActive := doSend := doSendLoop := doStepIntoBlock := dontUpdateInspectors := false. contextStackPolicy := ContextListPolicy debugger: self. self openInspectors. PDPManager notifyOnMethodChanged: self.
onHandle: aProcessHandle processHandle := aProcessHandle. processHandle process debugger: self. oldCursor := Cursor currentCursor. contextStackPolicy computeContextList.
prepareForErrorCondition processHandle prepareForErrorCondition
prepareTopContext self performDebugRequest: #basicPrepareTopContext.
process: aProcess context: aContext interrupted: aBoolean self onHandle: (ProcessHandle on: aProcess at: aContext interrupted: aBoolean)
process: aProcess context: aContext interrupted: aBoolean proceedable: proceedBoolean self onHandle: (ProcessHandle on: aProcess at: aContext interrupted: aBoolean)
removeAllDependents dependents := nil.
removeDependent: aDependent super removeDependent: aDependent. self dependents isEmpty ifTrue: [processHandle terminate]
</methods> <methods> CraftedSmalltalk.DebuggerService <category>private-return</category>
basicCompleteReturn: rtnMsg with: rtnValue | theContext currContext | theContext := currentContext. self cutbackTo: theContext finishWith: [self performDebugOperation: [processHandle interrupted: true. currContext := theContext pdpCompleteCallee: (theContext perform: rtnMsg with: rtnValue). self forceResetContext: currContext. self finishStep. nil]].
completeReturn: rtnMsg with: rtnValue self performDebugRequest: #basicCompleteReturn:with: withArguments: (Array with: rtnMsg with: rtnValue)
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>instance creation</category>
breakOn: anException "NOTICE: This method assumes that the process is cut back and will require a return object to be pushed on the stack." self openOn: anException parameter exception: anException interrupted: false. "Smalltalk Professional Debug Package Version 3.0 (c) 2001 Crafted Smalltalk"
context: aContext proceedable: aBoolean interrupted: interrupted | aDebugger | aDebugger := self new. aDebugger process: Processor activeProcess context: aContext interrupted: interrupted. ^aDebugger
interruptOn: anException "NOTICE: This method assumes that the process is NOT cut back and will NOT require a return object to be pushed on the stack." self openOn: anException parameter exception: anException interrupted: true "Smalltalk Professional Debug Package Version 3.0 (c) 2001 Crafted Smalltalk"
new ^super new initialize "Smalltalk Professional Debug Package Version 3.0 (c) 2001 Crafted Smalltalk"
openOnProcess: aProcess interrupted: aBoolean label: aString ^self openOnHandle: (ProcessHandle on: aProcess interrupted: aBoolean) label: aString "Smalltalk Professional Debug Package Version 3.0 (c) 2001 Crafted Smalltalk"
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>private</category>
enableWindowsIfNotEventFaithfulFor: aProcess EventFaithfulDebugging ifTrue: [^self]. aProcess windowManager ifNotNil: [:value | value launchBaseProcess].
resyncEvents EventQueue allInstancesDo: [:each | each restoreReadSynchSignals].
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>class initialization</category>
initialize TempMethods := PDPWeakDictionary weakKeys. EventFaithfulDebugging := false. DefaultToPermanentProbe := true.
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>instance creation - compatibility</category>
dumpStackForContext: haltContext label: aString proceedable: aBoolean interrupted: interrupted | dbr | thisContext unwindUpTo: haltContext. dbr := self context: haltContext proceedable: aBoolean interrupted: interrupted. dbr label: aString. ^dbr stackForCopy.
getDisplayPoint | windowManager | windowManager:= Processor activeProcess environmentAt: #WindowManager. ^[(windowManager isNil or: [windowManager activeController isNil]) ifTrue: [Screen default bounds center] ifFalse: [windowManager activeController view displayBox center]] on: Error do: [:exception | exception return: Screen default bounds center]
openContext: haltContext label: aString proceedable: aBoolean "Create and schedule an instance of me viewing a Debugger on haltContext. The view will be labeled with aString, and will show a short sender stack." self openContext: haltContext label: aString proceedable: aBoolean interrupted: false
openContext: haltContext label: aString proceedable: aBoolean interrupted: interrupted "Create and schedule an instance of me viewing a Debugger on haltContext. The view will be labeled with aString, and will show a short sender stack." | displayPoint contentsString dbr | self prepareForDebugging. contentsString := self shortStackFor: haltContext ofSize: 5. displayPoint := self getDisplayPoint. thisContext unwindUpTo: haltContext. dbr := self context: haltContext proceedable: aBoolean interrupted: interrupted. Processor activeProcess suspendResumable: false do: [:proc | self openDebugger: dbr contents: contentsString label: aString proceed: aBoolean displayAt: displayPoint. self enableWindowsIfNotEventFaithfulFor: proc].
openDebugger: aDebugger contents: aString1 label: aString2 proceed: mayProceed displayAt: aPoint | box text y builder label actions specs width height copyStack correctIt baseFraction defineIt | self prepareForDebugging. Processor activeProcess priority: Processor userSchedulingPriority. self logErrorFor: aDebugger label: aString2. aDebugger prepareForErrorCondition. builder := UIBuilder new. builder windowOn: aDebugger label: (#Exception << #pdp >> 'Exception'). aDebugger label: aString2. text := (self limitString: aString2 lengthTo: 200 andLinesTo: 5) asText. text emphasizeFrom: 1 to: text size with: (Screen default colorDepth < 4 ifTrue: [#bold] ifFalse: [Array with: #bold with: #color->(ColorValue red: 0.8 green: 0 blue: 0)]). text := ComposedText withText: text style: nil compositionWidth: 250. y := text bounds height // 2 max: 16. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: builder policy alertIcon. label layout: (AlignmentOrigin new leftOffset: 48; topOffset: y+16; leftAlignmentFraction: 1; topAlignmentFraction: 0.5). builder add: label. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: text. label layout: (AlignmentOrigin new leftOffset: 56; topOffset: y+16; leftAlignmentFraction: 0; topAlignmentFraction: 0.5). y := y * 2 + 32. builder add: label. actions := OrderedCollection with: (#Debug << #pdp >> 'Debug') -> [self clientClass openFullViewOn: aDebugger label: aString2. builder window model: nil. builder window controller close] with: (#Proceed << #pdp >> 'Proceed') -> [aDebugger basicProceed. builder window controller close. self resyncEvents] with: (#Terminate << #pdp >> 'Terminate') -> [aDebugger terminate. builder window controller close. self resyncEvents]. specs := OrderedCollection new. 1 to: actions size do: [:i | | action | action := actions at: i. specs add: (ActionButtonSpec model: action value label: action key layout: (LayoutFrame new leftFraction: i-1/actions size; rightFraction: i / actions size; topOffset: y; bottomOffset: y)). specs last defaultable: true. action key = (#Debug << #pdp >> 'Debug') ifTrue: [specs last isDefault: true. builder add: specs last. builder keyboardProcessor setActive: builder wrapper widget controller] ifFalse: [builder add: specs last]. (action key = (#Proceed << #pdp >> 'Proceed') and: [mayProceed not]) ifTrue: [builder wrapper disable]]. y := y + builder wrapper preferredBounds height. specs do: [:spec | spec layout bottomOffset: y]. baseFraction := actions size - 1 / 2 / actions size. copyStack := (ActionButtonSpec model: [ParagraphEditor currentSelection: aDebugger stackForCopy asText] label: (#CopyStack << #pdp >> 'Copy Stack') layout: (LayoutFrame new leftFraction: baseFraction; rightFraction: baseFraction + (1/actions size); topOffset: y; bottomOffset: y + builder wrapper preferredBounds height)). copyStack defaultable: true. builder add: copyStack. (aDebugger interruptedContext ~~ nil and: [aDebugger canDefineMethod]) ifTrue: [aDebugger interruptedContext selector == #doesNotUnderstand: ifTrue: [correctIt := (ActionButtonSpec model: [aDebugger correctSpelling. builder window controller close. self resyncEvents] label: (#CorrectItDots << #pdp >> 'Correct it...') layout: (LayoutFrame new leftFraction: baseFraction + (1/actions size); rightFraction: baseFraction + (2/actions size); topOffset: y; bottomOffset: y + builder wrapper preferredBounds height)). correctIt defaultable: true. builder add: correctIt]. defineIt := (ActionButtonSpec model: [aDebugger defineMethodStubAndAdvance. builder window model: nil. builder window controller close. self resyncEvents] label: (#DefineItDot << #dialogs >> 'Define it...') layout: (LayoutFrame new leftFraction: baseFraction - (1/actions size); rightFraction: baseFraction; topOffset: y; bottomOffset: y + builder wrapper preferredBounds height)). defineIt defaultable: true. builder add: defineIt]. y := y + builder wrapper preferredBounds height. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: aString1 asComposedText. label layout: (AlignmentOrigin new leftFraction: 0.5 offset: 0; topFraction: 0.5 offset: y // 2; leftAlignmentFraction: 0.5; topAlignmentFraction: 0.5). builder add: label. width := 320 max: label getLabel bounds width+12. height := y + label getLabel bounds height + 6. box := 0@0 corner: width@height. box := box align: box center with: aPoint. builder openIn: box.
openException: exception exception ifUnhandledOpenDebugger ifTrue: [self openOnException: exception] ifFalse: [self openContext: exception parameter label: exception errorString proceedable: exception willProceed interrupted: exception isInterrupt]
openNoModificationErrorNotifierForContext: haltContext error: noModificationError label: aString proceedable: aBoolean "Create and schedule an instance of me viewing a Debugger on haltContext. The view will be labeled with aString, and will show a short sender stack. Include information that informs the user as to the NoModificationError default werror treatments available and allows one to change them." | displayPoint contentsString dbr | self prepareForDebugging. contentsString := self shortStackFor: haltContext ofSize: 5. displayPoint := self getDisplayPoint. thisContext unwindUpTo: haltContext. dbr := self context: haltContext proceedable: aBoolean interrupted: false. Processor activeProcess suspendResumable: false do: [:proc | self openNoModificationNotifier: dbr error: noModificationError contents: contentsString label: aString displayAt: displayPoint. self enableWindowsIfNotEventFaithfulFor: proc]
openNoModificationNotifier: aDebugger error: theNoModificationError contents: aString1 label: aString2 displayAt: aPoint | box text helpText y builder label actions specs width height copyStack baseFraction radio errorModeRadioModel left radioButtonTop groupBox | self prepareForDebugging. Processor activeProcess priority: Processor userSchedulingPriority. self logErrorFor: aDebugger label: aString2. errorModeRadioModel := NoModificationError errorMode asValue. aDebugger prepareForErrorCondition. builder := UIBuilder new. builder windowOn: aDebugger label: (#Exception << #pdp >> 'Exception'). aDebugger label: aString2. text := (self limitString: aString2 lengthTo: 200 andLinesTo: 5) asText. text emphasizeFrom: 1 to: text size with: (Screen default colorDepth < 4 ifTrue: [#bold] ifFalse: [Array with: #bold with: #color->(ColorValue red: 0.8 green: 0 blue: 0)]). text := ComposedText withText: text style: nil compositionWidth: 250. y := 10. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: builder policy alertIcon. label layout: (AlignmentOrigin new leftOffset: 48; topOffset: y + (text bounds height - builder policy alertIcon bounds height // 2 max: 0); leftAlignmentFraction: 1). builder add: label. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: text. label layout: (AlignmentOrigin new leftOffset: 56; topOffset: y; leftAlignmentFraction: 0). y := y + text bounds height + 8. builder add: label. helpText := ComposedText withText: (#ItIsAnErrorToModifyImmutables << #pdp >> 'It is an error in VW7 to modify immutable objects such as literals. For backward compatibility, you can disable these errors by selecting a different immutability policy below and proceeding. This policy can also be changed using Settings>Immutability.') asText style: nil. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: helpText. label layout: (AlignmentOrigin new leftOffset: 20; topOffset: y; leftAlignmentFraction: 0). y := y + helpText bounds height + 8. builder add: label. radioButtonTop := y. y := y + 24. left := 40. text := ComposedText withText: (#SignalAnError << #pdp >> 'Signal an error') asText style: nil. radio := RadioButtonSpec model: errorModeRadioModel label: text select: #error. radio layout: (AlignmentOrigin new leftOffset: left; topOffset: y). builder add: radio. y := y + text bounds height. text := ComposedText withText: (#PrintAWarningMakeMutable << #pdp >> 'Print a warning and make the object mutable') asText style: nil. radio := RadioButtonSpec model: errorModeRadioModel label: text select: #warn . radio layout: (AlignmentOrigin new leftOffset: left; topOffset: y). builder add: radio. y := y + text bounds height. text := ComposedText withText: (#SilentlyMakeTheObjectMutable << #pdp >> 'Silently make the object mutable') asText style: nil. radio := RadioButtonSpec model: errorModeRadioModel label: text select: #ignore . radio layout: (AlignmentOrigin new leftOffset: left; topOffset: y). builder add: radio. y := y + builder wrapper preferredBounds height + 16. text := ComposedText withText: (#OnAttemptToModifyImmutable << #pdp >> 'On an attempt to modify an immutable object') asText style: nil. groupBox := GroupBoxSpec label: text. groupBox layout: (LayoutFrame leftFraction: 0 offset: 20 rightFraction: 1 offset: -20 topFraction: 0 offset: radioButtonTop bottomFraction: 0 offset: y). builder add: groupBox. y := y + 16. actions := Array with: (#Debug << #pdp >> 'Debug') -> [NoModificationError errorMode: errorModeRadioModel value. self clientClass openFullViewOn: aDebugger label: aString2. builder window model: nil. builder window controller close] with: (#Proceed << #pdp >> 'Proceed') -> ["Sigh; exceptions don't really proceed correctly, instead we resume execution in the context that raised the error. Better would be to proceed from the noHandler method. Because this doesn't happen we have to retry here explicitly." #error ~~ errorModeRadioModel value ifTrue: [NoModificationError errorMode: errorModeRadioModel value. aDebugger doItValue: theNoModificationError makeObjectsMutableAndRetry]. aDebugger basicProceed. builder window controller close] with: (#Terminate << #pdp >> 'Terminate') -> [NoModificationError errorMode: errorModeRadioModel value. aDebugger terminate. builder window controller close]. specs := OrderedCollection new. 1 to: actions size do: [:index | | action | action := actions at: index. specs add: (ActionButtonSpec model: action value label: action key layout: (LayoutFrame new leftFraction: index - 1 / actions size; leftOffset: (index = 1 ifTrue: [20] ifFalse: [0]); rightFraction: index / actions size; rightOffset: (index = actions size ifTrue: [-20] ifFalse: [0]); topOffset: y; bottomOffset: y)). specs last defaultable: true. action key = (#Debug << #pdp >> 'Debug') ifTrue: [specs last isDefault: true. builder add: specs last. builder keyboardProcessor setActive: builder wrapper widget controller] ifFalse: [builder add: specs last]. (action key = (#Proceed << #pdp >> 'Proceed') and: [aDebugger mayProceed not]) ifTrue: [builder wrapper disable]]. y := y + builder wrapper preferredBounds height. specs do: [:spec | spec layout bottomOffset: y]. baseFraction := actions size - 1 / 2 / actions size. copyStack := (ActionButtonSpec model: [ParagraphEditor currentSelection: aDebugger stackForCopy asText] label: (#CopyStack << #pdp >> 'Copy Stack') layout: (LayoutFrame new leftFraction: baseFraction; rightFraction: baseFraction + (1 / actions size); topOffset: y; bottomOffset: y + builder wrapper preferredBounds height)). copyStack defaultable: true. builder add: copyStack. y := y + builder wrapper preferredBounds height + 8. label := LabelSpec new hasCharacterOrientedLabel: false. label setLabel: aString1 asComposedText. label layout: (AlignmentOrigin new leftFraction: 0.5 offset: 0; topOffset: y; leftAlignmentFraction: 0.5). builder add: label. y := y + builder wrapper preferredBounds height . width := (420 max: label getLabel bounds width + 12) max: helpText bounds width + 20. height := y + 10. box := 0 @ 0 corner: width @ height. box := box align: box center with: aPoint. builder openIn: box.
prepareForDebugging "undo all grabs for event driven and Make sure that controllers without views are removed" | manager | InputState default ungrabBecauseOfError. manager := self activeWindowManager. manager ifNotNil: [manager purgeInvalidWindows].
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>private - instance creation</category>
debugException: anException self openOnException: anException
onHandle: aProcessHandle ^self new onHandle: aProcessHandle "Smalltalk Professional Debug Package Version 1.6 (c) 1998 Crafted Smalltalk"
openOn: aContext exception: anException interrupted: aBoolean | service | self prepareForDebugging. thisContext unwindUpTo: aContext. service := self context: aContext proceedable: true interrupted: aBoolean. service prepareForErrorCondition. service label: anException description. Processor activeProcess suspendResumable: false do: [:proc | self clientClass openFullViewOn: service label: anException description. self enableWindowsIfNotEventFaithfulFor: proc]
openOnException: anException self openOn: anException topOfContextStack exception: anException interrupted: anException isInterrupt
openOnHandle: aProcessHandle label: aString | service | self prepareForDebugging. service := self onHandle: aProcessHandle. service label: aString. service prepareForErrorCondition. ^self clientClass openFullViewOn: service label: aString
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>utility</category>
activeWindowManager ^Processor activeProcess environment at: #WindowManager ifAbsent: [nil]
getActiveUserProcess "Returns the highest priority user process waiting to run." Processor runableProcesses do: [:p | p isSystemProcess not ifTrue: [^p]]. ^nil
getCurrentWindowProcess Window currentWindow isNil ifTrue: [^nil]. ^Window currentWindow windowProcess
interruptAllUserProcesses | interruptor | interruptor := [Processor pauseUserProcesses. [InputState default ungrabBecauseOfError. WindowManager beEffectivelyModeless. ProcessMonitorService open] forkAt: Processor userSchedulingPriority.] newProcess. interruptor setIsSystemProcess. interruptor resume
interruptAllUserProcessesSuchThat: aBlock with: aStringUserMessage | interruptor | interruptor := [Processor pauseUserProcessesSuchThat: aBlock. [| procMonitor | InputState default ungrabBecauseOfError. WindowManager beEffectivelyModeless. [procMonitor := ProcessMonitorService open window. procMonitor label: procMonitor label asString , ' ' , aStringUserMessage asString] on: MessageNotUnderstood do: [:ex | EventQueue allInstancesDo: [:each | each restoreReadSynchSignals]. Processor proceedUserProcesses. Processor interruptAllUserProcessesSuchThat: aBlock with: aStringUserMessage. ex return]] forkAt: Processor userSchedulingPriority] newProcess. interruptor setIsSystemProcess. interruptor resume "DebuggerService interruptAllUserProcessesSuchThat:[:p| true] with: 'yo!'"
limitString: string lengthTo: maxLen andLinesTo: maxLines | outStr inStr done lineCnt charCnt char str | str := string asString. outStr := WriteStream on: (String new: str size). inStr := ReadStream on: str. done := false. lineCnt := charCnt := 0. [done or: [inStr atEnd]] whileFalse: [char := inStr next. char = Character cr ifTrue: [lineCnt := lineCnt + 1. done := lineCnt = maxLines]. done ifFalse: [outStr nextPut: char. charCnt := charCnt + 1. done := charCnt = maxLen]]. done ifTrue: [outStr nextPutAll: '...']. ^outStr contents
logErrorFor: aDebugger label: label "Log the error to a file in case the notifier can't come up." "If you want to enable logging of notifiers, change the first 'false' to 'true', which will cause logging to be enabled. Then edit the file name (the default is 'visual.err') to whatever file you want to write the logs to. Make sure that the file is writable, and that there is enough disk space. If there is any error writing the log file, the error will be silently ignored--otherwise the system would go into infinite recursion and run out of memory." | end printSymbol | false ifFalse: [^self]. end := 10. "Number of stack items to be dumped. Set to nil to dump full stack." " printSymbol := #printSimple." printSymbol := #printVerbose. [| file cp | file := 'visual.err' asFilename appendStream. [file cr; cr. cp := ContextDumpPolicy new initialize. cp stream: file. cp errorMessage: label. cp stack: aDebugger contextList . cp numberToDump: end. cp perform: printSymbol. file cr] ensure: [file close] ] on: Object errorSignal do: [:ex | ex inspect. ex return].
shortStackFor: aContext ofSize: anInteger "Answer a string with the simple descriptions of anInteger number of non-nil stackframes starting with aContext" | shortStackStream ctx | shortStackStream := WriteStream on: (String new: 400). ctx := aContext. anInteger timesRepeat: [ctx isNil ifFalse: [shortStackStream nextPutAll: (ctx printString contractTo: 50); cr. ctx := ctx sender]]. shortStackStream position > 0 ifTrue: [shortStackStream skip: -1]. ^shortStackStream contents
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>utilitiy</category>
interruptActiveUserProcess | proc | proc := self getActiveUserProcess. proc isNil ifTrue: [proc := self getCurrentWindowProcess]. proc isNil ifTrue: [^self interruptAllUserProcesses]. proc isUnderDebug ifTrue: [^proc debugger abortDebugOperationInProcess: proc]. proc interruptWith: [Object userInterruptSignal interruptWith: thisContext sender sender errorString: (#UserInterrupt << #pdp >> 'User Interrupt')]
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>defaults</category>
clientClass "Instances of this class are the application models created when the service receives a request to open a debugger. DebuggerClient is the default debugger application. Subclasses may redefine this to substitute their applications." ^DebuggerClient
</methods> <methods> Core.RunArray <category>accessing</category>
remove: aValue | index val end | cacheRun := cacheRunStart := 1. "Clear cache" index := 1. end := values size. [index > end or: [(val := values at: index) = aValue]] whileFalse: [val class == Array ifTrue: [(val indexOf: aValue) = 0 ifFalse: [val size = 1 ifTrue: [values at: index put: aValue. index := index -1] ifFalse: [^values at: index put: (val copyWithout: aValue)]]]. index := index + 1]. (values at: index) == aValue ifFalse: [^self]. values at: index put: nil.
</methods> <methods> Kernel.CompiledBlock <category>accessing</category>
blockMethodIndex "Returns the block method index of the receiver." | index | index := 1. self homeMethod withAllBlockMethodsDo: [:meth | meth = self ifTrue: [^index]. index := index + 1]
</methods> <methods> Kernel.CompiledBlock <category>testing</category>
isFullBlock "Returns true if the receiver is used in a full closure." ^outerMethod createsFullBlockFor: self
isFullBlockChain "Returns true if all the blocks from the receiver to the compiled method are used in full block closures." ^self isFullBlock and: [outerMethod isFullBlockChain]
</methods> <methods> Kernel.CompiledBlock <category>accessing</category>
nesting ^outerMethod nesting + 1
</methods> <methods> Kernel.CompiledMainBlock <category>accessing</category>
nesting ^0
originalMethod ^self
</methods> <methods> Kernel.Process <category>debugging</category>
debug self isUnderDebug ifFalse: [self privateDebug]
debugDebugger self debug
</methods> <methods> Kernel.Process <category>printing</category>
dumpStackToFileNamed: aString | strm | strm := aString asFilename writeStream. [self printStackOn: strm] ensure: [strm close]
</methods> <methods> Kernel.Process <category>debugging</category>
hasActiveDebugOperation ^self isUnderDebug and: [debugger hasActiveDebugOperation]
</methods> <methods> Kernel.Process <category>printing</category>
printStackOn: aStream suspendedContext isNil ifTrue: [suspendedContext printOn: aStream] ifFalse: [suspendedContext printSenderStackOn: aStream max: 200].
</methods> <methods> Kernel.Process <category>debugging</category>
privateDebug Processor activeProcess == self ifTrue: [self suspendResumable: false do: [:proc | proc privateDebug]. ^self "We should never reach this."]. suspendedContext isNil ifTrue: [^self]. "nothing to debug" Processor removePausedProcess: self. [myList isNil ifTrue: [self resume]. self uninterruptablyDo: [self suspend]] valueUnpreemptively. [DebuggerService openOnHandle: (ProcessHandle on: self at: suspendedContext interrupted: true) label: (#DebugProcess << #pdp >> 'Debug process').] forkAt: Processor userSchedulingPriority
</methods> <methods> Kernel.Process <category>changing process state</category>
proceed ^Processor resumePausedProcess: self
</methods> <methods> Tools.VisualLauncher <category>menus - pdp</category>
toggleDebuggingLabel ^PDPManager getEnableProbeDebuggingLabel
</methods> <methods> Kernel.Parser <category>private</category>
keywordPositions "This method expects the first token to be the first part of a keyword message. It also expects the last part to be followed by a variable or expression." | keywordPositions | tokenType == #keyword ifFalse: [^nil]. keywordPositions := Array with: mark -> token size. [self scanToken. self primaryExpression ifFalse: [^nil]. "this could return keywordPositions, but nil may catch errors" self messagePart: 2 repeat: true. tokenType == #keyword] whileTrue: [keywordPositions := keywordPositions copyWith: mark -> token size]. ^keywordPositions
</methods> <methods> Kernel.Parser <category>public access</category>
keywordPositionsIn: aString | failure | failure := [^self error: (#UnexpectedError << #pdp >> 'Unexpected error')]. self init: aString readStream notifying: (SilentCompilerErrorHandler new failBlock: failure) saveComments: false failBlock: failure. builder := ProgramNodeBuilder new. ^self keywordPositions
parseSelector: aString notifying: aController "Answer with the selector for this method string" | handler | handler := InteractiveCompilerErrorHandler new. ^handler forClass: Object on: (ReadStream on: aString asString) for: aController onFailDo: [^nil] do: [:src | self initPattern: src contents notifying: handler saveComments: false return: [:pattern | pattern at: 1]]
</methods> <methods> Core.Object <category>copying</category>
basicDcopyUsing: copyDict "Basic deep copy operation." ^copyDict at: self ifAbsent: [(copyDict at: self put: self shallowCopy) postDcopyUsing: copyDict; yourself]
basicMethodDcopy "Ignore." ^self
basicMethodDcopyUsing: copyDict "In general don't copy. Subclasses that do need to copy will override." ^self
</methods> <methods> Core.Object <category>error handling</category>
breakOn: aContext label: aString "This is a simple message to use for inserting breakpoints during debugging. The debugger is opened by raising a signal." BreakInterrupt raiseRequestWith: aContext errorString: aString
</methods> <methods> Core.Object <category>copying</category>
dcopy "Answer a deep copy of the receiver. References to shared objects in the graph reachable from the receiver are preserved. This deep copy is used to implement breakpoints in the debugger. It may be suitable for other uses, but be careful changing its semantics as doing so may break the debugger." ^self basicDcopyUsing: IdentityDictionary new
</methods> <methods> Core.Object <category>printing</category>
debugString ^self printString
forStackDumpPrintUsing: aPolicy ^aPolicy printObject: self
inspectString ^self debugString
</methods> <methods> Core.Object <category>testing</category>
isBlockContext ^false
isCharStyleCacheable ^true
</methods> <methods> Core.Object <category>copying</category>
postDcopyUsing: copyDict "Complete the deep copy operation." | class | class := self class. class isVariable ifTrue: [1 to: self basicSize do: [ :i | self basicAt: i put: ((self basicAt: i) basicDcopyUsing: copyDict)]]. 1 to: class instSize do: [ :i | self instVarAt: i put: ((self instVarAt: i) basicDcopyUsing: copyDict)]
</methods> <methods> Kernel.Context <category>private-debugger</category>
clearStack stackp := self initialStackDepthForProbes.
</methods> <methods> Kernel.Context <category>accessing</category>
contextStackDepth | i ctx | i := 1. ctx := self. [ctx := ctx sender. ctx == nil] whileFalse: [i := i + 1]. ^i
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
findParentContextWithHomeMethod: aMethod | ctx | ctx := self. [ctx == nil] whileFalse: [ctx method homeMethod originalMethod == aMethod ifTrue: [^ctx]. ctx := ctx sender]. ^nil
getTempVar: aVar "Answer the argument or temporary value of the variable." self nestingAt: self nesting - aVar nesting do: [:ctx | ^ctx slotAt: aVar debuggerIndex]. self error: (#IndexIsOutOfRange << #pdp >> 'Index is out of range')
growBy: aNumber | newStk | newStk := Array new: aNumber abs + self localSize. 1 to: self localSize do: [:i | newStk at: i put: (self localAt: i)]. self instVarAt: 6 put: newStk.
</methods> <methods> Kernel.Context <category>testing</category>
hasExited ^sender isNil and: [self atEnd]
hasInterimValues ^stackp > method numLocals
</methods> <methods> Kernel.Context <category>accessing</category>
homeReceiverClass ^(self _objectClass: self homeReceiver)
</methods> <methods> Kernel.Context <category>private-debugger</category>
initialStackDepthForProbes ^method numTemps.
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
intendedReceiver "Answer the receiver to which the home method was sent." ^self subclassResponsibility
</methods> <methods> Kernel.Context <category>private-simulation</category>
isSendLoop ^Processor activeProcess isDebugSendLoop
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
messageObjects | count objects | objects := OrderedCollection new. self pdpWillSend ifFalse: [^objects]. count := self peekForSelector numArgs. self sendsAdd1 ifTrue: [count := count - 1]. self hasReceiverOnStackForSend ifFalse: [objects add: receiver. count := count - 1]. "no receiver on stack" 0 to: count do: [:i | objects add: (self localAt: stackp - i)]. ^objects
nesting ^method nesting
</methods> <methods> Kernel.Context <category>simulation-debugger</category>
pdpCompleteCallee: aContext "Simulate the execution of bytecodes until a return to the receiver, or until a return to a non-context in case of block up arrow return." | ctxt current | self == aContext ifTrue: [^self]. ctxt := aContext. current := nil. [[ctxt == current or: [(ctxt isKindOf: Context) and: [ctxt hasSender: self]]] whileTrue: [current := ctxt. ctxt := ctxt step]] on: GetBaseContextForException do: [:ex | ex proceedWith: self]. "check for handler context" (ctxt isMemberOf: Array) ifTrue: [ctxt := ctxt at: 1]. ^ctxt
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
pdpSlotAccessors "Answer an OrderedCollection of the name strings of the temporary variables for this context and all its enclosing scopes. Note that this does not include compiler-generated temporary variables." | slots | slots := OrderedCollection new. self localScope temps do: [:var | | name | (var key first = $.) ifFalse: [name := var key. var value class == LocalVariable ifTrue: [name := '.' , name]. slots add: (Array with: name with: var value)]]. ^slots
</methods> <methods> Kernel.Context <category>simulation-debugger</category>
pdpStepUntilPC: stopPC "Simulate the execution of bytecodes until pc is equal to stopPC" [| ctx | ctx := self. [ctx == self and: [self pc < stopPC and: [self willReturn not and: [(self isJump: pc) not]]]] whileTrue: [ctx := self pdpCompleteCallee: self step]. ^ctx] on: Error do: [:ex | CodeSimulationError signalWith: self]
pdpStepUntilVisibleEffect "Simulate the execution of bytecodes until either sending a message or assigning a expression or returning a value to the receiver or calling a primitive (that is, until reaching a point that has meaning at the source level)." ^[[self pdpWillSend or: [self willAssign or: [self willReturn or: [self willDoPrimitive or: [self willJump]]]]] whileFalse: [| c | c := self step. c == self ifFalse: [^c]]. self] on: Core.Error do: [:ex | CodeSimulationError signalWith: self]
</methods> <methods> Kernel.Context <category>printing</category>
printSenderStackOn: aStream max: num | totalDepth topCnt bottomCnt dropCnt ctx | totalDepth := self contextStackDepth. totalDepth <= num ifTrue: [topCnt := totalDepth] ifFalse: [topCnt := (num / 4) truncated. bottomCnt := num - topCnt. dropCnt := totalDepth - num]. ctx := self. 1 to: topCnt do: [:i | ctx printOn: aStream. aStream cr. ctx := ctx sender]. topCnt = totalDepth ifTrue: [^self]. aStream nextPutAll: ' * * * '. 1 to: dropCnt do: [:i | ctx := ctx sender]. 1 to: bottomCnt do: [:i | ctx printOn: aStream. aStream cr. ctx := ctx sender].
</methods> <methods> Kernel.Context <category>private-debugger</category>
probeMethod: aMethod self changeToVPC. method := aMethod.
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
put: obj intoTempVar: aVar "Answer the argument or temporary value of the variable." self nestingAt: self nesting - aVar nesting do: [:ctx | ^ctx slotAt: aVar debuggerIndex put: obj]. self error: (#IndexIsOutOfRange << #pdp >> 'Index is out of range')
</methods> <methods> Kernel.Context <category>private-debugger</category>
restackMessage: aMessage to: obj self push: obj. aMessage arguments do: [:arg | self push: arg]
</methods> <methods> Kernel.Context <category>private-simulation</category>
return: value | caller | caller := sender. caller isNil ifTrue: [^self cannotReturn: value] ifFalse: [self terminate. ^caller push: value]
</methods> <methods> Kernel.Context <category>simulation-debugger</category>
safelyInterpretNextInstructionFor: aContext | interrupted ctx | interrupted := false. [ctx := self interpretNextInstructionFor: aContext] on: UserInterrupt do: [:ex | interrupted := true. ex resume]. interrupted ifTrue: [UserInterrupt signalWith: ctx]. ^ctx
</methods> <methods> Kernel.Context <category>private-simulation</category>
send: selector receiver: rcvr class: rclass super: flag numArgs: na "Don't simulate calls on error:." (flag | self class doSend or: [selector == #primTerminate or: [(rclass includesBehavior: GenericException) and: [selector ~~ #aboutToDebug]]]) ifFalse: [^self sendFast: selector receiver: rcvr numArgs: na]. (self isSendLoop and: [(rclass includesBehavior: GenericException) and: [selector == #aboutToDebug]]) ifTrue: [^ContextEmergencyError signalWith: rcvr]. self findMethod: selector class: rclass ifFound: [:meth :mclass | flag ifTrue: [self pop]. "remove class for super" ^self runMethod: meth numArgs: na contextClass: MethodContext]. self findMethod: #doesNotUnderstand: class: (self _objectClass: rcvr) ifFound: [:meth :mclass | | args | flag ifTrue: [self pop]. "remove class for super" args := Array new: na. na to: 1 by: -1 do: [:i | args at: i put: self topPop]. self push: (Message selector: selector arguments: args). ^self runMethod: meth numArgs: 1 contextClass: MethodContext]. self error: ((#MessageNotFoundC1s << #pdp >> 'Message not found: <1s>') expandMacrosWith: selector printString). "To continue, just return the receiver of the message." flag ifTrue: [self pop]. "remove class for super" stackp := stackp - na. self localAt: stackp put: rcvr
</methods> <methods> Kernel.Context <category>private-debugger</category>
sendFast: selector receiver: rcvr numArgs: na "Execute a send by using perform to invoke VM. Before doing perform, insert extra contexts between the receiver and the perform context. The extra contexts holds an exception handling block and an unwind block. The exception handling block is used to repropagate the signal through the client process contexts chain. The unwind block is used to catch control flow after an uparrow block return occurs in executing the send." | args context interrupted excpt rtnCtx | args := Array new: na. 1 to: na do: [ :i | args at: i put: ( self localAt: stackp - na + i ) ]. stackp := stackp - na - 1. (self checkHandlerBlock: rcvr value: selector) ifTrue: [selector == #aboutToDebug ifTrue: ["emergency handler" self class emergencySignal raiseWith: rcvr] ifFalse: [context := self class baseContextSignal raiseRequest. ((args at: 1) handlerContext hasSender: context) ifTrue: [^self blockContextFrom: rcvr args: args] ifFalse: [^Array with: (self blockContextFrom: rcvr args: args)]]]. interrupted := false. [ | savedSender invisibleContext stubCtx ctx | invisibleContext := thisContext. savedSender := thisContext sender. [ [invisibleContext sender: self. [stubCtx := thisContext. context := self push: (self _object: rcvr perform: selector withArguments: args)] on: Signal genericSignal do: [:ex | ex checkInitialContextIf: stubCtx with: self. self removeContextsTo: stubCtx. excpt := ex. rtnCtx := thisContext sender sender. thisContext sender: invisibleContext]. ] ifCurtailed: [ctx := thisContext unwindRequestorContext home. ctx method == ( BlockContext compiledMethodAt: #nonlocalReturn:through:) ifTrue: [context := ctx uparrowReturn]. thisContext sender: invisibleContext]. ] on: UserInterrupt do: [:ex | interrupted := true. ex resume]. invisibleContext sender: savedSender. ] value. excpt notNil ifTrue: [context := excpt rePropagateReturnTo: rtnCtx]. interrupted ifTrue: [UserInterrupt signalWith: context]. ^context
</methods> <methods> Kernel.Context <category>simulation-debugger</category>
sendIntoBlockStartingWithCallee: aContext "Simulate the execution of bytecodes until we encounter a context whose home method is the same as my homeMethod, or until a return to a non-context in case of block up arrow return." | ctxt guardMethod proc | guardMethod := self method homeMethod originalMethod. proc := Processor activeProcess. proc setDoSend. proc setDoSendLoop. [ ctxt := aContext == self ifTrue: [self step] ifFalse: [aContext]. [(ctxt isKindOf: Context) and: [(ctxt hasSender: self) and: [guardMethod ~~ ctxt method homeMethod originalMethod]]] whileTrue: [ctxt := ctxt step]. ] ensure: [proc clearDoSend. proc clearDoSendLoop]. "check for handler context" (ctxt isMemberOf: Array) ifTrue: [ctxt := ctxt at: 1]. ^ctxt
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
sourceMap "Answer a sourceMap for PC selection in the current code." ^self visibleSourceMap.
</methods> <methods> Kernel.Context <category>simulation-debugger</category>
step "Simulate the execution of the receiver's next bytecode. Answer the context that would be the active context after this bytecode." ^[self safelyInterpretNextInstructionFor: self] on:Object errorSignal do: [:ex | Context codeSimulationErrorSignal raiseFrom: self]
stepForever "Simulate the execution of the receiver's next bytecode until a return or an exception is raised, a break occurs. Answer the context that would be the active context after this bytecode." ^[| ctx | ctx := self. [ctx ~~ self or: [self willReturn]] whileFalse: [ctx := self pdpCompleteCallee: (self safelyInterpretNextInstructionFor: self)]. ctx] on: Core.Error do: [:ex | CodeSimulationError signalWith: self]
stepUntilSkipPC: stopPC "Simulate the execution of bytecodes until pc is equal to stopPC" ^[| ctx | ctx := self. [ctx == self and: [self pc < stopPC and: [self willReturn not]]] whileTrue: [ctx := self pdpCompleteCallee: self step]. ctx] on: Core.Error do: [:ex | CodeSimulationError signalWith: self]
</methods> <methods> Kernel.Context <category>private-debugger</category>
storeTop: anObject ^self localAt: stackp put: anObject
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
supposedHome ^self subclassResponsibility
</methods> <methods> Kernel.Context <category>simulation-primitive support</category>
tryPrimitive: index receiver: rcvr numArgs: numArgs boundByMethod: primMethod "Evaluate the primitive with the given index. Return new context if successful, nil if failed" (index >= 86 and: [index <= 89]) ifTrue: [index = 86 ifTrue: ["^self primWait: rcvr"]. index = 88 ifTrue: ["^self primSuspend: rcvr"]. index = 89 ifTrue: [^self primFlushVMmethodCache: rcvr]]. index = 184 ifTrue: "Context _object:perform:withArguments:" [^self primObjectPerform: (self localAt: stackp - 2) selector: (self localAt: stackp - 1) arguments: self top]. ((#(375 394 395) includes: index) and: [(primMethod isLinkedFor: rcvr class) not]) ifTrue: ["unlinked fast DLLCC call invokes unboundMethod:with:" ^self primUnlinkedCallCExternalMethod: primMethod receiver: rcvr numArgs: numArgs]. (index >= 500 and: [index <= 523]) ifTrue: [index = 500 ifTrue: "BlockClosure valueWithArguments:" [^self primBlockValue: rcvr arguments: self top]. index < 510 ifTrue: "BlockClosure value:*" [^self primBlockValue: rcvr numArgs: numArgs]. index = 510 ifTrue: "Object perform:withArguments:" [^self primPerform: rcvr selector: (self localAt: stackp - 1) arguments: self top]. index < 520 ifTrue: "Object perform:with:*" [^self primPerform: rcvr selector: (self localAt: stackp - numArgs + 1) numArgs: numArgs - 1]. index = 522 ifTrue: "Behavior flushVMmethodCacheEntriesFor:" [^self primFlushVMmethodCacheEntries: rcvr]. index = 523 ifTrue: "CompiledMethod valueWithReceiver:arguments:" [^self primPerformMethod: rcvr]]. index = 312 ifTrue: [ProcessTerminatedDuringSimulation signalWith: [self doPrimitive: index receiver: rcvr numArgs: numArgs boundByMethod: primMethod]]. ^self doPrimitive: index receiver: rcvr numArgs: numArgs boundByMethod: primMethod
</methods> <methods> Kernel.Context <category>accessing-debugger</category>
visibleSourceMap "Answer a sourceMap for PC selection in the current code." self sourceInfo: [:methodHolder :index | ^(methodHolder visibleSourceMap at: index) asSortedCollection]
</methods> <methods> UI.Icon class <category>private-icon-creation</category>
createWatchIcon ^self createVisualIcon: #[ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 60 0 30 0 108 0 54 0 198 0 99 1 134 0 195 3 12 1 134 6 0 3 0 12 0 6 0 24 0 12 0 63 15 152 0 63 159 240 0 96 240 112 0 192 96 48 0 192 96 48 0 192 96 48 0 204 102 48 0 254 127 48 0 254 127 48 0 124 254 96 0 63 159 192 0 31 15 128 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] "Smalltalk Professional Debug Package Version 1.10 (c) 1995 Crafted Smalltalk"
</methods> <methods> UI.Icon class <category>class initialization</category>
initializeWatchIcon "Icon initializeWatchIcon" self installMask: self createWatchIcon forIconNamed: #watchWindow. "Smalltalk Professional Debug Package Version 1.10 (c) 1995 Crafted Smalltalk"
</methods> <methods> Kernel.GeneralNameSpace <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Core.CharacterArray <category>printing</category>
forStackDumpPrintUsing: aPolicy aPolicy printString: self
</methods> <methods> Kernel.CompiledMethod <category>accessing</category>
blockMethodIndex "Returns the block method index of the receiver. Which is 1 in the case of a CompiledMethod." ^1
</methods> <methods> Kernel.CompiledMethod <category>testing</category>
isBound mclass selectorAtMethod: self ifAbsent: [^false]. ^true
isFullBlockChain "Returns true if all the blocks from the receiver to the compiled method are used in full block closures. For a CompiledMethod return true." ^true
isPartiallyBound mclass selectorAtMethod: self ifAbsent: [^false]. ^true
isProbeable "Return true if the receiver can be converted to a probed method." ^true
</methods> <methods> Kernel.CompiledMethod <category>accessing</category>
newFullProbedMethod ^self probedMethodClass from: self full: true
newNormalProbedMethod ^self probedMethodClass from: self full: false
newTempFullProbedMethod ^self newFullProbedMethod
newTempProbedMethod ^self newNormalProbedMethod
</methods> <methods> Kernel.CompiledMethod <category>printing</category>
printNameOn: aStream inClass: aClass | selector class | aClass isNil ifTrue: [| who | mclass isNil ifTrue: [aStream nextPutAll: (#ParenUnboundMethodParen << #pdp >> '(Unbound method)') asString. ^self]. who := self who. who isNil ifTrue: [class := mclass. selector := class defaultSelectorForMethod: self] ifFalse: [class := who first. selector := who at: 2]] ifFalse: [class := aClass. selector := class selectorAtMethod: self setClass: [:mc | ]]. aStream print: class. mclass == class ifFalse: [aStream nextPut: $(. aStream print: mclass. aStream nextPut: $)]. aStream nextPutAll: '>>'. aStream nextPutAll: selector
</methods> <methods> Kernel.CompiledMethod <category>accessing</category>
probedMethodClass ^ProbedCompiledMethod
revert "Ignore, this is overriden by ProbedCompiledMethod." ^self
</methods> <methods> Kernel.CodeComponent <category>private-load/unload</category>
prepareCodeWriter: aCodeWriter "Load aCodeWriter with the objects necessary to write-out the contents of the receiver." self cleanse. self definedClasses do: [:cl | cl revertAllProbedMethods]. self extensionMethods do: [:meth | meth revert]. self runPreSave. self storePropertiesOn: aCodeWriter. "Store the definitions." aCodeWriter storeDefinedObjects: self definedObjects. aCodeWriter storeClasses: self definedClasses extensions: self extensionMethods excluding: self definedClassesExcludedSelectors. aCodeWriter storeDefinedBindings: self definedBindings. self namedObjects keysAndValuesDo: [:key :value | aCodeWriter addObject: value named: key]. ^aCodeWriter
</methods> <methods> Core.UndefinedObject <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Core.Message <category>compilation</category>
methodStubSource "Return a String of a method body for the message which contains a single self halt statement." "nil zork" "nil zork: 1" "nil zork: 1 zork: $1" "nil zork: 1 zork: 1 zork: 1" | str na | str := (String new: 1024) writeStream. (na := args size) = 0 ifTrue: [str nextPutAll: selector] ifFalse: [| argNames | argNames := OrderedCollection new: na. args with: selector keywords do: [:arg :keyword| | argName | argName := ((arg isBehavior ifTrue: ['a', arg basicPrintString] ifFalse: [arg basicPrintString]) copyWithout: Character space) copyWithout: $. . (argNames includes: argName) ifTrue: [| newName n | n := 2. [newName := argName, n printString. argNames includes: newName] whileTrue: [n := n + 1]. argName := newName]. argNames add: argName. str nextPutAll: keyword; space; nextPutAll: argName. str space]]. str crtab; nextPutAll: 'self halt'. ^str contents "(Message selector: #with:with: arguments: (Array with: Store.PackageModel with: Store.PackageModel)) methodStubSource"
</methods> <methods> Kernel.AnnotatedMethod <category>accessing</category>
probedMethodClass ^ProbedAnnotatedMethod
</methods> <methods> Kernel.SyntaxError <category>text</category>
debug "Open a debugger on the stack" self changeRequest ifFalse: [^self]. DebuggerService openOnHandle: processHandle label: (#SyntaxError << #pdp >> 'Syntax Error')
textMenu "Answer a Menu of operations on the text that is to be displayed when the operate menu button is pressed." "SyntaxError flushMenus" TextMenu == nil ifTrue: [TextMenu := Menu labelList: ParagraphEditor editGroupLabels, (Array with: (Array with: (#DoIt << #pdp >> 'Do it') with: (#PrintIt << #pdp >> 'Print it') with: (#InspectIt << #pdp >> 'Inspect it')) with: (Array with: (#Accept << #pdp >> 'Accept') with: (#Cancel << #pdp >> 'Cancel')) with: (Array with: (#Proceed << #pdp >> 'Proceed') with: (#Debug << #pdp >> 'Debug')) with: (Array with: (#Hardcopy << #pdp >> 'Hardcopy'))) values: ParagraphEditor editGroupSelectors,#(doIt printIt inspectIt accept cancel proceed debug hardcopy)]. ^ TextMenu
</methods> <methods> Kernel.CompiledCode <category>accessing</category>
blockAt: anIndex | i | i := 1. self withAllBlockMethodsDo: [:aBlock | i = anIndex ifTrue: [^aBlock]. i := i + 1]
</methods> <methods> Kernel.CompiledCode <category>testing</category>
createsFullBlockFor: aBlock | scanner | scanner := InstructionStream on: self. ^scanner scanFor: [:byte | (byte = OpFullBlock or: [byte = OpFullCopyingBlock]) and: [aBlock = (self literalAt: (scanner parameterAt: scanner pc index: 1 extend: 1) + 1)]]
isProbed ^false
</methods> <methods> Kernel.CompiledCode <category>copying</category>
postCopy "Finish doing whatever is required, beyond a shallowCopy, to implement 'copy'. Answer the receiver. Subclasses may add functionality, but they should always do super postCopy first." super postCopy. 1 to: self numLiterals do: [:i | | lit cl | lit := self literalAt: i. cl := lit class. ((lit isKindOf: CompiledBlock) or: [cl == BlockClosure]) ifTrue: [self literalAt: i put: (lit := lit copy). cl = BlockClosure ifTrue: [lit method outerMethod: self] ifFalse: [lit outerMethod: self]] ifFalse: [self literalAt: i put: lit]]. ^self
</methods> <methods> Kernel.CompiledCode <category>testing</category>
readsField: instVarIndex ^InstanceVariableSearch new method: self; searchFor: instVarIndex-1 type: #read
</methods> <methods> Kernel.CompiledCode <category>accessing</category>
sourceInfo: aBlock "Invoke aBlock with the methodNodeHolder and the index." | homeMethod methodHolder index | homeMethod := self homeMethod. methodHolder := homeMethod sourceInfoIfCached. methodHolder == nil ifTrue: [methodHolder := self compilerClass new parse: self getSource in: self mclass environment: self environment allowReceiver: homeMethod usuallyAllowsReceiver noPattern: homeMethod usuallyHasSelector not notifying: nil. methodHolder == nil ifTrue: [methodHolder := self compilerClass new parse: self getSource in: self mclass environment: self environment allowReceiver: homeMethod usuallyAllowsReceiver noPattern: true notifying: nil]. homeMethod cacheSourceInfo: methodHolder]. index := homeMethod withAllBlockMethods identityIndexOf: self. ^aBlock value: methodHolder value: index
sourceMapAt: index ^self sourceInfo: [:methodHolder :x | ^(methodHolder sourceMap at: index) asSortedCollection]
</methods> <methods> Kernel.CompiledCode <category>enumerating</category>
withAllBlockMethodsDo: aBlock "Recursively enumerate the collection of methods (including block methods) that are included in this method." aBlock value: self. self literalsDo: [:lit | | cl | cl := lit class. (lit isKindOf: CompiledBlock) ifTrue: [lit withAllBlockMethodsDo: aBlock] ifFalse: [cl == BlockClosure ifTrue: [lit method withAllBlockMethodsDo: aBlock]]]
withAllProbedBlockMethodsDo: aBlock "Recursively enumerate the collection of methods (including block methods) that are included in this method." self isProbed ifFalse: [^self]. aBlock value: self. self literalsDo: [:lit | | cl | cl := lit class. (lit isKindOf: CompiledBlock) ifTrue: [lit withAllProbedBlockMethodsDo: aBlock] ifFalse: [cl == BlockClosure ifTrue: [lit method withAllProbedBlockMethodsDo: aBlock]]]
</methods> <methods> Kernel.CompiledCode <category>testing</category>
writesField: instVarIndex ^InstanceVariableSearch new method: self; searchFor: instVarIndex-1 type: #write
</methods> <methods> Core.Behavior <category>accessing</category>
methodDictionary ^methodDict
</methods> <methods> Core.Behavior <category>creating method dictionary</category>
replaceMethodAt: selector withMethod: compiledMethod "The purpose of this method is to replace a method with an instrumented verson. It should not be used when the source code is changed." methodDict at: selector put: (self validateMethod: compiledMethod forSelector: selector). self flushVMmethodCacheEntriesFor: selector.
</methods> <methods> Core.Behavior <category>probes</category>
revertAllProbedMethods "Make sure all original methods in the class have been restored. This must be done before changing the class structure, i.e. adding an instance variable." | pcms | pcms := OrderedCollection new. 2 to: methodDict basicSize by: 2 do: [:i | | cm | cm := methodDict basicAt: i. cm isProbed ifTrue: [methodDict basicAt: i put: cm originalMethod. pcms add: cm. PDPManager changedMethodFrom: cm to: cm originalMethod by: nil]]. ^pcms
revertAllProbedMethodsInTree "Make sure all original methods in the class tree have been restored. This must be done before changing the class structure, i.e. adding an instance variable." | pcms | pcms := OrderedCollection new. pcms addAll: self revertAllProbedMethods. self allSubclassesDo: [:cl | pcms addAll: cl revertAllProbedMethods]. ^pcms
</methods> <methods> Kernel.InstructionStream <category>testing</category>
atEnd "Answer true iff there are no more bytecodes in the stream." self changeToVPC. ^pc > method bytesSize
hasReceiverOnStackForSend | byte | self changeToVPC. byte := self baseBytecodeAt: pc. (byte between: OpSendSelf0 and: OpSendSelf0+MaxSendSelf0) ifTrue: [^false]. (byte = OpXSuper or: [byte = OpXXSuper]) ifTrue: [^false]. ^true
isPopPushAt: nextPC "This is almost the same as isPopFirst:" | byte | byte := self baseBytecodeAt: nextPC. byte < OpPopLoadTemp ifTrue: [^byte = OpPopLoadReceiver]. ^byte <= (OpPopLoadTemp + MaxPopLoadTemp)
pdpWillSend "Answer whether the next bytecode is a message-send." | byte | self changeToVPC. byte := self baseBytecodeAt: pc. byte < FirstShortSend ifTrue: [^false]. (byte between: FirstShortSend and: LastShortSend) ifTrue: [^true]. "special send or short send" byte = OpSendAdd1 ifTrue: [^true]. (byte between: OpXNoCheckSend and: OpXNonImmediateSpecialSend) ifTrue: [^true]. "long sends" byte = OpXNoCheckSpecialSend ifTrue: [^true]. (byte between: OpXSpecialSend and: OpXXNoCheckSend) ifTrue: [^true]. (byte between: OpXXSend and: OpXXSuper) ifTrue: [^true]. ^false
sendsAdd1 "Answer whether the next bytecode sends an add1" self changeToVPC. ^(method byteAt: pc) = OpSendAdd1
willJump "Answer whether the next bytecode is a junp." ^self isJump: self pc
</methods> <methods> Kernel.MarkedMethod <category>testing</category>
isProbeable "Return false. The receiver cannot be converted to a probed method." ^false
</methods> <methods> Kernel.MarkedMethod <category>accessing</category>
newFullProbedMethod ^nil
</methods> <methods> Core.Symbol <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Core.Boolean <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Kernel.ProcessorScheduler <category>debugging</category>
interruptActiveUserProcess | proc deb | proc := self runableProcesses detect: [:p | p isSystemProcess not] ifNone: [nil]. (proc isNil and: [Window currentWindow notNil]) ifTrue: [proc := Window currentWindow windowProcess]. proc isNil ifTrue: [^self interruptAllUserProcesses]. (deb := proc environmentAt: #debugger) notNil ifTrue: [^deb abortDebugOperationInProcess: proc]. proc isUnderDebug ifTrue: [^DebuggerService abortDebuggingFor: proc]. proc interruptWith: [Object userInterruptSignal interruptWith: thisContext sender sender errorString: (#exceptUserInterrupt << #dialogs >> 'User Interrupt')]
</methods> <methods> Kernel.ProcessorScheduler <category>accessing</category>
isPaused: aProcess ^pausedProcesses includes: aProcess
isRunable: aProcess ^(quiescentProcessLists at: aProcess priority) includes: aProcess
</methods> <methods> Kernel.ProcessorScheduler <category>process state change</category>
nextProcessForPausing quiescentProcessLists size to: 1 by: -1 do: [:i | | list p | list := quiescentProcessLists at: i. list isEmpty ifFalse: [p := list first. [p notNil and: [p isSystemProcess or: [p isUnderDebug]]] whileTrue: [p := p nextLink]. p notNil ifTrue: [^p]]]. ^nil
pauseUserProcesses | proc procs | procs := OrderedCollection new. "First, abort any debugging." Process allInstances do: [:p | p isUnderDebug ifTrue: [p debugger ctrlyAbort] ifFalse: [procs add: p]]. procs := procs reject: [:p | p isSystemProcess]. "Next, pause all runable processes, in priority order" [(proc := self nextProcessForPausing) notNil] whileTrue: [procs remove: proc ifAbsent: []. self pauseProcess: proc]. "These remaining processes should be blocked or suspended." procs do: [:p | self pauseProcess: p]
proceedUserProcesses pausedProcesses shallowCopy do: [:p | p proceed].
removePausedProcess: aProcess pausedProcesses remove: aProcess ifAbsent: [].
resumePausedProcess: aProcess pausedProcesses remove: aProcess ifAbsent: []. ^aProcess resume.
</methods> <methods> UI.ComposedTextView <category>updating</category>
updateTheDisplay "This is used by the browsers only." | text changedString | text := self getContents asText. changedString := displayContents text string ~= text string. (changedString or: [displayContents text runs ~= text runs]) ifFalse: [self controller. "Make sure we have a controller" self resetController. ^self]. "If nothing changed, exit" self isOpen ifTrue: [displayContents setCompositionWidth: self wrappingBox width. displayContents text: text asText copy] ifFalse: [displayContents setCompositionWidth: ComposedText defaultCompositionWidth. displayContents setText: text asText copy]. changedString ifTrue: [self setToTop]. startBlock := stopBlock := nil. selectionShowing := true. self controller. "Make sure we have a controller" self resetController. "redisplay now so selection updates will display correctly" self invalidateRectangle: self bounds repairNow: true.
</methods> <methods> Graphics.CharacterAttributes <category>private</category>
queryCacheAt: aStyle for: aFontPolicy put: query "Store the cached query for aStyle." aStyle isCharStyleCacheable ifFalse: [^self]. queryCache size >= QueryCacheLimit ifTrue: [self invalidateOnlyQueryCache]. policyCache at: 1 put: aFontPolicy. queryCache at: aStyle put: query
</methods> <methods> Kernel.ClassBuilder <category>accessing</category>
revertProbedMethods | removed | removed := OrderedCollection new. records do: [:rec | rec targetClass ifNotNil: [removed addAll: rec targetClass revertAllProbedMethodsInTree]]. ^removed "Smalltalk Professional Debug Package Version 3.1 (c) 2002 Crafted Smalltalk".
reviseSystemSilently | queue map next removedMethods | ^SystemUtils modifySystem: [self validateRecords. removedMethods := self revertProbedMethods. queue := OrderedCollection withAll: records. queue removeAllSuchThat: [:rec | rec isTrivial]. map := Dictionary new. [queue isEmpty] whileFalse: [next := queue removeFirst. (map includesKey: next fullName) ifFalse: [map at: next fullName put: next. queue addAll: next neededRecords]]. map do: [:record | record reviseFromMap: map; alertSuperclass]. map do: [:record | record verify]. Cursor read showWhile: [map do: [:record | record constructCopy]. map do: [:record | record constructCopy2]. map do: [:record | record constructCopy3]]. Cursor write showWhile: [map do: [:record | record doBecome]. map do: [:record | record cleanup]]. records do: [:r | r doExtraWork]. NameScope initialize. BlockAnalyzer initialize. ProbedCompiledMethod recompileAndInsertProbesFrom: removedMethods. records first result]
</methods> <methods> Kernel.GeneralBindingReference <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Kernel.ProgramNode <category>copying</category>
postDcopyUsing: copyDict "Complete the deep copy operation." sourcePosition := sourcePosition basicDcopyUsing: copyDict. 4 to: self class instSize do: [ :i | self instVarAt: i put: ((self instVarAt: i) basicDcopyUsing: copyDict)]
</methods> <methods> Tools.ProcessHandle <category>control</category>
abortDebugOperation process isNil ifTrue: [^self]. [process interruptWith: [Object userInterruptSignal interruptWith: thisContext sender sender errorString: (#OperationAborted << #pdp >> 'Operation aborted') asString]] on: Error do: [:ex | ] "Ignore error"
destroyProcess process := nil.
</methods> <methods> Tools.ProcessHandle <category>testing</category>
isInDebugSession ^process notNil
isTerminated ^process isNil or: [process isTerminated]
</methods> <methods> Tools.ProcessHandle <category>control</category>
pauseProcess "Continue the process--start it up again from the point of interrupt. If there was a controller associated with the interrupted process, make it be the active controller." process suspendedContext: resumeContext. process disableDebug. resumeContext method == (Process compiledMethodAt: #terminate) ifFalse: [controller == nil ifFalse: [controller restartAfterError.]]. Processor pauseProcess: process. process := nil. "So that the process doesn't get terminated"
</methods> <methods> Tools.ProcessHandle <category>access</category>
prepareForErrorCondition controller ifNotNil: [controller shutdownBecauseOfError]. modalWindowChain := WindowManager modalWindowChain reverse. WindowManager beEffectivelyModeless.
prepareForSimulation interrupted ifTrue: [^self]. resumeContext push: proceedValue. interrupted := true. "simulation leaves same state as interrupting"
</methods> <methods> Tools.ProcessHandle <category>private</category>
process: aProcess controller: aController interrupted: aBoolean resumeContext: aContext process := aProcess. controller := aController. interrupted := aBoolean. resumeContext := aContext. proceedValue := nil
</methods> <methods> Tools.ProcessHandle <category>control</category>
resumeProcess "Continue the process--start it up again from the point of interrupt. If there was a controller associated with the interrupted process, make it be the active controller." | p | process suspendedContext: resumeContext. process disableDebug. resumeContext method == (Process compiledMethodAt: #terminate) ifFalse: [controller notNil ifTrue: [controller restartAfterError. controller controlInitialize]]. p := process. process := nil. "So that the process doesn't get terminated" p resume.
terminate "Terminate the process that we are holding on to." controller notNil ifTrue: [[controller resetAfterError] on: Error do: [:ex |nil]]. process isNil ifTrue: [^self]. process suspendedContext: resumeContext. process disableDebug. [process terminateUnsafely] on: GenericException do: [:ex | process suspendUnconditionally; suspendedContext: nil]. process := nil
</methods> <methods> Tools.ProcessHandle <category>access</category>
topContext: aContext "Set aContext to be the context in which to continue the process, if possible." resumeContext := aContext. process suspendedContext: aContext.
</methods> <methods> UI.ParagraphEditor <category>accessing</category>
selectionRange ^self selectionStartIndex to: self selectionStopIndex
</methods> <methods> Core.Collection <category>printing</category>
forStackDumpPrintUsing: aPolicy aPolicy printCollection: self.
</methods> <methods> Core.Text <category>emphasis</category>
allItalic "Set the emphasis for all characters in the receiver to be italic." self emphasizeAllWith: #italic
</methods> <methods> Core.Character <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Kernel.SystemUtils class <category>accessing</category>
rebindEntireSystem self allClassesDo: [:class | Transcript show: class printString; cr. class revertAllProbedMethods. class rebindAllMethods] "Smalltalk Professional Debug Package Version 2.5 (c) 1999 Crafted Smalltalk"
</methods> <methods> Core.SmallInteger <category>copying</category>
basicDcopyUsing: copyDict "Don't copy" ^self
</methods> <methods> Kernel.BlockClosure <category>copying</category>
basicMethodDcopyUsing: copyDict ^self basicDcopyUsing: copyDict
</methods> <methods> Kernel.BlockClosure <category>testing</category>
isClean ^outerContext isNil and: [method numCopiedValues = 0]
</methods> <methods> Kernel.BlockClosure <category>private</category>
method: aMethod method := aMethod
promiseBlock: aPromise " Answer a block that evaluates the receiver as a Promise. " ^[ [ [ aPromise value: self value ] on: Signal noHandlerSignal do: [ :exc | (ControlInterrupt handles: exc parameter) ifTrue: [exc pass]. " An exception is being raised. If it is non-proceedable, save it so that the Promise will raise it instead of returning a value. " aPromise exception: exc parameter. exc return]] on: Process terminateSignal do: [ :exc | aPromise exception: ( Promise terminateSignal newException setSignal: Promise terminateSignal; parameter: exc; errorString: nil). exc return]]
</methods> <methods> Kernel.BlockContext <category>accessing-debugger</category>
findHomeContextByMatchingHomeMethod | meth ctx | meth := self method homeMethod originalMethod. ctx := self sender. [ctx == nil] whileFalse: [ctx isBlockContext ifFalse: [ctx method originalMethod == meth ifTrue: [^ctx]]. ctx := ctx sender]. ^nil
</methods> <methods> Kernel.BlockContext <category>private-debugger</category>
initialStackDepthForProbes ^super initialStackDepthForProbes + method numCopiedValues
</methods> <methods> Kernel.BlockContext <category>accessing-debugger</category>
intendedReceiver "Answer the receiver to which the home method was sent." | ctxt selfVar | (ctxt := self home) == nil ifFalse: [^ctxt receiver]. "No home receiver, look for a compiler generated temp." selfVar := self localScope temps detect: [:var | var key = 'self'] ifNone: [^nil]. ^self getTempVar: selfVar value
</methods> <methods> Kernel.BlockContext <category>private</category>
nestingAt: level do: aBlock | outer | level = 0 ifTrue: [^aBlock value: self]. (outer := self outerContext) == nil ifTrue: [^self error: (#LevelCountingError << #pdp >> 'Level counting error')]. ^outer nestingAt: level - 1 do: aBlock
</methods> <methods> Kernel.BlockContext <category>simulation-control</category>
stepToCtxtWithSameParentAs: ctxt "Step to a context with the same original method as ctxt, or until ctxt has exited." | parentCtxt | self hasExited ifFalse: [^ctxt]. parentCtxt := ctxt findParentContextWithHomeMethod: self method homeMethod originalMethod. parentCtxt isNil ifTrue: [^ctxt]. "No parent." ^parentCtxt sendIntoBlockStartingWithCallee: ctxt. "Smalltalk Professional Debug Package Version 3.1 (c) 2003 Crafted Smalltalk"
</methods> <methods> Kernel.BlockContext <category>accessing-debugger</category>
supposedHome | ctx | (ctx := self home) == nil ifFalse: [^ctx]. ^self findHomeContextByMatchingHomeMethod
</methods> <methods> Kernel.BlockContext <category>testing</category>
willExitMethod "Answer whether the next bytecode will cause an exit from the method." self changeToVPC. ^(self baseBytecodeAt: pc) = Kernel.OpcodePool.OpHomeReturn
</methods> <methods> Kernel.MethodContext <category>accessing-debugger</category>
intendedReceiver "Answer the receiver to which the home method was sent." ^receiver
</methods> <methods> Kernel.MethodContext <category>private</category>
nestingAt: level do: aBlock level > 0 ifTrue: [^self error: (#LevelCountingError << #pdp >> 'Level counting error')]. ^aBlock value: self
</methods> <methods> Kernel.MethodContext <category>simulation-control</category>
stepToCtxtWithSameParentAs: ctxt ^ctxt
</methods> <methods> Kernel.MethodContext <category>accessing-debugger</category>
supposedHome ^self
</methods> <methods> Kernel.MethodContext <category>testing</category>
willExitMethod "Answer whether the next bytecode will cause an exit from the method." ^self willReturn
</methods> <methods> CraftedSmalltalk.DebuggerService class <category>interface specs</category>
watchVarSpec "UIPainter new openOnClass: self andSelector: #watchVarSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #pdp) #bounds: #(#Rectangle 466 311 979 522 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#LayoutOrigin -103 0.5 15 0 ) #label: #(#{Kernel.UserMessage} #key: #SelectWatchVariable #defaultString: 'Select Watch Variable' #catalogID: #pdp) ) #(#ActionButtonSpec #layout: #(#Rectangle 121 166 210 196 ) #model: #accept #tabable: false #label: #(#{Kernel.UserMessage} #key: #Done #defaultString: 'Done' #catalogID: #pdp) #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 304 168 389 198 ) #model: #cancel #tabable: false #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #pdp) #defaultable: true ) #(#DividerSpec #layout: #(#LayoutFrame 0 0 150 0 0 1.0 154 0 ) ) #(#InputFieldSpec #layout: #(#Rectangle 131 98 385 130 ) #model: #wVar #tabable: false #isReadOnly: true ) #(#ActionButtonSpec #layout: #(#Rectangle 9 51 132 80 ) #model: #TOS #tabable: false #label: #(#{Kernel.UserMessage} #key: #TopOfStack #defaultString: 'Top of Stack' #catalogID: #pdp) #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 143 50 332 80 ) #name: #IvarSwitch #model: #iVar #tabable: true #label: #(#{Kernel.UserMessage} #key: #InstanceVariableDots #defaultString: 'Instance Variable...' #catalogID: #pdp) #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 342 50 503 81 ) #name: #TempSwitch #model: #tVar #tabable: false #label: #(#{Kernel.UserMessage} #key: #TempVariableDots #defaultString: 'Temp Variable...' #catalogID: #pdp) #defaultable: true ) ) ) )
</methods> <methods> Tools.VisualLauncher <category>menus - pdp</category>
browseAllProbedMethods <menuItem: #(#_BrowseProbes #pdp '&Browse Probes') icon: nil nameKey: nil menu: #(#menuBar #probes) position: 30.1> PDPManager browseAllProbedMethods
clearTestExpressionLibrary <menuItem: #(#_ClearDot #pdp '&Clear...') icon: nil nameKey: nil menu: #(#menuBar #probes #testLibrary) position: 20.2> ProbeTestExpressionEditor clearLibrary
clearWatchExpressionLibrary <menuItem: #(#_ClearDot #pdp '&Clear...') icon: nil nameKey: nil menu: #(#menuBar #probes #watchLibrary) position: 20.2> ProbeActionExpressionEditor clearLibrary
inspectDebugVars <menuItem: #(#_InspectDebugVariables #pdp '&Inspect Debug Variables') icon: nil nameKey: nil menu: #(#menuBar #probes) position: 30.2> PDPManager debugVariables inspect
inspectTestExpressionLibrary <menuItem: #(#_Inspect #pdp '&Inspect') icon: nil nameKey: nil menu: #(#menuBar #probes #testLibrary) position: 20.1> ProbeTestExpressionEditor inspectLibrary
inspectWatchExpressionLibrary <menuItem: #(#_Inspect #pdp '&Inspect') icon: nil nameKey: nil menu: #(#menuBar #probes #watchLibrary) position: 20.1> ProbeActionExpressionEditor inspectLibrary
loadTestExpressionLibrary <menuItem: #(#_LoadDot #pdp '&Load...') icon: nil nameKey: nil menu: #(#menuBar #probes #testLibrary) position: 10.1> ProbeTestExpressionEditor readLibrary
loadWatchExpressionLibrary <menuItem: #(#_LoadDot #pdp '&Load...') icon: nil nameKey: nil menu: #(#menuBar #probes #watchLibrary) position: 10.1> ProbeActionExpressionEditor readLibrary
probeLibraryMenu <submenu: #(#Probe_Library #pdp 'Probe &Library') nameKey: #probeLibrary menu: #(#menuBar #probes) position: 50.1>
probes <submenu: #(#_Debug #menus '&Debug') nameKey: #probes menu: #(#menuBar) position: 10.031>
purgeUnusedVars <menuItem: #(#RemoveUnusedDebug_VariablesDots #pdp 'Remove Unused Debug &Variables...') icon: nil nameKey: nil menu: #(#menuBar #probes) position: 20.3> (Dialog confirm: (#PurgeUnusedDebugVariables << #pdp >> 'Purge unused debug variables?')) ifTrue: [PDPManager purgeUnusedDebugVariables]
purgeUnusedWatches <menuItem: #(#RemoveUnused_WatchWindowsDots #pdp 'Remove Unused &Watch Windows...') icon: nil nameKey: nil menu: #(#menuBar #probes) position: 20.2> (Dialog confirm: (#PurgeUnusedWatches << #pdp >> 'Purge unused watches?')) ifTrue: [PDPManager purgeUnusedWatchWindows]
readProbeLibrary <menuItem: #(#_LoadDot #pdp '&Load...') icon: nil nameKey: nil menu: #(#menuBar probes #probeLibrary) position: 10.1> ProbedCompiledMethod readProbesFromFile
removeAllProbes <menuItem: #(#_RemoveAllProbesDots #pdp '&Remove All Probes...') icon: nil nameKey: nil menu: #(#menuBar #probes) position: 20.1> (Dialog confirm: (#RemoveAllProbesFromSystem << #pdp >> 'Remove all probes from system?')) ifTrue: [ProbedCompiledMethod revertAllProbedMethodsInSystem]
saveProbeLibrary <menuItem: #(#_SaveDot #pdp '&Save...') icon: nil nameKey: nil menu: #(#menuBar #probes #probeLibrary) position: 10.2> ProbedCompiledMethod saveProbesToFile
saveTestExpressionLibrary <menuItem: #(#_SaveDot #pdp '&Save...') icon: nil nameKey: nil menu: #(#menuBar #probes #testLibrary) position: 10.2> ProbeTestExpressionEditor saveLibrary
saveWatchExpressionLibrary <menuItem: #(#_SaveDot #pdp '&Save...') icon: nil nameKey: nil menu: #(#menuBar #probes #watchLibrary) position: 10.2> ProbeActionExpressionEditor saveLibrary
testLibraryMenu <submenu: #(#_TestLibrary #pdp '&Test Library') nameKey: #testLibrary menu: #(#menuBar #probes) position: 50.3>
toggleDebugging <menuItem: #toggleDebuggingLabel icon: nil nameKey: nil menu: #(#menuBar #probes) position: 10.1> PDPManager toggleDebugging
watchLibraryMenu <submenu: #(#_WatchLibrary #pdp '&Watch Library') nameKey: #watchLibrary menu: #(#menuBar #probes) position: 50.2>
</methods> <methods> Graphics.CharacterAttributes class <category>class initialization</category>
pdpAttributesFor: aDictionary <stylesWithOrder: 2> aDictionary at: #probe put: [:query :family | query underline: true; color: ColorValue red]. aDictionary at: #tempProbe put: [:query :family | query underline: true; color: ColorValue yellow].
</methods> <methods> Tools.VisualWorksSettings class <category>settings-debugger</category>
debugger10EditContextListPolicy <setting: #(tools debugger editContextListPolicy)> ^ExternalSetting new label: #EditContextListPresentation << #labels >> 'Context list presentation'; editorClass: CraftedSmalltalk.ContextListPolicyEditor; helpText: #EditContextListPresentationHelpText << #dialogs >> 'Opens an editor that allows to define special highlighting of contexts in the context list of the debugger. This setting is not saved together with the settings of the image.'
debugger40usePermanentProbes <setting: #(tools debugger usePermanentProbes)> ^(BooleanSetting on: CraftedSmalltalk.PDPManager aspect: #permanentProbeIsDefault) label: #UsePermanentProbesByDefault << #labels >> 'Use permanent probes by default'; default: true; helpText: #UsePermanentProbesHelpText << #dialogs >> 'Determines the default type of probes, and breakpoints created by the Insert Breakpoint command.'
debugger50showToolbarBelowContexts <setting: #(tools debugger showToolbarBelowContexts)> ^(BooleanSetting on: #{CraftedSmalltalk.DebuggerClient.PlaceToolbarBelowContexts}) label: #ShowToolbarBelowContexts << #labels >> 'Show toolbar below the context list'; default: false; helpText: #ShowToolbarBelowContextsHelpText << #dialogs >> 'Determines whether the toolbar is located in the standard place below the menu, or between the context list and the method text view.'
debugger70EventFaithfulDebugging <setting: #(tools debugger useEventFaithfulDebugging)> ^(BooleanSetting on: #{CraftedSmalltalk.DebuggerService.EventFaithfulDebugging}) default: false; label: #UseEventFaithfulDebugging << #labels >> 'Use event faithful debugging'; helpText: #UseEventFaithfulDebuggingHelpText << #dialogs >> 'Event faithful debugging insures that events are processed properly while debugging, but causes windows to freeze. If you are not concerned with debugging widgets, dialogs, or display code, then you may want this to be turned off. Additionally, if you are concerned about debugging THAPI you should have this enabled.'
debuggerPage <settingsPage: #(tools debugger)> ^ModularSettingsPage new label: #Debugger << #labels >> 'Debugger'; icon: (ListIconLibrary visualFor: #bug); settings: (self settingsWithPrefix: #(tools debugger))
</methods> <initialize> CraftedSmalltalk.DebuggerService </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>Parser</name> <environment>Kernel</environment> <super>Kernel.Scanner</super> <private>false</private> none builder requestor oldLanguage newLanguage extendedLanguage parseNode failBlock endTemps targetClass environment topEnvironment bindingRefs <imports></imports> <category>System-Compiler-Public Access</category> <attributes> <package>System-Compiler-Public Access</package> </attributes> </class> <class> <name>CompiledCode</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> objects bytes <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>CompiledMainBlock</name> <environment>Kernel</environment> <super>Kernel.CompiledCode</super> <private>false</private> objects <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>CompiledMethod</name> <environment>Kernel</environment> <super>Kernel.CompiledMainBlock</super> <private>false</private> objects mclass sourceCode <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>AnnotatedMethod</name> <environment>Kernel</environment> <super>Kernel.CompiledMethod</super> <private>false</private> objects attributes <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>MarkedMethod</name> <environment>Kernel</environment> <super>Kernel.AnnotatedMethod</super> <private>false</private> objects markType <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>SmallInteger</name> <environment>Core</environment> <super>Core.Integer</super> <private>false</private> immediate minVal maxVal maxBits maxBytes <imports></imports> <category>Magnitude-Numbers</category> <attributes> <package>Magnitude-Numbers</package> </attributes> </class> <class> <name>ProcessorScheduler</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none quiescentProcessLists activeProcess pausedProcesses <imports></imports> <category>Kernel-Processes</category> <attributes> <package>Kernel-Processes</package> </attributes> </class> <class> <name>Message</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none selector args <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>Character</name> <environment>Core</environment> <super>Core.Magnitude</super> <private>false</private> immediate <imports></imports> <category>Magnitude-General</category> <attributes> <package>Magnitude-General</package> </attributes> </class> <class> <name>CompiledBlock</name> <environment>Kernel</environment> <super>Kernel.CompiledCode</super> <private>false</private> objects outerMethod <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>Collection</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Collections-Abstract</category> <attributes> <package>Collections-Abstract</package> </attributes> </class> <class> <name>Model</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none dependents <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>RunArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none runs values cacheRun cacheRunStart <imports></imports> <category>Collections-Arrayed</category> <attributes> <package>Collections-Arrayed</package> </attributes> </class> <class> <name>InstructionStream</name> <environment>Kernel</environment> <super>Kernel.InstructionClient</super> <private>false</private> none method pc <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>CharacterAttributes</name> <environment>Graphics</environment> <super>Core.Object</super> <private>false</private> none attributes sharedAttributes defaultQuery queryCache policyCache <imports></imports> <category>Graphics-Fonts</category> <attributes> <package>Graphics-Fonts</package> </attributes> </class> <class> <name>GeneralBindingReference</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none path cache <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>CodeComponent</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none name properties <imports></imports> <category>System-Code Components</category> <attributes> <package>System-Code Components</package> </attributes> </class> <class> <name>CharacterArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>Boolean</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>Context</name> <environment>Kernel</environment> <super>Kernel.InstructionStream</super> <private>false</private> none sender receiver stackp stack <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>SyntaxError</name> <environment>Kernel</environment> <super>UI.Model</super> <private>false</private> none class badText processHandle <imports></imports> <category>Tools-Programming</category> <attributes> <package>Tools-Programming</package> </attributes> </class> <class> <name>BlockContext</name> <environment>Kernel</environment> <super>Kernel.Context</super> <private>false</private> none <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>ProgramNode</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none sourcePosition comment compilerHints blockIndex mapEntry returnMapEntry <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class> <class> <name>Process</name> <environment>Kernel</environment> <super>Core.Link</super> <private>false</private> none suspendedContext priority myList depth hostThreadKey interruptProtect environment isSystem name debugger locale <imports></imports> <category>Kernel-Processes</category> <attributes> <package>Kernel-Processes</package> </attributes> </class> <class> <name>BlockClosure</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none method outerContext copiedValues <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>Symbol</name> <environment>Core</environment> <super>Core.String</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>Text</name> <environment>Core</environment> <super>Core.CharacterArray</super> <private>false</private> none string runs <imports> private Graphics.TextConstants.* </imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>ProcessHandle</name> <environment>Tools</environment> <super>Core.Object</super> <private>false</private> none process controller interrupted resumeContext proceedValue modalWindowChain <imports></imports> <category>Tools-Programming</category> <attributes> <package>Tools-Programming</package> </attributes> </class> <class> <name>VisualLauncher</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none menuBar toolBar textCollector toolDock <imports></imports> <category>Tools-Misc</category> <attributes> <package>Tools-Misc</package> </attributes> </class> <class> <name>Behavior</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none superclass methodDict format subclasses <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>UndefinedObject</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ParagraphEditor</name> <environment>UI</environment> <super>UI.ControllerWithMenu</super> <private>false</private> none beginTypeInIndex anchorIndex emphasisHere dispatchTable charComposer textHasChanged feelPolicy supportCodeEditingFeels localMenuItems extendingDown <imports> private Graphics.TextConstants.* </imports> <category>UIBasics-Support</category> <attributes> <package>UIBasics-Support</package> </attributes> </class> <class> <name>MethodContext</name> <environment>Kernel</environment> <super>Kernel.Context</super> <private>false</private> none <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>ClassBuilder</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none records <imports> Behavior.* </imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>ComposedTextView</name> <environment>UI</environment> <super>UI.AutoScrollingView</super> <private>false</private> none displayContents startBlock stopBlock selectionShowing displaySelection <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</package> </attributes> </class> <class> <name>GeneralNameSpace</name> <environment>Kernel</environment> <super>Core.KeyedCollection</super> <private>false</private> none organization bindings specificImports generalImports <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class>