--- a/MiniDebugger.st Fri Mar 18 07:45:27 2016 +0000
+++ b/MiniDebugger.st Mon Mar 21 07:50:50 2016 +0000
@@ -15,7 +15,7 @@
Object subclass:#MiniDebugger
instanceVariableNames:'tracing stepping traceBlock command commandArg commandCount
- enteringContext dot nesting'
+ enteringContext dot nesting inputStream'
classVariableNames:'NotFirstTimeEntered'
poolDictionaries:''
category:'System-Debugging-Support'
@@ -58,77 +58,90 @@
"enter a miniDebugger"
^ self
- enter:thisContext sender
- withMessage:'MiniDebugger'
- mayProceed:true
+ enter:thisContext sender
+ withMessage:'MiniDebugger'
+ mayProceed:true
+ input:nil
!
enter:aContext withMessage:aString mayProceed:mayProceed
"enter a miniDebugger"
+ ^ self
+ enter:aContext
+ withMessage:aString
+ mayProceed:mayProceed
+ input:nil
+!
+
+enter:aContext withMessage:aString mayProceed:mayProceed input:inputStreamOrNil
+ "enter a miniDebugger"
+
|active con sender|
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 errorPrintCR.
- Processor notNil ifTrue:[
- active := Processor activeProcess.
- 'process: id=' errorPrint. active id errorPrint.
- ' name=' errorPrint. active name errorPrintCR.
+ aString errorPrintCR.
+ Processor notNil ifTrue:[
+ active := Processor activeProcess.
+ 'process: id=' errorPrint. active id errorPrint.
+ ' name=' errorPrint. active name errorPrintCR.
- '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.
- ].
+ '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.
- OperatingSystem exit:10.
- ] 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
+ inputStream:inputStreamOrNil;
+ enter:aContext mayProceed:mayProceed.
].
mayProceed ifFalse:[
- AbortOperationRequest raise
+ AbortOperationRequest raise
].
^ nil
@@ -142,18 +155,20 @@
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)
+ input:nil
!
enterWithMessage:aString mayProceed:mayProceed
"enter a miniDebugger"
^ self
- enter:thisContext sender
- withMessage:aString
- mayProceed:mayProceed
+ enter:thisContext sender
+ withMessage:aString
+ mayProceed:mayProceed
+ input:nil
"Modified: / 19.5.1999 / 18:14:33 / cg"
!
@@ -180,9 +195,10 @@
"enter a miniDebugger"
^ self
- enter:thisContext sender
- withMessage:'MiniDebugger [info]: Attention - process debugging not possible.'
- mayProceed:true
+ enter:thisContext sender
+ withMessage:'MiniDebugger [info]: Attention - process debugging not possible.'
+ mayProceed:true
+ input:nil
"Modified: / 19.5.1999 / 18:14:33 / cg"
!
@@ -225,6 +241,15 @@
^ nil
! !
+!MiniDebugger methodsFor:'accessing'!
+
+inputStream:aStream
+ "if non-nil, the debugger will read its input from there.
+ This allows for a miniDebugger to be used in a telnet stream (scripting)"
+
+ inputStream := aStream.
+! !
+
!MiniDebugger methodsFor:'entering'!
enter:aContext mayProceed:mayProceed
@@ -392,6 +417,14 @@
]
!
+getCharacter
+ inputStream isNil ifTrue:[
+ "/ globally blocking
+ ^ Character fromUser
+ ].
+ ^ inputStream next
+!
+
getContext
|backtrace|
@@ -611,13 +644,23 @@
(cmd == $b) ifTrue:[
proc notNil ifTrue:[
'-------- VM walkback of process ' errorPrint. id errorPrint. ' -------' errorPrintCR.
- ObjectMemory printStackBacktraceFrom:(proc suspendedContext)
+ (Processor activeProcess environmentAt:#Stderr ifAbsent:Stderr) == Stderr ifTrue:[
+ ObjectMemory printStackBacktraceFrom:(proc suspendedContext)
+ ] ifFalse:[
+ self printBacktraceFrom:(proc suspendedContext)
+ "/ proc suspendedContext fullPrintAllOn:(Processor activeProcess environmentAt:#Stderr)
+ ].
] ifFalse:[
id notNil ifTrue:[
'no process with id: ' errorPrint. id errorPrintCR.
] ifFalse:[
'-------- VM walkback of current process -------' errorPrintCR.
- ObjectMemory printStackBacktrace
+ (Processor activeProcess environmentAt:#Stderr ifAbsent:Stderr) == Stderr ifTrue:[
+ ObjectMemory printStackBacktrace
+ ] ifFalse:[
+ "/ self printBacktraceFrom:(self getContext)
+ thisContext fullPrintAllOn:(Processor activeProcess environmentAt:#Stderr)
+ ]
]
].
^ false
@@ -661,11 +704,14 @@
].
(cmd == $i) ifTrue:[
+ |inspectedObject|
+
(commandArg ? '') withoutSeparators notEmpty ifTrue:[
- MiniInspector openOn:(Parser evaluate:commandArg).
+ inspectedObject := (Parser evaluate:commandArg).
] ifFalse:[
- MiniInspector openOn:(dot receiver).
+ inspectedObject := (dot receiver).
].
+ MiniInspector openOn:inspectedObject input:inputStream.
^ false
].
@@ -815,58 +861,58 @@
"/ ].
Display notNil ifTrue:[
- Display ungrabPointer.
- Display ungrabKeyboard.
+ Display ungrabPointer.
+ Display ungrabKeyboard.
].
(prompt
- ? (nesting == 0 ifTrue:[
- 'MiniDebugger> '
- ] ifFalse:[
- 'MiniDebugger' , nesting printString , '>'
- ])) errorPrint.
+ ? (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:[
- '<EOF>' errorPrintCR.
- "
- mhmh end-of-file;
- return a 'c' (for continue); hope thats ok.
- "
- cmd := $c
- ].
+ cmd := self getCharacter.
+ cmd isNil ifTrue:[
+ '<EOF>' errorPrintCR.
+ "
+ mhmh end-of-file;
+ return a 'c' (for continue); hope thats ok.
+ "
+ cmd := $c
+ ].
- 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
- ].
- cmd isNil ifTrue:[ '<EOF>' errorPrintCR ].
- ].
+ cnt := nil.
+ (cmd isDigit) ifTrue:[
+ cnt := 0.
+ [
+ cnt := (cnt * 10) + cmd digitValue.
+ cmd := self getCharacter
+ ] doWhile:[cmd notNil and:[cmd isDigit]].
+ [cmd notNil and:[cmd == Character space]] whileTrue:[
+ cmd := self getCharacter
+ ].
+ cmd isNil ifTrue:[ '<EOF>' errorPrintCR ].
+ ].
- "
- collect to end-of-line in arg
- "
- c := cmd.
- arg := ''.
- [c isNil or:[c isEndOfLineCharacter]] whileFalse: [
- arg := arg copyWith:c.
- c := Character fromUser.
- c isNil ifTrue:[ '<EOF>' errorPrintCR ].
- ].
- 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 := self getCharacter.
+ c isNil ifTrue:[ '<EOF>' errorPrintCR ].
+ ].
+ commandArg := (arg copyFrom:2) withoutSeparators.
+ command := cmd.
+ commandCount := cnt.
].
^ command
@@ -927,10 +973,10 @@
interpreterLoopWith:anObject
'MinDebugger read-eval-print loop; exit with "#exit"; help with "?"' printCR.
ReadEvalPrintLoop new
- doChunkFormat:false;
- error:Stderr;
- prompt:'mDBG > ';
- readEvalPrintLoop.
+ doChunkFormat:false;
+ error:(Processor activeProcess stderr);
+ prompt:'mDBG > ';
+ readEvalPrintLoop.
"/ |line done rslt|
"/