|
1 " |
|
2 COPYRIGHT (c) 1988-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 Object subclass:#MiniDebugger |
|
14 instanceVariableNames:'tracing stepping traceBlock' |
|
15 classVariableNames: 'theOneAndOnlyDebugger' |
|
16 poolDictionaries:'' |
|
17 category:'System-Support' |
|
18 ! |
|
19 |
|
20 MiniDebugger comment:' |
|
21 |
|
22 COPYRIGHT (c) 1988-93 by Claus Gittinger |
|
23 All Rights Reserved |
|
24 |
|
25 a primitive (non graphical) debugger for use on systems without |
|
26 graphics or when the real debugger dies (i.e. an error occurs in |
|
27 the graphical debugger). |
|
28 |
|
29 %W% %E% |
|
30 '! |
|
31 |
|
32 !MiniDebugger class methodsFor: 'instance creation'! |
|
33 |
|
34 new |
|
35 theOneAndOnlyDebugger printNL. |
|
36 theOneAndOnlyDebugger isNil ifTrue:[ |
|
37 theOneAndOnlyDebugger := self basicNew initialize |
|
38 ]. |
|
39 ^ theOneAndOnlyDebugger |
|
40 ! |
|
41 |
|
42 singleStep:aBlock |
|
43 |aDebugger| |
|
44 |
|
45 aDebugger := self new stepping. |
|
46 StepInterruptHandler := aDebugger. |
|
47 StepInterruptPending := true. |
|
48 InterruptPending := true. |
|
49 aBlock value. |
|
50 StepInterruptPending := nil |
|
51 ! |
|
52 |
|
53 trace:aBlock |
|
54 self trace:aBlock with:[:where | where printNewline] |
|
55 ! |
|
56 |
|
57 trace:aBlock on:aStream |
|
58 self trace:aBlock with:[:where | where printString printOn:aStream. |
|
59 aStream cr] |
|
60 ! |
|
61 |
|
62 trace:aBlock with:aTraceBlock |
|
63 |aDebugger| |
|
64 |
|
65 aDebugger := self new tracingWith:aTraceBlock. |
|
66 ObjectMemory flushInlineCaches. |
|
67 StepInterruptHandler := aDebugger. |
|
68 StepInterruptPending := true. |
|
69 InterruptPending := true. |
|
70 aBlock value. |
|
71 StepInterruptPending := nil. |
|
72 ^ nil |
|
73 ! |
|
74 |
|
75 enterWithMessage:aString |
|
76 |aDebugger| |
|
77 |
|
78 StepInterruptPending := nil. |
|
79 aString printNewline. |
|
80 aDebugger := self new. |
|
81 aDebugger enter. |
|
82 ^ nil |
|
83 ! ! |
|
84 |
|
85 !MiniDebugger methodsFor: 'initialization'! |
|
86 |
|
87 initialize |
|
88 traceBlock := nil. |
|
89 tracing := false. |
|
90 stepping := false |
|
91 ! ! |
|
92 |
|
93 !MiniDebugger methodsFor: 'private'! |
|
94 |
|
95 stepping |
|
96 traceBlock := nil. |
|
97 tracing := false. |
|
98 stepping := true |
|
99 ! |
|
100 |
|
101 tracingWith:aBlockOrNil |
|
102 traceBlock := aBlockOrNil. |
|
103 stepping := false. |
|
104 tracing := true |
|
105 ! |
|
106 |
|
107 getContext |
|
108 |backtrace| |
|
109 backtrace := thisContext. |
|
110 (backtrace notNil) ifTrue: [ |
|
111 "remove Context getContext frame" |
|
112 backtrace := backtrace sender. |
|
113 "remove Debugger showContext frame" |
|
114 backtrace := backtrace sender. |
|
115 "remove Debugger commandLoop frame" |
|
116 backtrace := backtrace sender. |
|
117 "remove Debugger enter frame" |
|
118 backtrace := backtrace sender |
|
119 ]. |
|
120 ^ backtrace |
|
121 ! ! |
|
122 |
|
123 !MiniDebugger methodsFor: 'interrupt handling'! |
|
124 |
|
125 stepInterrupt |
|
126 |where| |
|
127 |
|
128 where := thisContext. "where is stepInterrupt context" |
|
129 where notNil ifTrue:[ |
|
130 where := where sender "where is now interrupted methods context" |
|
131 ]. |
|
132 stepping ifTrue:[ |
|
133 where notNil ifTrue:[ |
|
134 where fullPrint |
|
135 ] ifFalse:[ |
|
136 'stepInterrupt: no context' printNewline |
|
137 ]. |
|
138 self enter |
|
139 ] ifFalse:[ |
|
140 where notNil ifTrue:[ |
|
141 traceBlock notNil ifTrue:[ |
|
142 traceBlock value:where |
|
143 ] |
|
144 ] ifFalse:[ |
|
145 'traceInterrupt: no context' printNewline |
|
146 ]. |
|
147 ObjectMemory flushInlineCaches. |
|
148 StepInterruptPending := true. |
|
149 InterruptPending := true |
|
150 ] |
|
151 ! |
|
152 |
|
153 enter |
|
154 |cmd| |
|
155 |
|
156 cmd := self commandLoop. |
|
157 (cmd == $s) ifTrue: [ |
|
158 self stepping. |
|
159 ObjectMemory flushInlineCaches. |
|
160 StepInterruptHandler := self. |
|
161 StepInterruptPending := true. |
|
162 InterruptPending := true |
|
163 ]. |
|
164 (cmd == $t) ifTrue: [ |
|
165 traceBlock := [:where | where fullPrint]. |
|
166 ObjectMemory flushInlineCaches. |
|
167 StepInterruptHandler := self. |
|
168 StepInterruptPending := true. |
|
169 InterruptPending := true |
|
170 ]. |
|
171 (cmd == $c) ifTrue: [ |
|
172 stepping := false. |
|
173 tracing := false. |
|
174 StepInterruptPending := nil. |
|
175 InterruptPending := nil |
|
176 ]. |
|
177 ^ nil |
|
178 ! ! |
|
179 |
|
180 !MiniDebugger methodsFor: 'user commands'! |
|
181 |
|
182 commandLoop |
|
183 |cmd done valid context| |
|
184 |
|
185 done := false. |
|
186 [done] whileFalse:[ |
|
187 valid := false. |
|
188 cmd := self getCommand. |
|
189 (cmd == $p) ifTrue:[ |
|
190 valid := true. |
|
191 context isNil ifTrue: [ |
|
192 context := self getContext |
|
193 ]. |
|
194 context notNil ifTrue:[ |
|
195 context fullPrintAll |
|
196 ] ifFalse:[ |
|
197 'no context' printNewline |
|
198 ] |
|
199 ]. |
|
200 (cmd == $r) ifTrue:[ |
|
201 valid := true. |
|
202 context isNil ifTrue: [ |
|
203 context := self getContext |
|
204 ]. |
|
205 context notNil ifTrue:[ |
|
206 "remove Debugger stepinterrupt/halt frame" |
|
207 context sender receiver printNewline |
|
208 ] ifFalse:[ |
|
209 'no context - dont know receiver' printNewline |
|
210 ] |
|
211 ]. |
|
212 (cmd == $R) ifTrue:[ |
|
213 valid := true. |
|
214 context isNil ifTrue: [ |
|
215 context := self getContext |
|
216 ]. |
|
217 context notNil ifTrue:[ |
|
218 "remove Debugger stepinterrupt/halt frame" |
|
219 context sender receiver storeOn:Stdout |
|
220 ] ifFalse:[ |
|
221 'no context - dont know receiver' printNewline |
|
222 ] |
|
223 ]. |
|
224 (cmd == $i) ifTrue:[ |
|
225 valid := true. |
|
226 context isNil ifTrue: [ |
|
227 context := self getContext |
|
228 ]. |
|
229 context notNil ifTrue:[ |
|
230 "remove Debugger stepinterrupt/halt frame" |
|
231 context sender receiver inspect |
|
232 ] ifFalse:[ |
|
233 'no context - dont know receiver' printNewline |
|
234 ] |
|
235 ]. |
|
236 (cmd == $I) ifTrue:[ |
|
237 valid := true. |
|
238 context isNil ifTrue: [ |
|
239 context := self getContext |
|
240 ]. |
|
241 context notNil ifTrue:[ |
|
242 "remove Debugger stepinterrupt/halt frame" |
|
243 self interpreterLoopWith:(context sender receiver) |
|
244 ] ifFalse:[ |
|
245 'no context - dont know receiver' printNewline. |
|
246 self interpreterLoopWith:nil |
|
247 ] |
|
248 ]. |
|
249 context := nil. |
|
250 (cmd == $c) ifTrue:[valid := true. done := true]. |
|
251 (cmd == $s) ifTrue:[valid := true. done := true]. |
|
252 (cmd == $t) ifTrue:[valid := true. done := true]. |
|
253 (cmd == $a) ifTrue:[Smalltalk fatalAbort]. |
|
254 (cmd == $x) ifTrue:[Smalltalk exit]. |
|
255 valid ifFalse: [ |
|
256 'valid commands:' printNewline. |
|
257 ' (c)ontinue' printNewline. |
|
258 ' (s)tep' printNewline. |
|
259 ' (t)race' printNewline. |
|
260 ' (p)rintContext' printNewline. |
|
261 ' (r)eceiver' printNewline. |
|
262 ' (R)eceiver' printNewline. |
|
263 ' (i)nspect' printNewline. |
|
264 ' (I)nterpreter' printNewline. |
|
265 ' (a)bort' printNewline. |
|
266 ' (x)exit Smalltalk' printNewline |
|
267 ] |
|
268 ]. |
|
269 ^ cmd |
|
270 ! |
|
271 |
|
272 getCommand |
|
273 |cmd c| |
|
274 'MiniDebugger> ' print. |
|
275 cmd := Character fromUser. |
|
276 c := cmd. |
|
277 [ c isEndOfLineCharacter ] whileFalse: [ |
|
278 c := Character fromUser |
|
279 ]. |
|
280 ^ cmd |
|
281 ! |
|
282 |
|
283 interpreterLoopWith:anObject |
|
284 |line done| |
|
285 'read-eval-print loop; exit with empty line' printNewline. |
|
286 done := false. |
|
287 [done] whileFalse:[ |
|
288 line := Stdin nextLine. |
|
289 (line size == 0) ifTrue:[ |
|
290 done := true |
|
291 ] ifFalse:[ |
|
292 (Compiler evaluate:line |
|
293 receiver:anObject |
|
294 notifying:nil) printNewline |
|
295 ] |
|
296 ] |
|
297 ! ! |