--- a/DebugView.st Sun Dec 19 01:43:32 1993 +0100
+++ b/DebugView.st Mon Dec 20 00:44:35 1993 +0100
@@ -17,7 +17,8 @@
contextArray selectedContext
catchBlock grabber traceView tracing
bigStep steppedContextAddress canAbort
- abortButton'
+ abortButton
+ exclusive'
classVariableNames:'cachedDebugger theOneAndOnlyNotifier'
poolDictionaries:''
category:'Interface-Debugger'
@@ -29,11 +30,13 @@
All Rights Reserved
this class implements a graphical debugger interface.
-To get control over the workstation while debugging, I get an exclusive
-connection to the display and dispatch on this one. This will be changed
-using processes soon.
+The debugger usually sits on top of the faulting process,
+stopping it from further event processing.
+The exception is when an error occurs within the dispatcher process
+or in one of the eventhandler processes - in this case, the debugger
+will sit on an exclusive display connection.
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.5 1993-12-13 17:05:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.6 1993-12-19 23:44:27 claus Exp $
written spring/summer 89 by claus
'!
@@ -46,15 +49,20 @@
|debugger|
+ "need a blocking debugger if no processes or
+ or if its a timing/interrupt process (because otherwise we would not get any
+ events here ..."
+
ProcessorScheduler isPureEventDriven ifTrue:[
cachedDebugger isNil ifTrue:[
- debugger := super on:ModalDisplay.
- debugger label:'Debugger'.
- debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
- cachedDebugger := debugger
+ cachedDebugger := self newExclusive
].
^ cachedDebugger
].
+ (Processor activeProcess priority > Processor userSchedulingPriority) ifTrue:[
+ ^ self newExclusive
+ ].
+
(cachedDebugger isNil or:[cachedDebugger busy]) ifTrue:[
debugger := super new.
debugger label:'Debugger'.
@@ -68,6 +76,18 @@
^ debugger
!
+newExclusive
+ "return a debugger for exclusive display access"
+
+ |debugger|
+
+ debugger := super on:ModalDisplay.
+ debugger label:'Debugger'.
+ debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
+ debugger exclusive:true.
+ ^ debugger
+!
+
newDebugger
"force creation of a new debugger"
@@ -84,7 +104,7 @@
StepInterruptPending := nil.
aDebugger := self new.
- name := Processor currentProcess nameOrId.
+ name := Processor activeProcess nameOrId.
aDebugger label:aString , ' (process: ' , name , ')'.
aDebugger enter.
^ nil
@@ -99,7 +119,7 @@
StepInterruptPending := nil.
aDebugger := self new.
- name := Processor currentProcess nameOrId.
+ name := Processor activeProcess nameOrId.
aDebugger label:'Debugger (process: ' , name , ')'.
aDebugger enter.
^ nil
@@ -236,6 +256,13 @@
createOnTop
^ false "true"
+!
+
+realize
+ super realize.
+ exclusive ifTrue:[
+ windowGroup := nil
+ ].
! !
!DebugView methodsFor:'error handling'!
@@ -301,9 +328,9 @@
s := 'after send'
].
- name := Processor currentProcess name.
+ name := Processor activeProcess name.
name isNil ifTrue:[
- name := Processor currentProcess id printString.
+ name := Processor activeProcess id printString.
].
self label:(s , ' (process: ' , name , ')').
@@ -318,6 +345,10 @@
^ busy
!
+exclusive:aBoolean
+ exclusive := aBoolean
+!
+
enter
"enter the debugger - get and display the context, then start an
exclusive event loop on top of eveything else"
@@ -345,8 +376,15 @@
"not the first time - realize at old position"
self rerealize
] ifFalse:[
- self realize.
+ exclusive ifFalse:[
+ windowGroup isNil ifTrue:[
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ ].
+ ].
+ self realize
].
+
self raise.
Display synchronizeOutput.
@@ -441,7 +479,7 @@
ErrorActive := false.
InInterrupt := nil.
RecursionLimit := oldRecursionLimit.
- Processor currentProcess terminate.
+ Processor activeProcess terminate.
'cannot terminate process' printNewline
]
]
@@ -494,13 +532,23 @@
"setup a catch-block"
catchBlock := [^ nil].
- "this is a kludge:
- we do not have multiple processes
- therefore we start another dispatch loop, which exits when
- either continue, resume or step is pressed
- or (via the catchBlock) if an error occures
- "
- device dispatchWhile:[haveControl]
+ exclusive ifTrue:[
+ "if we do not have multiple processes or its a system process
+ we start another dispatch loop, which exits when
+ either continue, resume or step is pressed
+ or (via the catchBlock) if an error occurs.
+ Since our display is an extra exclusive one (ModalDisplay)
+ all processing for normal views stops here ...
+ "
+ device dispatchWhile:[haveControl]
+ ] ifFalse:[
+ "we do have multiple processes -
+ simply enter the DebugViews-Windowgroup event loop.
+ effectively suspending event processing for the currently
+ active group.
+ "
+ self windowGroup eventLoop
+ ]
!
setContext:aContext
@@ -669,7 +717,11 @@
canContinue ifTrue:[
steppedContextAddress := nil.
haveControl := false.
- exitAction := #step
+ exitAction := #step.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
]
!
@@ -685,7 +737,11 @@
steppedContextAddress := ObjectMemory addressOf:(contextArray at:2)
].
haveControl := false.
- exitAction := #step
+ exitAction := #step.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
]
!
@@ -704,10 +760,14 @@
steppedContextAddress := nil.
haveControl := false.
exitAction := #abort.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
^ self.
"obsolete ..."
- Processor currentProcess id == 0 ifTrue:[
+ Processor activeProcess id == 0 ifTrue:[
"dont allow termination of main-thread"
exitAction := #abort
] ifFalse:[
@@ -720,7 +780,11 @@
steppedContextAddress := nil.
haveControl := false.
- exitAction := #terminate
+ exitAction := #terminate.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
!
@@ -729,7 +793,11 @@
steppedContextAddress := nil.
haveControl := false.
- exitAction := #resume
+ exitAction := #resume.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
!
doRestart
@@ -737,7 +805,11 @@
steppedContextAddress := nil.
haveControl := false.
- exitAction := #restart
+ exitAction := #restart.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
!
doTrace
@@ -780,6 +852,10 @@
steppedContextAddress := nil.
tracing := false.
haveControl := false.
- exitAction := #continue
+ exitAction := #continue.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock value
+ ].
]
! !