17 category:'System-Support' |
17 category:'System-Support' |
18 ! |
18 ! |
19 |
19 |
20 MiniDebugger comment:' |
20 MiniDebugger comment:' |
21 COPYRIGHT (c) 1988 by Claus Gittinger |
21 COPYRIGHT (c) 1988 by Claus Gittinger |
22 All Rights Reserved |
22 All Rights Reserved |
23 |
23 |
24 $Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.8 1994-08-05 00:59:02 claus Exp $ |
24 $Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.9 1994-10-10 00:26:48 claus Exp $ |
25 '! |
25 '! |
26 |
26 |
27 !MiniDebugger class methodsFor: 'documentation'! |
27 !MiniDebugger class methodsFor: 'documentation'! |
28 |
28 |
29 copyright |
29 copyright |
30 " |
30 " |
31 COPYRIGHT (c) 1988 by Claus Gittinger |
31 COPYRIGHT (c) 1988 by Claus Gittinger |
32 All Rights Reserved |
32 All Rights Reserved |
33 |
33 |
34 This software is furnished under a license and may be used |
34 This software is furnished under a license and may be used |
35 only in accordance with the terms of that license and with the |
35 only in accordance with the terms of that license and with the |
36 inclusion of the above copyright notice. This software may not |
36 inclusion of the above copyright notice. This software may not |
37 be provided or otherwise made available to, or used by, any |
37 be provided or otherwise made available to, or used by, any |
138 |
140 |
139 getContext |
141 getContext |
140 |backtrace| |
142 |backtrace| |
141 backtrace := thisContext. |
143 backtrace := thisContext. |
142 (backtrace notNil) ifTrue: [ |
144 (backtrace notNil) ifTrue: [ |
143 "remove Context getContext frame" |
145 "remove Context getContext frame" |
144 backtrace := backtrace sender. |
146 backtrace := backtrace sender. |
145 "remove Debugger showContext frame" |
147 "remove Debugger showContext frame" |
146 backtrace := backtrace sender. |
148 backtrace := backtrace sender. |
147 "remove Debugger commandLoop frame" |
149 "remove Debugger commandLoop frame" |
148 backtrace := backtrace sender. |
150 backtrace := backtrace sender. |
149 "remove Debugger enter frame" |
151 "remove Debugger enter frame" |
150 backtrace := backtrace sender |
152 backtrace := backtrace sender |
151 ]. |
153 ]. |
152 ^ backtrace |
154 ^ backtrace |
153 ! |
155 ! |
154 |
156 |
155 findContext:aSelector |
157 findContext:aSelector |
156 |con| |
158 |con| |
157 |
159 |
158 con := thisContext sender. |
160 con := thisContext sender. |
159 [con notNil] whileTrue:[ |
161 [con notNil] whileTrue:[ |
160 (con isBlockContext not and:[con selector == aSelector]) ifTrue:[ |
162 (con isBlockContext not and:[con selector == aSelector]) ifTrue:[ |
161 "got it" |
163 "got it" |
162 ^ con |
164 ^ con |
163 ]. |
165 ]. |
164 con := con sender |
166 con := con sender |
165 ]. |
167 ]. |
166 ^ nil |
168 ^ nil |
167 ! ! |
169 ! ! |
168 |
170 |
169 !MiniDebugger methodsFor: 'interrupt handling'! |
171 !MiniDebugger methodsFor: 'interrupt handling'! |
171 stepInterrupt |
173 stepInterrupt |
172 |where| |
174 |where| |
173 |
175 |
174 where := thisContext. "where is stepInterrupt context" |
176 where := thisContext. "where is stepInterrupt context" |
175 where notNil ifTrue:[ |
177 where notNil ifTrue:[ |
176 where := where sender "where is now interrupted methods context" |
178 where := where sender "where is now interrupted methods context" |
177 ]. |
179 ]. |
178 stepping ifTrue:[ |
180 stepping ifTrue:[ |
179 where notNil ifTrue:[ |
181 where notNil ifTrue:[ |
180 where fullPrint |
182 where fullPrint |
181 ] ifFalse:[ |
183 ] ifFalse:[ |
182 'stepInterrupt: no context' errorPrintNewline |
184 'stepInterrupt: no context' errorPrintNewline |
183 ]. |
185 ]. |
184 self enter |
186 self enter |
185 ] ifFalse:[ |
187 ] ifFalse:[ |
186 where notNil ifTrue:[ |
188 where notNil ifTrue:[ |
187 traceBlock notNil ifTrue:[ |
189 traceBlock notNil ifTrue:[ |
188 traceBlock value:where |
190 traceBlock value:where |
189 ] |
191 ] |
190 ] ifFalse:[ |
192 ] ifFalse:[ |
191 'traceInterrupt: no context' errorPrintNewline |
193 'traceInterrupt: no context' errorPrintNewline |
192 ]. |
194 ]. |
193 ObjectMemory flushInlineCaches. |
195 ObjectMemory flushInlineCaches. |
194 StepInterruptPending := true. |
196 StepInterruptPending := true. |
195 InterruptPending := true |
197 InterruptPending := true |
196 ] |
198 ] |
197 ! |
199 ! |
198 |
200 |
199 enter |
201 enter |
200 |cmd stillHere| |
202 |leaveCmd stillHere| |
201 |
203 |
202 stillHere := true. |
204 stillHere := true. |
203 [stillHere] whileTrue:[ |
205 [stillHere] whileTrue:[ |
204 cmd := self commandLoop. |
206 leaveCmd := self commandLoop. |
205 |
207 |
206 (cmd == $s) ifTrue: [ |
208 (leaveCmd == $s) ifTrue: [ |
207 self stepping. |
209 self stepping. |
208 ObjectMemory flushInlineCaches. |
210 ObjectMemory flushInlineCaches. |
209 ObjectMemory stepInterruptHandler:self. |
211 ObjectMemory stepInterruptHandler:self. |
210 stillHere := false. |
212 stillHere := false. |
211 StepInterruptPending := true. |
213 StepInterruptPending := true. |
212 InterruptPending := true |
214 InterruptPending := true |
213 ]. |
215 ]. |
214 (cmd == $t) ifTrue: [ |
216 (leaveCmd == $t) ifTrue: [ |
215 traceBlock := [:where | where fullPrint]. |
217 traceBlock := [:where | where fullPrint]. |
216 ObjectMemory flushInlineCaches. |
218 ObjectMemory flushInlineCaches. |
217 ObjectMemory stepInterruptHandler:self. |
219 ObjectMemory stepInterruptHandler:self. |
218 stillHere := false. |
220 stillHere := false. |
219 StepInterruptPending := true. |
221 StepInterruptPending := true. |
220 InterruptPending := true |
222 InterruptPending := true |
221 ]. |
223 ]. |
222 (cmd == $c) ifTrue: [ |
224 (leaveCmd == $c) ifTrue: [ |
223 stillHere := false. |
225 stillHere := false. |
224 stepping := false. |
226 stepping := false. |
225 tracing := false. |
227 tracing := false. |
226 StepInterruptPending := nil. |
228 StepInterruptPending := nil. |
227 InterruptPending := nil |
229 InterruptPending := nil |
228 ]. |
230 ]. |
229 (cmd == $a) ifTrue: [ |
231 (leaveCmd == $a) ifTrue: [ |
230 "abort" |
232 "abort" |
231 stepping := false. |
233 stepping := false. |
232 tracing := false. |
234 tracing := false. |
233 StepInterruptPending := nil. |
235 StepInterruptPending := nil. |
234 InterruptPending := nil. |
236 InterruptPending := nil. |
235 self doAbort. |
237 self doAbort. |
236 stillHere := true. |
238 stillHere := true. |
237 "failed abort" |
239 "failed abort" |
238 ]. |
240 ]. |
239 ]. |
241 ]. |
240 ^ nil |
242 ^ nil |
241 ! ! |
243 ! ! |
242 |
244 |
243 !MiniDebugger methodsFor: 'user commands'! |
245 !MiniDebugger methodsFor: 'user commands'! |
244 |
246 |
245 doAbort |
247 doAbort |
246 |con sig| |
248 |con sig| |
247 |
249 |
248 (sig := Object abortSignal) isHandled ifTrue:[ |
250 (sig := Object abortSignal) isHandled ifTrue:[ |
249 sig raise. |
251 sig raise. |
250 'abort raise failed' errorPrintNewline. |
252 'abort raise failed' errorPrintNewline. |
251 ]. |
253 ]. |
252 |
254 |
253 "TEMPORARY kludge - find event handler context |
255 "TEMPORARY kludge - find event handler context |
254 this will be removed, once real debugging is possible |
256 this will be removed, once real debugging is possible |
255 " |
257 " |
256 con := self findContext:#processEvent. |
258 con := self findContext:#processEvent. |
257 con isNil ifTrue:[ |
259 con isNil ifTrue:[ |
258 con := self findContext:#dispatch. |
260 con := self findContext:#dispatch. |
259 ]. |
261 ]. |
260 con notNil ifTrue:[ |
262 con notNil ifTrue:[ |
261 "got it" |
263 "got it" |
262 con return. |
264 con return. |
263 'return failed' errorPrintNewline. |
265 'return failed' errorPrintNewline. |
264 ]. |
266 ]. |
265 |
267 |
266 'found no context to resume' errorPrintNewline. |
268 'found no context to resume' errorPrintNewline. |
267 ! |
269 ! |
268 |
270 |
271 |
273 |
272 active := Processor activeProcess. |
274 active := Processor activeProcess. |
273 'current id=' print. active id print. ' name=' print. active name printNewline. |
275 'current id=' print. active id print. ' name=' print. active name printNewline. |
274 |
276 |
275 Process allInstancesDo:[:p | |
277 Process allInstancesDo:[:p | |
276 'proc id=' print. p id print. ' name=' print. p name print. ' state=' print. |
278 'proc id=' print. p id print. ' name=' print. p name print. ' state=' print. |
277 p state printNewline. |
279 p state printNewline. |
278 ] |
280 ] |
279 ! |
281 ! |
280 |
282 |
281 commandLoop |
283 commandLoop |
282 |cmd done valid context| |
284 |cmd done valid context| |
283 |
285 |
284 done := false. |
286 done := false. |
285 [done] whileFalse:[ |
287 [done] whileFalse:[ |
286 valid := false. |
288 valid := false. |
287 cmd := self getCommand. |
289 cmd := self getCommand. |
288 (cmd == $p) ifTrue:[ |
290 (cmd == $p) ifTrue:[ |
289 valid := true. |
291 valid := true. |
290 context isNil ifTrue: [ |
292 context isNil ifTrue: [ |
291 context := self getContext |
293 context := self getContext |
292 ]. |
294 ]. |
293 context notNil ifTrue:[ |
295 context notNil ifTrue:[ |
294 context fullPrintAll |
296 context fullPrintAll |
295 ] ifFalse:[ |
297 ] ifFalse:[ |
296 'no context' errorPrintNewline |
298 'no context' errorPrintNewline |
297 ] |
299 ] |
298 ]. |
300 ]. |
299 (cmd == $P) ifTrue:[ |
301 (cmd == $P) ifTrue:[ |
300 valid := true. |
302 valid := true. |
301 self showProcesses. |
303 self showProcesses. |
302 ]. |
304 ]. |
303 (cmd == $r) ifTrue:[ |
305 (cmd == $r) ifTrue:[ |
304 valid := true. |
306 valid := true. |
305 context isNil ifTrue: [ |
307 context isNil ifTrue: [ |
306 context := self getContext |
308 context := self getContext |
307 ]. |
309 ]. |
308 context notNil ifTrue:[ |
310 context notNil ifTrue:[ |
309 "remove Debugger stepinterrupt/halt frame" |
311 "remove Debugger stepinterrupt/halt frame" |
310 context sender receiver printNewline |
312 context sender receiver printNewline |
311 ] ifFalse:[ |
313 ] ifFalse:[ |
312 'no context - dont know receiver' errorPrintNewline |
314 'no context - dont know receiver' errorPrintNewline |
313 ] |
315 ] |
314 ]. |
316 ]. |
315 (cmd == $R) ifTrue:[ |
317 (cmd == $R) ifTrue:[ |
316 valid := true. |
318 valid := true. |
317 context isNil ifTrue: [ |
319 context isNil ifTrue: [ |
318 context := self getContext |
320 context := self getContext |
319 ]. |
321 ]. |
320 context notNil ifTrue:[ |
322 context notNil ifTrue:[ |
321 "remove Debugger stepinterrupt/halt frame" |
323 "remove Debugger stepinterrupt/halt frame" |
322 context sender receiver storeOn:Stdout |
324 context sender receiver storeOn:Stdout |
323 ] ifFalse:[ |
325 ] ifFalse:[ |
324 'no context - dont know receiver' errorPrintNewline |
326 'no context - dont know receiver' errorPrintNewline |
325 ] |
327 ] |
326 ]. |
328 ]. |
327 (cmd == $i) ifTrue:[ |
329 (cmd == $i) ifTrue:[ |
328 valid := true. |
330 valid := true. |
329 context isNil ifTrue: [ |
331 context isNil ifTrue: [ |
330 context := self getContext |
332 context := self getContext |
331 ]. |
333 ]. |
332 context notNil ifTrue:[ |
334 context notNil ifTrue:[ |
333 "remove Debugger stepinterrupt/halt frame" |
335 "remove Debugger stepinterrupt/halt frame" |
334 MiniInspector openOn:(context sender receiver) |
336 MiniInspector openOn:(context sender receiver) |
335 ] ifFalse:[ |
337 ] ifFalse:[ |
336 'no context - dont know receiver' errorPrintNewline |
338 'no context - dont know receiver' errorPrintNewline |
337 ] |
339 ] |
338 ]. |
340 ]. |
339 (cmd == $I) ifTrue:[ |
341 (cmd == $I) ifTrue:[ |
340 valid := true. |
342 valid := true. |
341 context isNil ifTrue: [ |
343 context isNil ifTrue: [ |
342 context := self getContext |
344 context := self getContext |
343 ]. |
345 ]. |
344 context notNil ifTrue:[ |
346 context notNil ifTrue:[ |
345 "remove Debugger stepinterrupt/halt frame" |
347 "remove Debugger stepinterrupt/halt frame" |
346 self interpreterLoopWith:(context sender receiver) |
348 self interpreterLoopWith:(context sender receiver) |
347 ] ifFalse:[ |
349 ] ifFalse:[ |
348 'no context - dont know receiver' errorPrintNewline. |
350 'no context - dont know receiver' errorPrintNewline. |
349 self interpreterLoopWith:nil |
351 self interpreterLoopWith:nil |
350 ] |
352 ] |
351 ]. |
353 ]. |
352 context := nil. |
354 context := nil. |
353 (cmd == $c) ifTrue:[valid := true. done := true]. |
355 (cmd == $c) ifTrue:[valid := true. done := true]. |
354 (cmd == $s) ifTrue:[valid := true. done := true]. |
356 (cmd == $s) ifTrue:[valid := true. done := true]. |
355 (cmd == $t) ifTrue:[valid := true. done := true]. |
357 (cmd == $t) ifTrue:[valid := true. done := true]. |
356 (cmd == $a) ifTrue:[valid := true. done := true]. |
358 (cmd == $a) ifTrue:[valid := true. done := true]. |
357 (cmd == $T) ifTrue:[valid := true. Processor activeProcess terminate]. |
359 (cmd == $T) ifTrue:[valid := true. Processor terminateActive]. |
358 (cmd == $X) ifTrue:[Smalltalk fatalAbort]. |
360 (cmd == $Q) ifTrue:[valid := true. Processor terminateActiveNoSignal]. |
359 (cmd == $x) ifTrue:[Smalltalk exit]. |
361 (cmd == $X) ifTrue:[Smalltalk fatalAbort]. |
360 valid ifFalse: [ |
362 (cmd == $x) ifTrue:[Smalltalk exit]. |
361 'valid commands: |
363 valid ifFalse: [ |
|
364 'valid commands: |
362 (c)ontinue |
365 (c)ontinue |
363 (s)tep |
366 (s)tep |
364 (t)race |
367 (t)race |
365 (p)rintContext |
368 (p)rintContext |
366 (r)eceiver printString |
369 (r)eceiver printString |
368 (i)nspect |
371 (i)nspect |
369 (I)nterpreter |
372 (I)nterpreter |
370 (a)bort |
373 (a)bort |
371 (P)rocesses |
374 (P)rocesses |
372 (T)terminate current process |
375 (T)terminate current process |
|
376 (Q)uick terminate current process (no unwinds) |
373 (X)exit (+core) |
377 (X)exit (+core) |
374 (x)exit Smalltalk' errorPrintNewline |
378 (x)exit Smalltalk' errorPrintNewline |
375 ] |
379 ] |
376 ]. |
380 ]. |
377 ^ cmd |
381 ^ cmd |
378 ! |
382 ! |
379 |
383 |
380 getCommand |
384 getCommand |
381 |cmd c| |
385 |cmd c| |
382 |
386 |
383 'MiniDebugger> ' print. |
387 'MiniDebugger> ' print. |
384 |
388 |
385 cmd := Character fromUser. |
389 Object userInterruptSignal handle:[:ex | |
386 cmd isNil ifTrue:[ |
390 ex restart |
387 " |
391 ] do:[ |
388 mhmh end-of-file; |
392 cmd := Character fromUser. |
389 return a 'c' (for continue); hope thats ok. |
393 cmd isNil ifTrue:[ |
390 " |
394 " |
391 cmd := $c |
395 mhmh end-of-file; |
392 ]. |
396 return a 'c' (for continue); hope thats ok. |
393 |
397 " |
394 " |
398 cmd := $c |
395 ignore to end-of-line |
399 ]. |
396 " |
400 |
397 c := cmd. |
401 " |
398 [c isNil or:[c isEndOfLineCharacter]] whileFalse: [ |
402 ignore to end-of-line |
399 c := Character fromUser. |
403 " |
|
404 c := cmd. |
|
405 [c isNil or:[c isEndOfLineCharacter]] whileFalse: [ |
|
406 c := Character fromUser. |
|
407 ]. |
400 ]. |
408 ]. |
401 ^ cmd |
409 ^ cmd |
402 ! |
410 ! |
403 |
411 |
404 interpreterLoopWith:anObject |
412 interpreterLoopWith:anObject |
405 |line done| |
413 |line done| |
406 'read-eval-print loop; exit with empty line' printNewline. |
414 'read-eval-print loop; exit with empty line' printNewline. |
407 done := false. |
415 done := false. |
408 [done] whileFalse:[ |
416 [done] whileFalse:[ |
409 line := Stdin nextLine. |
417 line := Stdin nextLine. |
410 (line size == 0) ifTrue:[ |
418 (line size == 0) ifTrue:[ |
411 done := true |
419 done := true |
412 ] ifFalse:[ |
420 ] ifFalse:[ |
413 (Compiler evaluate:line |
421 (Compiler evaluate:line |
414 receiver:anObject |
422 receiver:anObject |
415 notifying:nil) printNewline |
423 notifying:nil) printNewline |
416 ] |
424 ] |
417 ] |
425 ] |
418 ! ! |
426 ! ! |