37 |
37 |
38 documentation |
38 documentation |
39 " |
39 " |
40 a primitive (non graphical) debugger for use on systems without |
40 a primitive (non graphical) debugger for use on systems without |
41 graphics or when the real debugger dies (i.e. an error occurs in |
41 graphics or when the real debugger dies (i.e. an error occurs in |
42 the graphical debugger). |
42 the graphical debugger or the UI/event handler is broken). |
43 Also, if an interrupt occurs within the debuger, this one is called |
43 Also, if an interrupt occurs within the debuger, this one is called for. |
44 for. |
44 Needs a console. |
45 |
45 |
46 MiniDebugger enter |
46 MiniDebugger enter |
47 |
47 |
48 [author:] |
48 [author:] |
49 Claus Gittinger |
49 Claus Gittinger |
50 " |
50 " |
51 ! ! |
51 ! ! |
52 |
52 |
53 !MiniDebugger class methodsFor:'instance creation'! |
53 !MiniDebugger class methodsFor:'instance creation'! |
54 |
54 |
55 enter |
55 enter |
56 "enter a miniDebugger" |
56 "enter a miniDebugger" |
57 |
57 |
58 ^ self |
58 ^ self |
59 enter:thisContext sender |
59 enter:thisContext sender |
60 withMessage:'MiniDebugger' |
60 withMessage:'MiniDebugger' |
61 mayProceed:true |
61 mayProceed:true |
62 ! |
62 ! |
63 |
63 |
64 enter:aContext withMessage:aString mayProceed:mayProceed |
64 enter:aContext withMessage:aString mayProceed:mayProceed |
65 "enter a miniDebugger" |
65 "enter a miniDebugger" |
66 |
66 |
67 |active con sender| |
67 |active con sender| |
68 |
68 |
69 StepInterruptPending := nil. |
69 StepInterruptPending := nil. |
70 |
70 |
71 Error handle:[:ex | |
71 Error handle:[:ex | |
72 ex return |
72 ex return |
73 ] do:[ |
73 ] do:[ |
74 thisContext isRecursive ifTrue:[ |
74 thisContext isRecursive ifTrue:[ |
75 "/ 'recursive error in debugger ignored' errorPrintCR. |
75 "/ 'recursive error in debugger ignored' errorPrintCR. |
76 ^ self |
76 ^ self |
77 ]. |
77 ]. |
78 |
78 |
79 aString printCR. |
79 aString errorPrintCR. |
80 Processor notNil ifTrue:[ |
80 Processor notNil ifTrue:[ |
81 active := Processor activeProcess. |
81 active := Processor activeProcess. |
82 'process: id=' print. active id print. |
82 'process: id=' errorPrint. active id errorPrint. |
83 ' name=' print. active name printCR. |
83 ' name=' errorPrint. active name errorPrintCR. |
84 |
84 |
85 'context: ' print. aContext printString printCR. |
85 'context: ' errorPrint. aContext printString errorPrintCR. |
86 (con := aContext) notNil ifTrue:[ |
86 (con := aContext) notNil ifTrue:[ |
87 con := con sender. |
87 con := con sender. |
88 ' ......: ' print. con printString printCR. |
88 ' ......: ' errorPrint. con printString errorPrintCR. |
89 [con notNil] whileTrue:[ |
89 [con notNil] whileTrue:[ |
90 sender := con sender. |
90 sender := con sender. |
91 (sender notNil and:[sender selector == con selector]) ifTrue:[ |
91 (sender notNil and:[sender selector == con selector]) ifTrue:[ |
92 ' ......: ' print. sender printString printCR. |
92 ' ......: ' errorPrint. sender printString errorPrintCR. |
93 ' ......: [** intermediate recursive contexts skipped **]' printCR. |
93 ' ......: [** intermediate recursive contexts skipped **]' errorPrintCR. |
94 [sender notNil |
94 [sender notNil |
95 and:[sender selector == con selector |
95 and:[sender selector == con selector |
96 and:[sender method == con method]]] whileTrue:[ |
96 and:[sender method == con method]]] whileTrue:[ |
97 con := sender. |
97 con := sender. |
98 sender := con sender. |
98 sender := con sender. |
99 ]. |
99 ]. |
100 ]. |
100 ]. |
101 con := sender. |
101 con := sender. |
102 ' ......: ' print. con printString printCR. |
102 ' ......: ' errorPrint. con printString errorPrintCR. |
103 ] |
103 ] |
104 ] |
104 ] |
105 ]. |
105 ]. |
106 NotFirstTimeEntered ~~ true ifTrue:[ |
106 NotFirstTimeEntered ~~ true ifTrue:[ |
107 NotFirstTimeEntered := true. |
107 NotFirstTimeEntered := true. |
108 'Type "c" to proceed, "?" for help' printCR. |
108 'Type "c" to proceed, "?" for help' errorPrintCR. |
109 ]. |
109 ]. |
110 ]. |
110 ]. |
111 |
111 |
112 OperatingSystem hasConsole ifFalse:[ |
112 OperatingSystem hasConsole ifFalse:[ |
113 Error handle:[:ex | |
113 Error handle:[:ex | |
114 ex return |
114 ex return |
115 ] do:[ |
115 ] do:[ |
116 self warn:('Unexpected error:\' , aString , '\\No MiniDebugger functionality available') withCRs . |
116 self warn:('Unexpected error:\' , aString , '\\No MiniDebugger functionality available') withCRs . |
117 ]. |
117 ]. |
118 |
118 |
119 Error handle:[:ex | |
119 Error handle:[:ex | |
120 'cannot raise Abort - exiting ...' errorPrintCR. |
120 'cannot raise Abort - exiting ...' errorPrintCR. |
121 Smalltalk exit. |
121 OperatingSystem exit:10. |
122 ] do:[ |
122 ] do:[ |
123 AbortOperationRequest raise. |
123 AbortOperationRequest raise. |
124 ] |
124 ] |
125 ] ifTrue:[ |
125 ] ifTrue:[ |
126 self new enter:aContext mayProceed:mayProceed. |
126 self new enter:aContext mayProceed:mayProceed. |
127 ]. |
127 ]. |
128 mayProceed ifFalse:[ |
128 mayProceed ifFalse:[ |
129 AbortOperationRequest raise |
129 AbortOperationRequest raise |
130 ]. |
130 ]. |
131 ^ nil |
131 ^ nil |
132 |
132 |
133 "Modified: / 19.5.1999 / 18:14:33 / cg" |
133 "Modified: / 19.5.1999 / 18:14:33 / cg" |
134 ! |
134 ! |
232 |
232 |
233 enteringContext := dot := aContext. |
233 enteringContext := dot := aContext. |
234 nesting := 0. |
234 nesting := 0. |
235 c := aContext. |
235 c := aContext. |
236 [c notNil] whileTrue:[ |
236 [c notNil] whileTrue:[ |
237 c selector == #enter:mayProceed: ifTrue:[ |
237 c selector == #enter:mayProceed: ifTrue:[ |
238 nesting := nesting + 1. |
238 nesting := nesting + 1. |
239 ]. |
239 ]. |
240 c := c sender. |
240 c := c sender. |
241 ]. |
241 ]. |
242 |
242 |
243 stillHere := true. |
243 stillHere := true. |
244 [stillHere] whileTrue:[ |
244 [stillHere] whileTrue:[ |
245 AbortOperationRequest handle:[:ex | |
245 AbortOperationRequest handle:[:ex | |
246 '** Abort cought - back in previous debugLevel' printCR. |
246 '** Abort caught - back in previous debugLevel' errorPrintCR. |
247 ] do:[ |
247 ] do:[ |
248 Error handle:[:ex | |
248 Error handle:[:ex | |
249 'Error while executing MiniDebugger command: ' print. |
249 StreamError handle:[:ex| |
250 ex description printCR. |
250 "You won't see this probably - but you will see it when doing a syscall trace" |
251 yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug / b(acktrace) ? '. |
251 'Error while processing error in MiniDebugger (Stdout closed?):' errorPrintCR. |
252 yesNo == $d ifTrue:[ |
252 ex description errorPrintCR. |
253 MiniDebugger enterWithMessage:'Debugging debugger' mayProceed:true. |
253 OperatingSystem exit:10. |
254 ex proceed |
254 ] do:[ |
255 ]. |
255 'Error while executing MiniDebugger command: ' errorPrint. |
256 yesNo == $p ifTrue:[ |
256 ex description errorPrintCR. |
257 ex proceed |
257 yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug / b(acktrace) ? '. |
258 ]. |
258 yesNo == $d ifTrue:[ |
259 yesNo == $b ifTrue:[ |
259 MiniDebugger enterWithMessage:'Debugging debugger' mayProceed:true. |
260 ex suspendedContext fullPrintAll. |
260 ex proceed |
261 ex proceed |
261 ]. |
262 ]. |
262 yesNo == $p ifTrue:[ |
263 ] do:[ |
263 ex proceed |
264 [ |
264 ]. |
265 leaveCmd := self commandLoop. |
265 yesNo == $b ifTrue:[ |
266 ] valueUnpreemptively. |
266 ex suspendedContext fullPrintAll. |
267 ]. |
267 ex proceed |
268 ]. |
268 ]. |
269 |
269 ]. |
270 (leaveCmd == $s) ifTrue: [ |
270 ] do:[ |
271 self stepping. |
271 [ |
272 ObjectMemory flushInlineCaches. |
272 leaveCmd := self commandLoop. |
273 ObjectMemory stepInterruptHandler:self. |
273 ] valueUnpreemptively. |
274 stillHere := false. |
274 ]. |
275 StepInterruptPending := 1. |
275 ]. |
276 InterruptPending := 1 |
276 |
277 ]. |
277 (leaveCmd == $s) ifTrue: [ |
278 (leaveCmd == $t) ifTrue: [ |
278 self stepping. |
279 traceBlock := [:where | where fullPrint]. |
279 ObjectMemory flushInlineCaches. |
280 ObjectMemory flushInlineCaches. |
280 ObjectMemory stepInterruptHandler:self. |
281 ObjectMemory stepInterruptHandler:self. |
281 stillHere := false. |
282 stillHere := false. |
282 StepInterruptPending := 1. |
283 StepInterruptPending := 1. |
283 InterruptPending := 1 |
284 InterruptPending := 1 |
284 ]. |
285 ]. |
285 (leaveCmd == $t) ifTrue: [ |
286 (leaveCmd == $c) ifTrue: [ |
286 traceBlock := [:where | where fullPrint]. |
287 traceBlock := nil. |
287 ObjectMemory flushInlineCaches. |
288 ObjectMemory flushInlineCaches. |
288 ObjectMemory stepInterruptHandler:self. |
289 ObjectMemory stepInterruptHandler:nil. |
289 stillHere := false. |
290 stillHere := false. |
290 StepInterruptPending := 1. |
291 stepping := false. |
291 InterruptPending := 1 |
292 tracing := false. |
292 ]. |
293 StepInterruptPending := nil. |
293 (leaveCmd == $c) ifTrue: [ |
294 InterruptPending := nil |
294 traceBlock := nil. |
295 ]. |
295 ObjectMemory flushInlineCaches. |
296 (leaveCmd == $a) ifTrue: [ |
296 ObjectMemory stepInterruptHandler:nil. |
297 "abort" |
297 stillHere := false. |
298 traceBlock := nil. |
298 stepping := false. |
299 ObjectMemory flushInlineCaches. |
299 tracing := false. |
300 ObjectMemory stepInterruptHandler:nil. |
300 StepInterruptPending := nil. |
301 stepping := false. |
301 InterruptPending := nil |
302 tracing := false. |
302 ]. |
303 StepInterruptPending := nil. |
303 (leaveCmd == $a) ifTrue: [ |
304 InterruptPending := nil. |
304 "abort" |
305 self doAbort. |
305 traceBlock := nil. |
306 stillHere := true. |
306 ObjectMemory flushInlineCaches. |
307 "failed abort" |
307 ObjectMemory stepInterruptHandler:nil. |
308 ]. |
308 stepping := false. |
|
309 tracing := false. |
|
310 StepInterruptPending := nil. |
|
311 InterruptPending := nil. |
|
312 self doAbort. |
|
313 stillHere := true. |
|
314 "failed abort" |
|
315 ]. |
309 ]. |
316 ]. |
310 enteringContext := dot := nil. |
317 enteringContext := dot := nil. |
311 ^ nil |
318 ^ nil |
312 |
319 |
313 "Modified (comment): / 29-09-2011 / 09:05:57 / cg" |
320 "Modified (comment): / 29-09-2011 / 09:05:57 / cg" |
318 |
325 |
319 |where| |
326 |where| |
320 |
327 |
321 where := thisContext. "where is stepInterrupt context" |
328 where := thisContext. "where is stepInterrupt context" |
322 where notNil ifTrue:[ |
329 where notNil ifTrue:[ |
323 where := where sender "where is now interrupted methods context" |
330 where := where sender "where is now interrupted methods context" |
324 ]. |
331 ]. |
325 stepping ifTrue:[ |
332 stepping ifTrue:[ |
326 where notNil ifTrue:[ |
333 where notNil ifTrue:[ |
327 where fullPrint |
334 where fullPrint |
328 ] ifFalse:[ |
335 ] ifFalse:[ |
329 'stepInterrupt: no context' errorPrintCR |
336 'stepInterrupt: no context' errorPrintCR |
330 ]. |
337 ]. |
331 self enter:where mayProceed:true |
338 self enter:where mayProceed:true |
332 ] ifFalse:[ |
339 ] ifFalse:[ |
333 where notNil ifTrue:[ |
340 where notNil ifTrue:[ |
334 traceBlock notNil ifTrue:[ |
341 traceBlock notNil ifTrue:[ |
335 traceBlock value:where |
342 traceBlock value:where |
336 ] |
343 ] |
337 ] ifFalse:[ |
344 ] ifFalse:[ |
338 'traceInterrupt: no context' errorPrintCR |
345 'traceInterrupt: no context' errorPrintCR |
339 ]. |
346 ]. |
340 ObjectMemory flushInlineCaches. |
347 ObjectMemory flushInlineCaches. |
341 StepInterruptPending := 1. |
348 StepInterruptPending := 1. |
342 InterruptPending := 1 |
349 InterruptPending := 1 |
343 ] |
350 ] |
344 |
351 |
345 "Modified: / 20-05-1996 / 10:23:11 / cg" |
352 "Modified: / 20-05-1996 / 10:23:11 / cg" |
346 "Modified (comment): / 29-09-2011 / 09:06:29 / cg" |
353 "Modified (comment): / 29-09-2011 / 09:06:29 / cg" |
347 ! ! |
354 ! ! |
559 |
566 |
560 "Modified: / 16.11.2001 / 17:39:14 / cg" |
567 "Modified: / 16.11.2001 / 17:39:14 / cg" |
561 ! |
568 ! |
562 |
569 |
563 doCommand:cmd |
570 doCommand:cmd |
564 "a single command; |
571 "a single command; |
565 return true, if command loop should be finished" |
572 return true, if command loop should be finished" |
566 |
573 |
567 |id proc bool| |
574 |id proc bool| |
568 |
575 |
569 commandArg notEmptyOrNil ifTrue:[ |
576 commandArg notEmptyOrNil ifTrue:[ |
570 id := Number readFrom:commandArg onError:nil. |
577 id := Number readFrom:commandArg onError:nil. |
571 id notNil ifTrue:[ |
578 id notNil ifTrue:[ |
572 proc := Process allSubInstances detect:[:p | p id == id] ifNone:nil. |
579 proc := Process allSubInstances detect:[:p | p id == id] ifNone:nil. |
573 proc == Processor activeProcess ifTrue:[ |
580 proc == Processor activeProcess ifTrue:[ |
574 id := proc := nil |
581 id := proc := nil |
575 ] |
582 ] |
576 ] ifFalse:[ |
583 ] ifFalse:[ |
577 commandArg = '-' ifTrue:[ |
584 commandArg = '-' ifTrue:[ |
578 bool := false |
585 bool := false |
579 ] ifFalse:[ |
586 ] ifFalse:[ |
580 commandArg = '+' ifTrue:[ |
587 commandArg = '+' ifTrue:[ |
581 bool := true |
588 bool := true |
582 ] |
589 ] |
583 ] |
590 ] |
584 ] |
591 ] |
585 ]. |
592 ]. |
586 |
593 |
587 (cmd == $w) ifTrue:[ |
594 (cmd == $w) ifTrue:[ |
588 proc notNil ifTrue:[ |
595 proc notNil ifTrue:[ |
589 '-------- walkback of process ' print. id print. ' -------' printCR. |
596 '-------- walkback of process ' errorPrint. id errorPrint. ' -------' errorPrintCR. |
590 self printBacktraceFrom:(proc suspendedContext) |
597 self printBacktraceFrom:(proc suspendedContext) |
591 ] ifFalse:[ |
598 ] ifFalse:[ |
592 id notNil ifTrue:[ |
599 id notNil ifTrue:[ |
593 'no process with id: ' print. id printCR. |
600 'no process with id: ' errorPrint. id errorPrintCR. |
594 ] ifFalse:[ |
601 ] ifFalse:[ |
595 '-------- walkback of current process -------' printCR. |
602 '-------- walkback of current process -------' errorPrintCR. |
596 self printBacktraceFrom:(self getContext) |
603 self printBacktraceFrom:(self getContext) |
597 ] |
604 ] |
598 ]. |
605 ]. |
599 ^ false |
606 ^ false |
600 ]. |
607 ]. |
601 |
608 |
602 (cmd == $b) ifTrue:[ |
609 (cmd == $b) ifTrue:[ |
603 proc notNil ifTrue:[ |
610 proc notNil ifTrue:[ |
604 '-------- VM walkback of process ' print. id print. ' -------' printCR. |
611 '-------- VM walkback of process ' errorPrint. id errorPrint. ' -------' errorPrintCR. |
605 ObjectMemory printStackBacktraceFrom:(proc suspendedContext) |
612 ObjectMemory printStackBacktraceFrom:(proc suspendedContext) |
606 ] ifFalse:[ |
613 ] ifFalse:[ |
607 id notNil ifTrue:[ |
614 id notNil ifTrue:[ |
608 'no process with id: ' print. id printCR. |
615 'no process with id: ' errorPrint. id errorPrintCR. |
609 ] ifFalse:[ |
616 ] ifFalse:[ |
610 '-------- VM walkback of current process -------' printCR. |
617 '-------- VM walkback of current process -------' errorPrintCR. |
611 ObjectMemory printStackBacktrace |
618 ObjectMemory printStackBacktrace |
612 ] |
619 ] |
613 ]. |
620 ]. |
614 ^ false |
621 ^ false |
615 ]. |
622 ]. |
616 |
623 |
617 (cmd == $S) ifTrue:[ |
624 (cmd == $S) ifTrue:[ |
618 'saving "crash.img"...' print. |
625 'saving "crash.img"...' errorPrint. |
619 ObjectMemory writeCrashImage. |
626 ObjectMemory writeCrashImage. |
620 'done.' printCR. |
627 'done.' errorPrintCR. |
621 ^ false |
628 ^ false |
622 ]. |
629 ]. |
623 (cmd == $C) ifTrue:[ |
630 (cmd == $C) ifTrue:[ |
624 |changesFilename| |
631 |changesFilename| |
625 |
632 |
626 changesFilename := Timestamp now |
633 changesFilename := Timestamp now |
627 printStringFormat:'changes_%(year)-%(month)-%(day)__%h:%m:%s.chg'. |
634 printStringFormat:'changes_%(year)-%(month)-%(day)__%h:%m:%s.chg'. |
628 OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ]. |
635 OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ]. |
629 |
636 |
630 ChangeSet current fileOutAs: changesFilename. |
637 ChangeSet current fileOutAs: changesFilename. |
631 ('saved session changes to "',changesFilename,'".') printCR. |
638 ('saved session changes to "',changesFilename,'".') errorPrintCR. |
632 ^ false |
639 ^ false |
633 ]. |
640 ]. |
634 |
641 |
635 (cmd == $B) ifTrue:[ |
642 (cmd == $B) ifTrue:[ |
636 self printAllBacktraces. |
643 self printAllBacktraces. |
637 ^ false |
644 ^ false |
638 ]. |
645 ]. |
639 |
646 |
640 (cmd == $P) ifTrue:[ |
647 (cmd == $P) ifTrue:[ |
641 self showProcesses:#all. |
648 self showProcesses:#all. |
642 ^ false |
649 ^ false |
643 ]. |
650 ]. |
644 (cmd == $p) ifTrue:[ |
651 (cmd == $p) ifTrue:[ |
645 self showProcesses:#live. |
652 self showProcesses:#live. |
646 ^ false |
653 ^ false |
647 ]. |
654 ]. |
648 |
655 |
649 (cmd == $r) ifTrue:[ |
656 (cmd == $r) ifTrue:[ |
650 dot receiver printCR. |
657 dot receiver errorPrintCR. |
651 ^ false |
658 ^ false |
652 ]. |
659 ]. |
653 |
660 |
654 (cmd == $i) ifTrue:[ |
661 (cmd == $i) ifTrue:[ |
655 MiniInspector openOn:(dot receiver). |
662 (commandArg ? '') withoutSeparators notEmpty ifTrue:[ |
656 ^ false |
663 MiniInspector openOn:(Parser evaluate:commandArg). |
|
664 ] ifFalse:[ |
|
665 MiniInspector openOn:(dot receiver). |
|
666 ]. |
|
667 ^ false |
657 ]. |
668 ]. |
658 |
669 |
659 (cmd == $I) ifTrue:[ |
670 (cmd == $I) ifTrue:[ |
660 self interpreterLoopWith:nil. |
671 self interpreterLoopWith:nil. |
661 ^ false |
672 ^ false |
662 ]. |
673 ]. |
663 (cmd == $E) ifTrue:[ |
674 (cmd == $E) ifTrue:[ |
664 Parser evaluate:commandArg. |
675 Parser evaluate:commandArg. |
665 ^ false |
676 ^ false |
666 ]. |
677 ]. |
667 (cmd == $e) ifTrue:[ |
678 (cmd == $e) ifTrue:[ |
668 (Parser evaluate:commandArg) printCR. |
679 (Parser evaluate:commandArg) errorPrintCR. |
669 ^ false |
680 ^ false |
670 ]. |
681 ]. |
671 |
682 |
672 (cmd == $c) ifTrue:[^ true]. |
683 (cmd == $c) ifTrue:[^ true]. |
673 (cmd == $s) ifTrue:[^ true]. |
684 (cmd == $s) ifTrue:[^ true]. |
674 (cmd == $t) ifTrue:[^ true]. |
685 (cmd == $t) ifTrue:[^ true]. |
675 (cmd == $a) ifTrue:[^ true]. |
686 (cmd == $a) ifTrue:[^ true]. |
676 |
687 |
677 (cmd == $u) ifTrue:[ |
688 (cmd == $u) ifTrue:[ |
678 stepping := false. |
689 stepping := false. |
679 tracing := false. |
690 tracing := false. |
680 Processor activeProcess vmTrace:false. |
691 Processor activeProcess vmTrace:false. |
681 ^ false |
692 ^ false |
682 ]. |
693 ]. |
683 |
694 |
684 (cmd == $h) ifTrue:[ |
695 (cmd == $h) ifTrue:[ |
685 (bool notNil) ifTrue:[ |
696 (bool notNil) ifTrue:[ |
686 Smalltalk ignoreHalt:bool not. |
697 Smalltalk ignoreHalt:bool not. |
687 ]. |
698 ]. |
688 'halts are ' print. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) printCR. |
699 'halts are ' errorPrint. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) errorPrintCR. |
689 ^ false |
700 ^ false |
690 ]. |
701 ]. |
691 |
702 |
692 (cmd == $R) ifTrue:[ |
703 (cmd == $R) ifTrue:[ |
693 proc notNil ifTrue:[ |
704 proc notNil ifTrue:[ |
694 proc resume. |
705 proc resume. |
695 ]. |
706 ]. |
696 ^ false |
707 ^ false |
697 ]. |
708 ]. |
698 |
709 |
699 (cmd == $T) ifTrue:[ |
710 (cmd == $T) ifTrue:[ |
700 proc notNil ifTrue:[ |
711 proc notNil ifTrue:[ |
701 proc terminate. |
712 proc terminate. |
702 ] ifFalse:[ |
713 ] ifFalse:[ |
703 id notNil ifTrue:[ |
714 id notNil ifTrue:[ |
704 'no process with id: ' print. id printCR. |
715 'no process with id: ' errorPrint. id errorPrintCR. |
705 ] ifFalse:[ |
716 ] ifFalse:[ |
706 Processor terminateActive |
717 Processor terminateActive |
707 ] |
718 ] |
708 ]. |
719 ]. |
709 ^ false |
720 ^ false |
710 ]. |
721 ]. |
711 |
722 |
712 (cmd == $W) ifTrue:[ |
723 (cmd == $W) ifTrue:[ |
713 proc notNil ifTrue:[ |
724 proc notNil ifTrue:[ |
714 'stopping process id: ' print. id printCR. |
725 'stopping process id: ' errorPrint. id errorPrintCR. |
715 proc stop. |
726 proc stop. |
716 ] ifFalse:[ |
727 ] ifFalse:[ |
717 'invalid process id: ' print. id printCR. |
728 'invalid process id: ' errorPrint. id errorPrintCR. |
718 ]. |
729 ]. |
719 ^ false |
730 ^ false |
720 ]. |
731 ]. |
721 |
732 |
722 (cmd == $a) ifTrue:[ |
733 (cmd == $a) ifTrue:[ |
723 "without id-arg, this is handled by caller" |
734 "without id-arg, this is handled by caller" |
724 proc notNil ifTrue:[ |
735 proc notNil ifTrue:[ |
725 'aborting process id: ' print. id printCR. |
736 'aborting process id: ' errorPrint. id errorPrintCR. |
726 proc interruptWith:[AbortOperationRequest raise] |
737 proc interruptWith:[AbortOperationRequest raise] |
727 ] ifFalse:[ |
738 ] ifFalse:[ |
728 'aborting' printCR. |
739 'aborting' errorPrintCR. |
729 ]. |
740 ]. |
730 ^ false |
741 ^ false |
731 ]. |
742 ]. |
732 |
743 |
733 (cmd == $Q) ifTrue:[ |
744 (cmd == $Q) ifTrue:[ |
734 proc notNil ifTrue:[ |
745 proc notNil ifTrue:[ |
735 proc terminateNoSignal. |
746 proc terminateNoSignal. |
736 ] ifFalse:[ |
747 ] ifFalse:[ |
737 id notNil ifTrue:[ |
748 id notNil ifTrue:[ |
738 'no process with id: ' print. id printCR. |
749 'no process with id: ' errorPrint. id errorPrintCR. |
739 ] ifFalse:[ |
750 ] ifFalse:[ |
740 Processor terminateActiveNoSignal |
751 Processor terminateActiveNoSignal |
741 ] |
752 ] |
742 ]. |
753 ]. |
743 ^ false |
754 ^ false |
744 ]. |
755 ]. |
745 |
756 |
746 (cmd == $g) ifTrue:[ |
757 (cmd == $g) ifTrue:[ |
747 self garbageCollectCommand:id. |
758 self garbageCollectCommand:id. |
748 ^ false |
759 ^ false |
749 ]. |
760 ]. |
750 |
761 |
751 (cmd == $U) ifTrue:[ |
762 (cmd == $U) ifTrue:[ |
752 MessageTracer unwrapAllMethods. |
763 MessageTracer unwrapAllMethods. |
753 ^ false |
764 ^ false |
|
765 ]. |
|
766 (cmd == $D) ifTrue:[ |
|
767 Breakpoint disableAllBreakpoints. |
|
768 ^ false |
754 ]. |
769 ]. |
755 (cmd == $X) ifTrue:[ |
770 (cmd == $X) ifTrue:[ |
756 Smalltalk fatalAbort. |
771 Smalltalk fatalAbort. |
757 "/ not reached |
772 "/ not reached |
758 ^ false |
773 ^ false |
759 ]. |
774 ]. |
760 (cmd == $x) ifTrue:[ |
775 (cmd == $x) ifTrue:[ |
761 OperatingSystem exit. |
776 OperatingSystem exit. |
762 "/ not reached |
777 "/ not reached |
763 ^ false |
778 ^ false |
764 ]. |
779 ]. |
765 |
780 |
766 (cmd == $.) ifTrue:[self printDot. ^ false ]. |
781 (cmd == $.) ifTrue:[self printDot. ^ false ]. |
767 (cmd == $l) ifTrue:[self printDotsMethodSource:false. ^ false ]. |
782 (cmd == $l) ifTrue:[self printDotsMethodSource:false. ^ false ]. |
768 (cmd == $L) ifTrue:[self printDotsMethodSource:true. ^ false ]. |
783 (cmd == $L) ifTrue:[self printDotsMethodSource:true. ^ false ]. |
769 (cmd == $-) ifTrue:[self moveDotUp. self printDot. ^ false ]. |
784 (cmd == $-) ifTrue:[self moveDotUp. self printDot. ^ false ]. |
770 (cmd == $+) ifTrue:[self moveDotDown. self printDot. ^ false ]. |
785 (cmd == $+) ifTrue:[self moveDotDown. self printDot. ^ false ]. |
771 (cmd == $?) ifTrue:[ |
786 (cmd == $?) ifTrue:[ |
772 commandArg notEmpty ifTrue:[ |
787 commandArg notEmpty ifTrue:[ |
773 self helpOn:commandArg. ^ false |
788 self helpOn:commandArg. ^ false |
774 ] |
789 ] |
775 ]. |
790 ]. |
776 |
791 |
777 "/ avoid usage print if return was typed ... |
792 "/ avoid usage print if return was typed ... |
778 ((cmd == Character return) |
793 ((cmd == Character return) |
779 or:[cmd == Character linefeed]) ifTrue:[^ false]. |
794 or:[cmd == Character linefeed]) ifTrue:[^ false]. |
791 "/ aScreen ungrabKeyboard. |
806 "/ aScreen ungrabKeyboard. |
792 "/ ]. |
807 "/ ]. |
793 "/ ]. |
808 "/ ]. |
794 |
809 |
795 Display notNil ifTrue:[ |
810 Display notNil ifTrue:[ |
796 Display ungrabPointer. |
811 Display ungrabPointer. |
797 Display ungrabKeyboard. |
812 Display ungrabKeyboard. |
798 ]. |
813 ]. |
799 |
814 |
800 (prompt |
815 (prompt |
801 ? (nesting == 0 ifTrue:[ |
816 ? (nesting == 0 ifTrue:[ |
802 'MiniDebugger> ' |
817 'MiniDebugger> ' |
803 ] ifFalse:[ |
818 ] ifFalse:[ |
804 'MiniDebugger' , nesting printString , '>' |
819 'MiniDebugger' , nesting printString , '>' |
805 ])) print. |
820 ])) errorPrint. |
806 |
821 |
807 UserInterrupt handle:[:ex | |
822 UserInterrupt handle:[:ex | |
808 ex restart |
823 ex restart |
809 ] do:[ |
824 ] do:[ |
810 |c cmd arg cnt| |
825 |c cmd arg cnt| |
811 |
826 |
812 cmd := Character fromUser. |
827 cmd := Character fromUser. |
813 cmd isNil ifTrue:[ |
828 cmd isNil ifTrue:[ |
814 " |
829 " |
815 mhmh end-of-file; |
830 mhmh end-of-file; |
816 return a 'c' (for continue); hope thats ok. |
831 return a 'c' (for continue); hope thats ok. |
817 " |
832 " |
818 cmd := $c |
833 cmd := $c |
819 ]. |
834 ]. |
820 |
835 |
821 cnt := nil. |
836 cnt := nil. |
822 (cmd isDigit) ifTrue:[ |
837 (cmd isDigit) ifTrue:[ |
823 cnt := 0. |
838 cnt := 0. |
824 [cmd isDigit] whileTrue:[ |
839 [ |
825 cnt := (cnt * 10) + cmd digitValue. |
840 cnt := (cnt * 10) + cmd digitValue. |
826 cmd := Character fromUser |
841 cmd := Character fromUser |
827 ]. |
842 ] doWhile:[cmd notNil and:[cmd isDigit]]. |
828 [cmd == Character space] whileTrue:[ |
843 [cmd notNil and:[cmd == Character space]] whileTrue:[ |
829 cmd := Character fromUser |
844 cmd := Character fromUser |
830 ]. |
845 ]. |
831 ]. |
846 ]. |
832 |
847 |
833 " |
848 " |
834 collect to end-of-line in arg |
849 collect to end-of-line in arg |
835 " |
850 " |
836 c := cmd. |
851 c := cmd. |
837 arg := ''. |
852 arg := ''. |
838 [c isNil or:[c isEndOfLineCharacter]] whileFalse: [ |
853 [c isNil or:[c isEndOfLineCharacter]] whileFalse: [ |
839 arg := arg copyWith:c. |
854 arg := arg copyWith:c. |
840 c := Character fromUser. |
855 c := Character fromUser. |
841 ]. |
856 ]. |
842 commandArg := (arg copyFrom:2) withoutSeparators. |
857 commandArg := (arg copyFrom:2) withoutSeparators. |
843 command := cmd. |
858 command := cmd. |
844 commandCount := cnt. |
859 commandCount := cnt. |
845 ]. |
860 ]. |
846 ^ command |
861 ^ command |
847 |
862 |
848 "Modified: / 31.7.1998 / 16:11:01 / cg" |
863 "Modified: / 31.7.1998 / 16:11:01 / cg" |
849 ! |
864 ! |
850 |
865 |
851 helpOn:commandArg |
866 helpOn:commandArg |
852 |args className sym val match showMethod| |
867 |args className sym val match showMethod| |
853 |
868 |
854 commandArg withoutSeparators isEmpty ifTrue:[ |
869 commandArg withoutSeparators isEmpty ifTrue:[ |
855 'usage: H className [methodPattern]' printCR. |
870 'usage: H className [methodPattern]' errorPrintCR. |
856 ^self |
871 ^self |
857 ]. |
872 ]. |
858 args := commandArg asCollectionOfWords. |
873 args := commandArg asCollectionOfWords. |
859 className := args first. |
874 className := args first. |
860 |
875 |
861 (sym := className asSymbolIfInterned) isNil ifTrue:[ |
876 (sym := className asSymbolIfInterned) isNil ifTrue:[ |
862 'no such class' printCR. |
877 'no such class' errorPrintCR. |
863 ^ self. |
878 ^ self. |
864 ]. |
879 ]. |
865 val := Smalltalk at:sym ifAbsent:['no such class' printCR. ^ self.]. |
880 val := Smalltalk at:sym ifAbsent:['no such class' errorPrintCR. ^ self.]. |
866 val isBehavior ifFalse:[ |
881 val isBehavior ifFalse:[ |
867 'not a class: ' print. className printCR. |
882 'not a class: ' errorPrint. className errorPrintCR. |
868 val := val class. |
883 val := val class. |
869 'showing help for ' print. val name printCR. |
884 'showing help for ' errorPrint. val name errorPrintCR. |
870 ]. |
885 ]. |
871 args size > 1 ifTrue:[ |
886 args size > 1 ifTrue:[ |
872 match := args at:2 |
887 match := args at:2 |
873 ] ifFalse:[ |
888 ] ifFalse:[ |
874 match := '*' |
889 match := '*' |
875 ]. |
890 ]. |
876 |
891 |
877 showMethod := |
892 showMethod := |
878 [:sel :cls | |
893 [:sel :cls | |
879 |mthd| |
894 |mthd| |
880 |
895 |
881 ((match includesMatchCharacters and:[ sel matches:match caseSensitive:false]) |
896 ((match includesMatchCharacters and:[ sel matches:match caseSensitive:false]) |
882 or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[ |
897 or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[ |
883 mthd := cls compiledMethodAt:sel. |
898 mthd := cls compiledMethodAt:sel. |
884 mthd category ~= 'documentation' ifTrue:[ |
899 mthd category ~= 'documentation' ifTrue:[ |
885 sel printCR. |
900 sel errorPrintCR. |
886 (mthd comment ? '') asStringCollection do:[:l | |
901 (mthd comment ? '') asStringCollection do:[:l | |
887 ' ' print. l withoutSeparators printCR. |
902 ' ' errorPrint. l withoutSeparators errorPrintCR. |
888 ]. |
903 ]. |
889 '' printCR |
904 '' errorPrintCR |
890 ]. |
905 ]. |
891 ]. |
906 ]. |
892 ]. |
907 ]. |
893 |
908 |
894 val theMetaclass selectors copy sort do:[:sel | |
909 val theMetaclass selectors copy sort do:[:sel | |
895 showMethod value:sel value:val theMetaclass |
910 showMethod value:sel value:val theMetaclass |
896 ]. |
911 ]. |
897 val theNonMetaclass selectors copy sort do:[:sel | |
912 val theNonMetaclass selectors copy sort do:[:sel | |
898 showMethod value:sel value:val theNonMetaclass |
913 showMethod value:sel value:val theNonMetaclass |
899 ]. |
914 ]. |
900 ! |
915 ! |
901 |
916 |
902 interpreterLoopWith:anObject |
917 interpreterLoopWith:anObject |
903 'read-eval-print loop; exit with "#exit"; help with "?"' printCR. |
918 'MinDebugger read-eval-print loop; exit with "#exit"; help with "?"' printCR. |
904 (ReadEvalPrintLoop new doChunkFormat:false; error:Stderr; prompt:'> ')readEvalPrintLoop. |
919 ReadEvalPrintLoop new |
|
920 doChunkFormat:false; |
|
921 error:Stderr; |
|
922 prompt:'mDBG > '; |
|
923 readEvalPrintLoop. |
905 |
924 |
906 "/ |line done rslt| |
925 "/ |line done rslt| |
907 "/ |
926 "/ |
908 "/ 'read-eval-print loop; exit with empty line' printCR. |
927 "/ 'read-eval-print loop; exit with empty line' printCR. |
909 "/ '' printCR. |
928 "/ '' printCR. |
956 |
975 |
957 showProcesses:how |
976 showProcesses:how |
958 |active| |
977 |active| |
959 |
978 |
960 active := Processor activeProcess. |
979 active := Processor activeProcess. |
961 'current id=' print. active id print. ' name=''' print. active name print. '''' printCR. |
980 'current id=' errorPrint. active id errorPrint. ' name=''' errorPrint. active name errorPrint. '''' errorPrintCR. |
962 |
981 |
963 Process allSubInstancesDo:[:p | |
982 (Process allSubInstances sort:[:a :b | (a id ? -1)<(b id ? -1)]) do:[:p | |
964 |doShow| |
983 |doShow| |
965 |
984 |
966 doShow := (how == #all). |
985 doShow := (how == #all). |
967 doShow := doShow or:[ (how == #dead) and:[ p isDead ]]. |
986 doShow := doShow or:[ (how == #dead) and:[ p isDead ]]. |
968 doShow := doShow or:[ (how ~~ #dead) and:[ p isDead not ]]. |
987 doShow := doShow or:[ (how ~~ #dead) and:[ p isDead not ]]. |
969 doShow ifTrue:[ |
988 doShow ifTrue:[ |
970 'proc id=' print. (p id printStringPaddedTo:5) print. |
989 'proc id=' errorPrint. (p id printStringPaddedTo:6) errorPrint. |
971 (p state printStringPaddedTo:10) print. |
990 (p state printStringPaddedTo:10) errorPrint. |
972 ' pri=' print. (p priority printStringPaddedTo:2) print. |
991 ' pri=' errorPrint. (p priority printStringPaddedTo:2) errorPrint. |
973 ' creator:' print. (p creatorId printStringPaddedTo:5) print. |
992 ' creator:' errorPrint. (p creatorId printStringPaddedTo:5) errorPrint. |
974 ' name=''' print. p name print. |
993 ' group:' errorPrint. (p processGroupId printStringPaddedTo:5) errorPrint. |
975 '''' printCR. |
994 ' sys:' errorPrint. (p isSystemProcess ifTrue:'y' ifFalse:'n') errorPrint. |
976 ] |
995 ' ui:' errorPrint. (p isGUIProcess ifTrue:'y' ifFalse:'n') errorPrint. |
|
996 ' name=''' errorPrint. p name errorPrint. |
|
997 '''' errorPrintCR. |
|
998 ] |
977 ] |
999 ] |
978 |
1000 |
979 "Modified: / 31.7.1998 / 16:30:19 / cg" |
1001 "Modified: / 31.7.1998 / 16:30:19 / cg" |
980 ! |
1002 ! |
981 |
1003 |
982 showValidCommandHelp |
1004 showValidCommandHelp |
983 'valid commands: |
1005 'valid commands: |
984 c ...... continue |
1006 c ........ continue |
985 s ...... step |
1007 s ........ step |
986 t ...... trace (continue with trace) |
1008 t ........ trace (continue with trace) |
987 a [id] abort (i.e. raise abort signal) in (current) process |
1009 a [id] ... abort (i.e. raise abort signal) in (current) process |
988 T [id] terminate (current) process |
1010 T [id] ... terminate (current) process |
989 W [id] stop (current) process |
1011 W [id] ... stop (current) process |
990 R [id] resume (current) process |
1012 R [id] ... resume (current) process |
991 Q [id] quick terminate (current) process - no unwinds or cleanup |
1013 Q [id] ... quick terminate (current) process - no unwinds or cleanup |
992 |
1014 |
993 p ...... list processes ("P" for full list) |
1015 p ........ list processes ("P" for full list) |
994 w [id] walkback (of process with id) |
1016 w [id] ... walkback (of current/process with id) |
995 b [id] full (VM) backtrace (more detail) |
1017 b [id] ... full (VM) backtrace with more detail |
996 B ...... backtrace of all other processes |
1018 B ........ backtrace of all other processes |
997 |
1019 |
998 U ...... unwrap all traced/breakpointed methods |
1020 U ........ unwrap all traced/breakpointed methods |
999 h [-/+] disable/enable halts |
1021 D ........ disable all line breakpoints |
1000 g ...... collect all garbage |
1022 h [-/+] .. disable/enable halts |
1001 g 2 .... collect all garbage & reclaim symbols |
1023 g ........ collect all garbage |
1002 g 3 .... collect all garbage, reclaim symbols and compress |
1024 g 2 ...... collect all garbage & reclaim symbols |
1003 |
1025 g 3 ...... collect all garbage, reclaim symbols and compress |
1004 S ...... save snapshot into "crash.img" |
1026 |
1005 C ...... save session changes to a separate change file |
1027 S ........ save snapshot into "crash.img" |
1006 x ...... exit Smalltalk ("X" to exit with core dump) |
1028 C ........ save session changes to a separate change file |
1007 |
1029 x ........ exit Smalltalk ("X" to exit with core dump) |
1008 . ...... print dot (the current context) |
1030 |
1009 - ...... move dot up (sender) |
1031 . ........ print dot (the current context) |
1010 + ...... move dot down (called context) |
1032 - ........ move dot up (sender) |
1011 l ...... list dot''s method source around PC ("L" for full list) |
1033 + ........ move dot down (called context) |
1012 |
1034 l ........ list dot''s method source around PC ("L" for full list) |
1013 r ...... receiver (in dot) printString |
1035 |
1014 i ...... inspect receiver (in dot) |
1036 r ........ receiver (in dot) printString |
1015 I ...... interpreter (expression evaluator) |
1037 i [expr] . inspect expression (or receiver in dot) |
1016 e expr evaluate expression & print result ("E" to not print) |
1038 I ........ interpreter (expression evaluator) |
1017 ? c [p] help on class c (selectors matching p) |
1039 e expr ... evaluate expression & print result ("E" to not print) |
|
1040 ? c [p] .. help on class c (selectors matching p) |
1018 ' errorPrintCR. |
1041 ' errorPrintCR. |
1019 |
1042 |
1020 (XWorkstation notNil and:[ Screen default isKindOf:XWorkstation ]) ifTrue:[ |
1043 (XWorkstation notNil and:[ Screen default isKindOf:XWorkstation ]) ifTrue:[ |
1021 ' To repair a broken X-Connection, enter an interpreter (enter "I") and evaluate: |
1044 ' To repair a broken X-Connection, enter an interpreter (enter "I") and evaluate: |
1022 Display := XWorkstation new. |
1045 Display := XWorkstation new. |
1023 Display initializeFor:''localhost:0''. |
1046 Display initializeFor:''localhost:0''. |
1024 Display startDispatch. |
1047 Display startDispatch. |
1025 NewLauncher openOnDevice:Display. |
1048 NewLauncher openOnDevice:Display. |
1026 <empty line> |
1049 #exit |
1027 then enter "c" to continue; a NewLauncher should pop up soon. |
1050 then enter "c" to continue; a NewLauncher should pop up soon. |
1028 ' errorPrintCR |
1051 ' errorPrintCR |
1029 ] |
1052 ] |
1030 |
1053 |
1031 "Modified: / 06-12-2013 / 16:41:39 / cg" |
1054 "Modified: / 03-02-2014 / 10:38:36 / cg" |
1032 ! ! |
1055 ! ! |
1033 |
1056 |
1034 !MiniDebugger class methodsFor:'documentation'! |
1057 !MiniDebugger class methodsFor:'documentation'! |
1035 |
1058 |
1036 version |
1059 version |
1037 ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.92 2013-12-06 18:31:26 cg Exp $' |
1060 ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.103 2014-06-25 07:43:51 stefan Exp $' |
1038 ! |
1061 ! |
1039 |
1062 |
1040 version_CVS |
1063 version_CVS |
1041 ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.92 2013-12-06 18:31:26 cg Exp $' |
1064 ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.103 2014-06-25 07:43:51 stefan Exp $' |
1042 ! ! |
1065 ! ! |
1043 |
1066 |