--- a/MiniDebugger.st Tue Feb 04 21:09:59 2014 +0100
+++ b/MiniDebugger.st Wed Apr 01 10:20:10 2015 +0100
@@ -14,7 +14,7 @@
Object subclass:#MiniDebugger
instanceVariableNames:'tracing stepping traceBlock command commandArg commandCount
enteringContext dot nesting'
- classVariableNames:'TheOneAndOnlyDebugger NotFirstTimeEntered'
+ classVariableNames:'NotFirstTimeEntered'
poolDictionaries:''
category:'System-Debugging-Support'
!
@@ -39,14 +39,14 @@
"
a primitive (non graphical) debugger for use on systems without
graphics or when the real debugger dies (i.e. an error occurs in
- the graphical debugger).
- Also, if an interrupt occurs within the debuger, this one is called
- for.
+ the graphical debugger or the UI/event handler is broken).
+ Also, if an interrupt occurs within the debuger, this one is called for.
+ Needs a console.
MiniDebugger enter
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -55,10 +55,10 @@
enter
"enter a miniDebugger"
- ^ self
- enter:thisContext sender
- withMessage:'MiniDebugger'
- mayProceed:true
+ ^ self
+ enter:thisContext sender
+ withMessage:'MiniDebugger'
+ mayProceed:true
!
enter:aContext withMessage:aString mayProceed:mayProceed
@@ -69,64 +69,64 @@
StepInterruptPending := nil.
Error handle:[:ex |
- ex return
+ ex return
] do:[
- thisContext isRecursive ifTrue:[
- "/ 'recursive error in debugger ignored' errorPrintCR.
- ^ self
- ].
+ thisContext isRecursive ifTrue:[
+ "/ 'recursive error in debugger ignored' errorPrintCR.
+ ^ self
+ ].
- aString printCR.
- Processor notNil ifTrue:[
- active := Processor activeProcess.
- 'process: id=' print. active id print.
- ' name=' print. active name printCR.
+ aString errorPrintCR.
+ Processor notNil ifTrue:[
+ active := Processor activeProcess.
+ 'process: id=' errorPrint. active id errorPrint.
+ ' name=' errorPrint. active name errorPrintCR.
- 'context: ' print. aContext printString printCR.
- (con := aContext) notNil ifTrue:[
- con := con sender.
- ' ......: ' print. con printString printCR.
- [con notNil] whileTrue:[
- sender := con sender.
- (sender notNil and:[sender selector == con selector]) ifTrue:[
- ' ......: ' print. sender printString printCR.
- ' ......: [** intermediate recursive contexts skipped **]' printCR.
- [sender notNil
- and:[sender selector == con selector
- and:[sender method == con method]]] whileTrue:[
- con := sender.
- sender := con sender.
- ].
- ].
- con := sender.
- ' ......: ' print. con printString printCR.
- ]
- ]
- ].
- NotFirstTimeEntered ~~ true ifTrue:[
- NotFirstTimeEntered := true.
- 'Type "c" to proceed, "?" for help' printCR.
- ].
+ 'context: ' errorPrint. aContext printString errorPrintCR.
+ (con := aContext) notNil ifTrue:[
+ con := con sender.
+ ' ......: ' errorPrint. con printString errorPrintCR.
+ [con notNil] whileTrue:[
+ sender := con sender.
+ (sender notNil and:[sender selector == con selector]) ifTrue:[
+ ' ......: ' errorPrint. sender printString errorPrintCR.
+ ' ......: [** intermediate recursive contexts skipped **]' errorPrintCR.
+ [sender notNil
+ and:[sender selector == con selector
+ and:[sender method == con method]]] whileTrue:[
+ con := sender.
+ sender := con sender.
+ ].
+ ].
+ con := sender.
+ ' ......: ' errorPrint. con printString errorPrintCR.
+ ]
+ ]
+ ].
+ NotFirstTimeEntered ~~ true ifTrue:[
+ NotFirstTimeEntered := true.
+ 'Type "c" to proceed, "?" for help' errorPrintCR.
+ ].
].
OperatingSystem hasConsole ifFalse:[
- Error handle:[:ex |
- ex return
- ] do:[
- self warn:('Unexpected error:\' , aString , '\\No MiniDebugger functionality available') withCRs .
- ].
+ Error handle:[:ex |
+ ex return
+ ] do:[
+ self warn:('Unexpected error:\' , aString , '\\No MiniDebugger functionality available') withCRs .
+ ].
- Error handle:[:ex |
- 'cannot raise Abort - exiting ...' errorPrintCR.
- Smalltalk exit.
- ] do:[
- AbortOperationRequest raise.
- ]
+ Error handle:[:ex |
+ 'cannot raise Abort - exiting ...' errorPrintCR.
+ OperatingSystem exit:10.
+ ] do:[
+ AbortOperationRequest raise.
+ ]
] ifTrue:[
- self new enter:aContext mayProceed:mayProceed.
+ self new enter:aContext mayProceed:mayProceed.
].
mayProceed ifFalse:[
- AbortOperationRequest raise
+ AbortOperationRequest raise
].
^ nil
@@ -140,18 +140,18 @@
sent from error- and halt messages."
^ self
- enter:ex returnableSuspendedContext
- withMessage:(ex creator name,': ',ex descriptionForDebugger)
- mayProceed:(ex mayProceed).
+ enter:ex returnableSuspendedContext
+ withMessage:(ex creator name,': ',ex descriptionForDebugger)
+ mayProceed:(ex mayProceed).
!
enterWithMessage:aString mayProceed:mayProceed
"enter a miniDebugger"
- ^ self
- enter:thisContext sender
- withMessage:aString
- mayProceed:mayProceed
+ ^ self
+ enter:thisContext sender
+ withMessage:aString
+ mayProceed:mayProceed
"Modified: / 19.5.1999 / 18:14:33 / cg"
!
@@ -199,7 +199,7 @@
!
trace:aBlock
- self trace:aBlock with:[:where | where printCR]
+ self trace:aBlock with:[:where | where errorPrintCR]
"Modified: 20.5.1996 / 10:27:37 / cg"
!
@@ -234,78 +234,85 @@
nesting := 0.
c := aContext.
[c notNil] whileTrue:[
- c selector == #enter:mayProceed: ifTrue:[
- nesting := nesting + 1.
- ].
- c := c sender.
+ c selector == #enter:mayProceed: ifTrue:[
+ nesting := nesting + 1.
+ ].
+ c := c sender.
].
stillHere := true.
[stillHere] whileTrue:[
- AbortOperationRequest handle:[:ex |
- '** Abort cought - back in previous debugLevel' printCR.
- ] do:[
- Error handle:[:ex |
- 'Error while executing MiniDebugger command: ' print.
- ex description printCR.
- yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug / b(acktrace) ? '.
- yesNo == $d ifTrue:[
- MiniDebugger enterWithMessage:'Debugging debugger' mayProceed:true.
- ex proceed
- ].
- yesNo == $p ifTrue:[
- ex proceed
- ].
- yesNo == $b ifTrue:[
- ex suspendedContext fullPrintAll.
- ex proceed
- ].
- ] do:[
- [
- leaveCmd := self commandLoop.
- ] valueUnpreemptively.
- ].
- ].
+ AbortOperationRequest handle:[:ex |
+ '** Abort caught - back in previous debugLevel' errorPrintCR.
+ ] do:[
+ Error handle:[:ex |
+ StreamError handle:[:ex|
+ "You won't see this probably - but you will see it when doing a syscall trace"
+ 'Error while processing error in MiniDebugger (Stdout closed?):' errorPrintCR.
+ ex description errorPrintCR.
+ OperatingSystem exit:10.
+ ] do:[
+ 'Error while executing MiniDebugger command: ' errorPrint.
+ ex description errorPrintCR.
+ yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug / b(acktrace) ? '.
+ yesNo == $d ifTrue:[
+ MiniDebugger enterWithMessage:'Debugging debugger' mayProceed:true.
+ ex proceed
+ ].
+ yesNo == $p ifTrue:[
+ ex proceed
+ ].
+ yesNo == $b ifTrue:[
+ ex suspendedContext fullPrintAll.
+ ex proceed
+ ].
+ ].
+ ] do:[
+ [
+ leaveCmd := self commandLoop.
+ ] valueUnpreemptively.
+ ].
+ ].
- (leaveCmd == $s) ifTrue: [
- self stepping.
- ObjectMemory flushInlineCaches.
- ObjectMemory stepInterruptHandler:self.
- stillHere := false.
- StepInterruptPending := 1.
- InterruptPending := 1
- ].
- (leaveCmd == $t) ifTrue: [
- traceBlock := [:where | where fullPrint].
- ObjectMemory flushInlineCaches.
- ObjectMemory stepInterruptHandler:self.
- stillHere := false.
- StepInterruptPending := 1.
- InterruptPending := 1
- ].
- (leaveCmd == $c) ifTrue: [
- traceBlock := nil.
- ObjectMemory flushInlineCaches.
- ObjectMemory stepInterruptHandler:nil.
- stillHere := false.
- stepping := false.
- tracing := false.
- StepInterruptPending := nil.
- InterruptPending := nil
- ].
- (leaveCmd == $a) ifTrue: [
- "abort"
- traceBlock := nil.
- ObjectMemory flushInlineCaches.
- ObjectMemory stepInterruptHandler:nil.
- stepping := false.
- tracing := false.
- StepInterruptPending := nil.
- InterruptPending := nil.
- self doAbort.
- stillHere := true.
- "failed abort"
- ].
+ (leaveCmd == $s) ifTrue: [
+ self stepping.
+ ObjectMemory flushInlineCaches.
+ ObjectMemory stepInterruptHandler:self.
+ stillHere := false.
+ StepInterruptPending := 1.
+ InterruptPending := 1
+ ].
+ (leaveCmd == $t) ifTrue: [
+ traceBlock := [:where | where fullPrint].
+ ObjectMemory flushInlineCaches.
+ ObjectMemory stepInterruptHandler:self.
+ stillHere := false.
+ StepInterruptPending := 1.
+ InterruptPending := 1
+ ].
+ (leaveCmd == $c) ifTrue: [
+ traceBlock := nil.
+ ObjectMemory flushInlineCaches.
+ ObjectMemory stepInterruptHandler:nil.
+ stillHere := false.
+ stepping := false.
+ tracing := false.
+ StepInterruptPending := nil.
+ InterruptPending := nil
+ ].
+ (leaveCmd == $a) ifTrue: [
+ "abort"
+ traceBlock := nil.
+ ObjectMemory flushInlineCaches.
+ ObjectMemory stepInterruptHandler:nil.
+ stepping := false.
+ tracing := false.
+ StepInterruptPending := nil.
+ InterruptPending := nil.
+ self doAbort.
+ stillHere := true.
+ "failed abort"
+ ].
].
enteringContext := dot := nil.
^ nil
@@ -320,26 +327,26 @@
where := thisContext. "where is stepInterrupt context"
where notNil ifTrue:[
- where := where sender "where is now interrupted methods context"
+ where := where sender "where is now interrupted methods context"
].
stepping ifTrue:[
- where notNil ifTrue:[
- where fullPrint
- ] ifFalse:[
- 'stepInterrupt: no context' errorPrintCR
- ].
- self enter:where mayProceed:true
+ where notNil ifTrue:[
+ where fullPrint
+ ] ifFalse:[
+ 'stepInterrupt: no context' errorPrintCR
+ ].
+ self enter:where mayProceed:true
] ifFalse:[
- where notNil ifTrue:[
- traceBlock notNil ifTrue:[
- traceBlock value:where
- ]
- ] ifFalse:[
- 'traceInterrupt: no context' errorPrintCR
- ].
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1
+ where notNil ifTrue:[
+ traceBlock notNil ifTrue:[
+ traceBlock value:where
+ ]
+ ] ifFalse:[
+ 'traceInterrupt: no context' errorPrintCR
+ ].
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := 1.
+ InterruptPending := 1
]
"Modified: / 20-05-1996 / 10:23:11 / cg"
@@ -388,13 +395,13 @@
backtrace := thisContext.
(backtrace notNil) ifTrue: [
- [backtrace selector ~~ #commandLoop] whileTrue:[
- backtrace := backtrace sender.
- ].
- "remove Debugger commandLoop frame"
- backtrace := backtrace sender.
- "remove Debugger enter frame"
- backtrace := backtrace sender
+ [backtrace selector ~~ #commandLoop] whileTrue:[
+ backtrace := backtrace sender.
+ ].
+ "remove Debugger commandLoop frame"
+ backtrace := backtrace sender.
+ "remove Debugger enter frame"
+ backtrace := backtrace sender
].
^ backtrace
@@ -407,22 +414,22 @@
c := enteringContext.
[ c notNil and:[ c sender ~~ dot ] ] whileTrue:[
- c := c sender.
+ c := c sender.
].
c notNil ifTrue:[
- dot := c.
- "/ dot fullPrint.
+ dot := c.
+ "/ dot fullPrint.
] ifFalse:[
- '** dot is the bottom of the calling chain' printCR.
+ '** dot is the bottom of the calling chain' errorPrintCR.
].
!
moveDotUp
dot sender notNil ifTrue:[
- dot := dot sender.
- "/ dot fullPrint.
+ dot := dot sender.
+ "/ dot fullPrint.
] ifFalse:[
- '** dot is the top of the calling chain' printCR.
+ '** dot is the top of the calling chain' errorPrintCR.
].
!
@@ -450,15 +457,15 @@
printDot
dot fullPrint.
- ' receiver: ' print. dot receiver printCR.
- ' selector: ' print. dot selector printCR.
- ' args: ' printCR.
+ ' receiver: ' errorPrint. dot receiver errorPrintCR.
+ ' selector: ' errorPrint. dot selector errorPrintCR.
+ ' args: ' errorPrintCR.
dot args keysAndValuesDo:[:idx :eachArg |
- ' ' print. idx print. ': ' print. eachArg printCR.
+ ' ' errorPrint. idx errorPrint. ': ' errorPrint. eachArg errorPrintCR.
].
- ' vars: ' printCR.
+ ' vars: ' errorPrintCR.
dot vars keysAndValuesDo:[:idx :eachVar |
- ' ' print. idx print. ': ' print. eachVar printCR.
+ ' ' errorPrint. idx errorPrint. ': ' errorPrint. eachVar errorPrintCR.
].
!
@@ -472,32 +479,32 @@
home := dot methodHome.
mthd := home method.
mthd isNil ifTrue:[
- '** no source **' printCR.
- ^ self.
+ '** no source **' errorPrintCR.
+ ^ self.
].
src := mthd source.
src isNil ifTrue:[
- '** no source **' printCR.
- ^ self.
+ '** no source **' errorPrintCR.
+ ^ self.
].
pcLineNr := dot lineNumber.
src := src asCollectionOfLines.
full ifTrue:[
- startLnr := 1.
- stopLnr := src size.
+ startLnr := 1.
+ stopLnr := src size.
] ifFalse:[
- startLnr := pcLineNr-10 max:1.
- stopLnr := pcLineNr+10 min:src size.
+ startLnr := pcLineNr-10 max:1.
+ stopLnr := pcLineNr+10 min:src size.
].
startLnr to:stopLnr do:[:lNr |
- lNr == pcLineNr ifTrue:[
- '>> ' print.
- ] ifFalse:[
- ' ' print.
- ].
- (lNr printStringLeftPaddedTo:3) print. ' ' print.
- (src at:lNr) printCR.
+ lNr == pcLineNr ifTrue:[
+ '>> ' errorPrint.
+ ] ifFalse:[
+ ' ' errorPrint.
+ ].
+ (lNr printStringLeftPaddedTo:3) errorPrint. ' ' errorPrint.
+ (src at:lNr) errorPrintCR.
]
!
@@ -516,18 +523,18 @@
!MiniDebugger methodsFor:'user commands'!
commandLoop
- "read-eval commands, until one of the continue, abort or single step commands is entered;
+ "read-eval commands, until one of the continue, abort or single step commands is entered;
return the last command character"
|cmd done|
done := false.
[done] whileFalse:[
- cmd := self getCommand:nil.
- cmd isNil ifTrue:[ "/ EOF is treated like continue command
- cmd := $c
- ].
- done := self doCommand:cmd.
+ cmd := self getCommand:nil.
+ cmd isNil ifTrue:[ "/ EOF is treated like continue command
+ cmd := $c
+ ].
+ done := self doCommand:cmd.
].
^ cmd
@@ -561,112 +568,116 @@
!
doCommand:cmd
- "a single command;
+ "a single command;
return true, if command loop should be finished"
|id proc bool|
commandArg notEmptyOrNil ifTrue:[
- id := Number readFrom:commandArg onError:nil.
- id notNil ifTrue:[
- proc := Process allSubInstances detect:[:p | p id == id] ifNone:nil.
- proc == Processor activeProcess ifTrue:[
- id := proc := nil
- ]
- ] ifFalse:[
- commandArg = '-' ifTrue:[
- bool := false
- ] ifFalse:[
- commandArg = '+' ifTrue:[
- bool := true
- ]
- ]
- ]
+ id := Number readFrom:commandArg onError:nil.
+ id notNil ifTrue:[
+ proc := Process allSubInstances detect:[:p | p id == id] ifNone:nil.
+ proc == Processor activeProcess ifTrue:[
+ id := proc := nil
+ ]
+ ] ifFalse:[
+ commandArg = '-' ifTrue:[
+ bool := false
+ ] ifFalse:[
+ commandArg = '+' ifTrue:[
+ bool := true
+ ]
+ ]
+ ]
].
(cmd == $w) ifTrue:[
- proc notNil ifTrue:[
- '-------- walkback of process ' print. id print. ' -------' printCR.
- self printBacktraceFrom:(proc suspendedContext)
- ] ifFalse:[
- id notNil ifTrue:[
- 'no process with id: ' print. id printCR.
- ] ifFalse:[
- '-------- walkback of current process -------' printCR.
- self printBacktraceFrom:(self getContext)
- ]
- ].
- ^ false
+ proc notNil ifTrue:[
+ '-------- walkback of process ' errorPrint. id errorPrint. ' -------' errorPrintCR.
+ self printBacktraceFrom:(proc suspendedContext)
+ ] ifFalse:[
+ id notNil ifTrue:[
+ 'no process with id: ' errorPrint. id errorPrintCR.
+ ] ifFalse:[
+ '-------- walkback of current process -------' errorPrintCR.
+ self printBacktraceFrom:(self getContext)
+ ]
+ ].
+ ^ false
].
(cmd == $b) ifTrue:[
- proc notNil ifTrue:[
- '-------- VM walkback of process ' print. id print. ' -------' printCR.
- ObjectMemory printStackBacktraceFrom:(proc suspendedContext)
- ] ifFalse:[
- id notNil ifTrue:[
- 'no process with id: ' print. id printCR.
- ] ifFalse:[
- '-------- VM walkback of current process -------' printCR.
- ObjectMemory printStackBacktrace
- ]
- ].
- ^ false
+ proc notNil ifTrue:[
+ '-------- VM walkback of process ' errorPrint. id errorPrint. ' -------' errorPrintCR.
+ ObjectMemory printStackBacktraceFrom:(proc suspendedContext)
+ ] ifFalse:[
+ id notNil ifTrue:[
+ 'no process with id: ' errorPrint. id errorPrintCR.
+ ] ifFalse:[
+ '-------- VM walkback of current process -------' errorPrintCR.
+ ObjectMemory printStackBacktrace
+ ]
+ ].
+ ^ false
].
(cmd == $S) ifTrue:[
- 'saving "crash.img"...' print.
- ObjectMemory writeCrashImage.
- 'done.' printCR.
- ^ false
+ 'saving "crash.img"...' errorPrint.
+ ObjectMemory writeCrashImage.
+ 'done.' errorPrintCR.
+ ^ false
].
(cmd == $C) ifTrue:[
- |changesFilename|
+ |changesFilename|
- changesFilename := Timestamp now
- printStringFormat:'changes_%(year)-%(month)-%(day)__%h:%m:%s.chg'.
- OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ].
+ changesFilename := Timestamp now
+ printStringFormat:'changes_%(year)-%(month)-%(day)__%h:%m:%s.chg'.
+ OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ].
- ChangeSet current fileOutAs: changesFilename.
- ('saved session changes to "',changesFilename,'".') printCR.
- ^ false
+ ChangeSet current fileOutAs: changesFilename.
+ ('saved session changes to "',changesFilename,'".') errorPrintCR.
+ ^ false
].
(cmd == $B) ifTrue:[
- self printAllBacktraces.
- ^ false
+ self printAllBacktraces.
+ ^ false
].
(cmd == $P) ifTrue:[
- self showProcesses:#all.
- ^ false
+ self showProcesses:#all.
+ ^ false
].
(cmd == $p) ifTrue:[
- self showProcesses:#live.
- ^ false
+ self showProcesses:#live.
+ ^ false
].
(cmd == $r) ifTrue:[
- dot receiver printCR.
- ^ false
+ dot receiver errorPrintCR.
+ ^ false
].
(cmd == $i) ifTrue:[
- MiniInspector openOn:(dot receiver).
- ^ false
+ (commandArg ? '') withoutSeparators notEmpty ifTrue:[
+ MiniInspector openOn:(Parser evaluate:commandArg).
+ ] ifFalse:[
+ MiniInspector openOn:(dot receiver).
+ ].
+ ^ false
].
(cmd == $I) ifTrue:[
- self interpreterLoopWith:nil.
- ^ false
+ self interpreterLoopWith:nil.
+ ^ false
].
(cmd == $E) ifTrue:[
- Parser evaluate:commandArg.
- ^ false
+ Parser evaluate:commandArg.
+ ^ false
].
(cmd == $e) ifTrue:[
- (Parser evaluate:commandArg) printCR.
- ^ false
+ (Parser evaluate:commandArg) errorPrintCR.
+ ^ false
].
(cmd == $c) ifTrue:[^ true].
@@ -675,92 +686,96 @@
(cmd == $a) ifTrue:[^ true].
(cmd == $u) ifTrue:[
- stepping := false.
- tracing := false.
- Processor activeProcess vmTrace:false.
- ^ false
+ stepping := false.
+ tracing := false.
+ Processor activeProcess vmTrace:false.
+ ^ false
].
(cmd == $h) ifTrue:[
- (bool notNil) ifTrue:[
- Smalltalk ignoreHalt:bool not.
- ].
- 'halts are ' print. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) printCR.
- ^ false
+ (bool notNil) ifTrue:[
+ Smalltalk ignoreHalt:bool not.
+ ].
+ 'halts are ' errorPrint. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) errorPrintCR.
+ ^ false
].
(cmd == $R) ifTrue:[
- proc notNil ifTrue:[
- proc resume.
- ].
- ^ false
+ proc notNil ifTrue:[
+ proc resume.
+ ].
+ ^ false
].
(cmd == $T) ifTrue:[
- proc notNil ifTrue:[
- proc terminate.
- ] ifFalse:[
- id notNil ifTrue:[
- 'no process with id: ' print. id printCR.
- ] ifFalse:[
- Processor terminateActive
- ]
- ].
- ^ false
+ proc notNil ifTrue:[
+ proc terminate.
+ ] ifFalse:[
+ id notNil ifTrue:[
+ 'no process with id: ' errorPrint. id errorPrintCR.
+ ] ifFalse:[
+ Processor terminateActive
+ ]
+ ].
+ ^ false
].
(cmd == $W) ifTrue:[
- proc notNil ifTrue:[
- 'stopping process id: ' print. id printCR.
- proc stop.
- ] ifFalse:[
- 'invalid process id: ' print. id printCR.
- ].
- ^ false
+ proc notNil ifTrue:[
+ 'stopping process id: ' errorPrint. id errorPrintCR.
+ proc stop.
+ ] ifFalse:[
+ 'invalid process id: ' errorPrint. id errorPrintCR.
+ ].
+ ^ false
].
(cmd == $a) ifTrue:[
- "without id-arg, this is handled by caller"
- proc notNil ifTrue:[
- 'aborting process id: ' print. id printCR.
- proc interruptWith:[AbortOperationRequest raise]
- ] ifFalse:[
- 'aborting' printCR.
- ].
- ^ false
+ "without id-arg, this is handled by caller"
+ proc notNil ifTrue:[
+ 'aborting process id: ' errorPrint. id errorPrintCR.
+ proc interruptWith:[AbortOperationRequest raise]
+ ] ifFalse:[
+ 'aborting' errorPrintCR.
+ ].
+ ^ false
].
(cmd == $Q) ifTrue:[
- proc notNil ifTrue:[
- proc terminateNoSignal.
- ] ifFalse:[
- id notNil ifTrue:[
- 'no process with id: ' print. id printCR.
- ] ifFalse:[
- Processor terminateActiveNoSignal
- ]
- ].
- ^ false
+ proc notNil ifTrue:[
+ proc terminateNoSignal.
+ ] ifFalse:[
+ id notNil ifTrue:[
+ 'no process with id: ' errorPrint. id errorPrintCR.
+ ] ifFalse:[
+ Processor terminateActiveNoSignal
+ ]
+ ].
+ ^ false
].
(cmd == $g) ifTrue:[
- self garbageCollectCommand:id.
- ^ false
+ self garbageCollectCommand:id.
+ ^ false
].
(cmd == $U) ifTrue:[
- MessageTracer unwrapAllMethods.
- ^ false
+ MessageTracer unwrapAllMethods.
+ ^ false
+ ].
+ (cmd == $D) ifTrue:[
+ Breakpoint disableAllBreakpoints.
+ ^ false
].
(cmd == $X) ifTrue:[
- Smalltalk fatalAbort.
- "/ not reached
- ^ false
+ Smalltalk fatalAbort.
+ "/ not reached
+ ^ false
].
(cmd == $x) ifTrue:[
- OperatingSystem exit.
- "/ not reached
- ^ false
+ OperatingSystem exit.
+ "/ not reached
+ ^ false
].
(cmd == $.) ifTrue:[self printDot. ^ false ].
@@ -769,9 +784,9 @@
(cmd == $-) ifTrue:[self moveDotUp. self printDot. ^ false ].
(cmd == $+) ifTrue:[self moveDotDown. self printDot. ^ false ].
(cmd == $?) ifTrue:[
- commandArg notEmpty ifTrue:[
- self helpOn:commandArg. ^ false
- ]
+ commandArg notEmpty ifTrue:[
+ self helpOn:commandArg. ^ false
+ ]
].
"/ avoid usage print if return was typed ...
@@ -793,55 +808,55 @@
"/ ].
Display notNil ifTrue:[
- Display ungrabPointer.
- Display ungrabKeyboard.
+ Display ungrabPointer.
+ Display ungrabKeyboard.
].
(prompt
- ? (nesting == 0 ifTrue:[
- 'MiniDebugger> '
- ] ifFalse:[
- 'MiniDebugger' , nesting printString , '>'
- ])) print.
+ ? (nesting == 0 ifTrue:[
+ 'MiniDebugger> '
+ ] ifFalse:[
+ 'MiniDebugger' , nesting printString , '>'
+ ])) errorPrint.
UserInterrupt handle:[:ex |
- ex restart
+ ex restart
] do:[
- |c cmd arg cnt|
+ |c cmd arg cnt|
- cmd := Character fromUser.
- cmd isNil ifTrue:[
- "
- mhmh end-of-file;
- return a 'c' (for continue); hope thats ok.
- "
- cmd := $c
- ].
+ cmd := Character fromUser.
+ cmd isNil ifTrue:[
+ "
+ mhmh end-of-file;
+ return a 'c' (for continue); hope thats ok.
+ "
+ cmd := $c
+ ].
- cnt := nil.
- (cmd isDigit) ifTrue:[
- cnt := 0.
- [cmd isDigit] whileTrue:[
- cnt := (cnt * 10) + cmd digitValue.
- cmd := Character fromUser
- ].
- [cmd == Character space] whileTrue:[
- cmd := Character fromUser
- ].
- ].
+ cnt := nil.
+ (cmd isDigit) ifTrue:[
+ cnt := 0.
+ [
+ cnt := (cnt * 10) + cmd digitValue.
+ cmd := Character fromUser
+ ] doWhile:[cmd notNil and:[cmd isDigit]].
+ [cmd notNil and:[cmd == Character space]] whileTrue:[
+ cmd := Character fromUser
+ ].
+ ].
- "
- collect to end-of-line in arg
- "
- c := cmd.
- arg := ''.
- [c isNil or:[c isEndOfLineCharacter]] whileFalse: [
- arg := arg copyWith:c.
- c := Character fromUser.
- ].
- commandArg := (arg copyFrom:2) withoutSeparators.
- command := cmd.
- commandCount := cnt.
+ "
+ collect to end-of-line in arg
+ "
+ c := cmd.
+ arg := ''.
+ [c isNil or:[c isEndOfLineCharacter]] whileFalse: [
+ arg := arg copyWith:c.
+ c := Character fromUser.
+ ].
+ commandArg := (arg copyFrom:2) withoutSeparators.
+ command := cmd.
+ commandCount := cnt.
].
^ command
@@ -852,56 +867,60 @@
|args className sym val match showMethod|
commandArg withoutSeparators isEmpty ifTrue:[
- 'usage: H className [methodPattern]' printCR.
- ^self
+ 'usage: H className [methodPattern]' errorPrintCR.
+ ^self
].
args := commandArg asCollectionOfWords.
className := args first.
-
+
(sym := className asSymbolIfInterned) isNil ifTrue:[
- 'no such class' printCR.
- ^ self.
+ 'no such class' errorPrintCR.
+ ^ self.
].
- val := Smalltalk at:sym ifAbsent:['no such class' printCR. ^ self.].
+ val := Smalltalk at:sym ifAbsent:['no such class' errorPrintCR. ^ self.].
val isBehavior ifFalse:[
- 'not a class: ' print. className printCR.
- val := val class.
- 'showing help for ' print. val name printCR.
+ 'not a class: ' errorPrint. className errorPrintCR.
+ val := val class.
+ 'showing help for ' errorPrint. val name errorPrintCR.
].
args size > 1 ifTrue:[
- match := args at:2
+ match := args at:2
] ifFalse:[
- match := '*'
+ match := '*'
].
- showMethod :=
- [:sel :cls |
- |mthd|
+ showMethod :=
+ [:sel :cls |
+ |mthd|
- ((match includesMatchCharacters and:[ sel matches:match caseSensitive:false])
- or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[
- mthd := cls compiledMethodAt:sel.
- mthd category ~= 'documentation' ifTrue:[
- sel printCR.
- (mthd comment ? '') asStringCollection do:[:l |
- ' ' print. l withoutSeparators printCR.
- ].
- '' printCR
- ].
- ].
- ].
+ ((match includesMatchCharacters and:[ sel matches:match caseSensitive:false])
+ or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[
+ mthd := cls compiledMethodAt:sel.
+ mthd category ~= 'documentation' ifTrue:[
+ sel errorPrintCR.
+ (mthd comment ? '') asStringCollection do:[:l |
+ ' ' errorPrint. l withoutSeparators errorPrintCR.
+ ].
+ '' errorPrintCR
+ ].
+ ].
+ ].
val theMetaclass selectors copy sort do:[:sel |
- showMethod value:sel value:val theMetaclass
+ showMethod value:sel value:val theMetaclass
].
val theNonMetaclass selectors copy sort do:[:sel |
- showMethod value:sel value:val theNonMetaclass
+ showMethod value:sel value:val theNonMetaclass
].
!
interpreterLoopWith:anObject
- 'read-eval-print loop; exit with "#exit"; help with "?"' printCR.
- (ReadEvalPrintLoop new doChunkFormat:false; error:Stderr; prompt:'> ')readEvalPrintLoop.
+ 'MinDebugger read-eval-print loop; exit with "#exit"; help with "?"' printCR.
+ ReadEvalPrintLoop new
+ doChunkFormat:false;
+ error:Stderr;
+ prompt:'mDBG > ';
+ readEvalPrintLoop.
"/ |line done rslt|
"/
@@ -935,18 +954,18 @@
printAllBacktraces
Process allInstancesDo:[:p |
- (p isActive not
- and:[p isDead not]) ifTrue:[
- '---------------------------------------------------------' printCR.
- ' proc id=' print. p id print.
- ' name=''' print. p name print.
- ''' createdBy: ' print. p creatorId print.
- ' state=' print. p state print.
- ' prio=' print. p priority printCR.
- '' printCR. '' printCR.
+ (p isActive not
+ and:[p isDead not]) ifTrue:[
+ '---------------------------------------------------------' errorPrintCR.
+ ' proc id=' errorPrint. p id errorPrint.
+ ' name=''' errorPrint. p name errorPrint.
+ ''' createdBy: ' errorPrint. p creatorId errorPrint.
+ ' state=' errorPrint. p state errorPrint.
+ ' prio=' errorPrint. p priority errorPrintCR.
+ '' errorPrintCR. '' errorPrintCR.
- self printBacktraceFrom:(p suspendedContext)
- ]
+ self printBacktraceFrom:(p suspendedContext)
+ ]
]
!
@@ -958,63 +977,67 @@
|active|
active := Processor activeProcess.
- 'current id=' print. active id print. ' name=''' print. active name print. '''' printCR.
+ 'current id=' errorPrint. active id errorPrint. ' name=''' errorPrint. active name errorPrint. '''' errorPrintCR.
- Process allSubInstancesDo:[:p |
- |doShow|
+ (Process allSubInstances sort:[:a :b | (a id ? -1)<(b id ? -1)]) do:[:p |
+ |doShow|
- doShow := (how == #all).
- doShow := doShow or:[ (how == #dead) and:[ p isDead ]].
- doShow := doShow or:[ (how ~~ #dead) and:[ p isDead not ]].
- doShow ifTrue:[
- 'proc id=' print. (p id printStringPaddedTo:5) print.
- (p state printStringPaddedTo:10) print.
- ' pri=' print. (p priority printStringPaddedTo:2) print.
- ' creator:' print. (p creatorId printStringPaddedTo:5) print.
- ' name=''' print. p name print.
- '''' printCR.
- ]
+ doShow := (how == #all).
+ doShow := doShow or:[ (how == #dead) and:[ p isDead ]].
+ doShow := doShow or:[ (how ~~ #dead) and:[ p isDead not ]].
+ doShow ifTrue:[
+ 'proc id=' errorPrint. (p id printStringPaddedTo:6) errorPrint.
+ (p state printStringPaddedTo:10) errorPrint.
+ ' pri=' errorPrint. (p priority printStringPaddedTo:2) errorPrint.
+ ' creator:' errorPrint. (p creatorId printStringPaddedTo:5) errorPrint.
+ ' group:' errorPrint. (p processGroupId printStringPaddedTo:5) errorPrint.
+ ' sys:' errorPrint. (p isSystemProcess ifTrue:'y' ifFalse:'n') errorPrint.
+ ' ui:' errorPrint. (p isGUIProcess ifTrue:'y' ifFalse:'n') errorPrint.
+ ' name=''' errorPrint. p name errorPrint.
+ '''' errorPrintCR.
+ ]
]
"Modified: / 31.7.1998 / 16:30:19 / cg"
!
showValidCommandHelp
- 'valid commands:
- c ...... continue
- s ...... step
- t ...... trace (continue with trace)
- a [id] abort (i.e. raise abort signal) in (current) process
- T [id] terminate (current) process
- W [id] stop (current) process
- R [id] resume (current) process
- Q [id] quick terminate (current) process - no unwinds or cleanup
+ 'valid commands:
+ c ........ continue
+ s ........ step
+ t ........ trace (continue with trace)
+ a [id] ... abort (i.e. raise abort signal) in (current) process
+ T [id] ... terminate (current) process
+ W [id] ... stop (current) process
+ R [id] ... resume (current) process
+ Q [id] ... quick terminate (current) process - no unwinds or cleanup
- p ...... list processes ("P" for full list)
- w [id] walkback (of process with id)
- b [id] full (VM) backtrace (more detail)
- B ...... backtrace of all other processes
+ p ........ list processes ("P" for full list)
+ w [id] ... walkback (of current/process with id)
+ b [id] ... full (VM) backtrace with more detail
+ B ........ backtrace of all other processes
- U ...... unwrap all traced/breakpointed methods
- h [-/+] disable/enable halts
- g ...... collect all garbage
- g 2 .... collect all garbage & reclaim symbols
- g 3 .... collect all garbage, reclaim symbols and compress
+ U ........ unwrap all traced/breakpointed methods
+ D ........ disable all line breakpoints
+ h [-/+] .. disable/enable halts
+ g ........ collect all garbage
+ g 2 ...... collect all garbage & reclaim symbols
+ g 3 ...... collect all garbage, reclaim symbols and compress
- S ...... save snapshot into "crash.img"
- C ...... save session changes to a separate change file
- x ...... exit Smalltalk ("X" to exit with core dump)
+ S ........ save snapshot into "crash.img"
+ C ........ save session changes to a separate change file
+ x ........ exit Smalltalk ("X" to exit with core dump)
- . ...... print dot (the current context)
- - ...... move dot up (sender)
- + ...... move dot down (called context)
- l ...... list dot''s method source around PC ("L" for full list)
+ . ........ print dot (the current context)
+ - ........ move dot up (sender)
+ + ........ move dot down (called context)
+ l ........ list dot''s method source around PC ("L" for full list)
- r ...... receiver (in dot) printString
- i ...... inspect receiver (in dot)
- I ...... interpreter (expression evaluator)
- e expr evaluate expression & print result ("E" to not print)
- ? c [p] help on class c (selectors matching p)
+ r ........ receiver (in dot) printString
+ i [expr] . inspect expression (or receiver in dot)
+ I ........ interpreter (expression evaluator)
+ e expr ... evaluate expression & print result ("E" to not print)
+ ? c [p] .. help on class c (selectors matching p)
' errorPrintCR.
(XWorkstation notNil and:[ Screen default isKindOf:XWorkstation ]) ifTrue:[
@@ -1023,21 +1046,21 @@
Display initializeFor:''localhost:0''.
Display startDispatch.
NewLauncher openOnDevice:Display.
- <empty line>
+ #exit
then enter "c" to continue; a NewLauncher should pop up soon.
' errorPrintCR
]
- "Modified: / 06-12-2013 / 16:41:39 / cg"
+ "Modified: / 03-02-2014 / 10:38:36 / cg"
! !
!MiniDebugger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.92 2013-12-06 18:31:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.103 2014-06-25 07:43:51 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.92 2013-12-06 18:31:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.103 2014-06-25 07:43:51 stefan Exp $'
! !