DebugView.st
changeset 13 145a9461122e
parent 10 46e0d4f2079f
child 14 e07eee5d93ca
equal deleted inserted replaced
12:f090e399a84f 13:145a9461122e
    15                               contextView codeView
    15                               contextView codeView
    16                               receiverInspector contextInspector
    16                               receiverInspector contextInspector
    17                               contextArray selectedContext
    17                               contextArray selectedContext
    18                               catchBlock grabber traceView tracing
    18                               catchBlock grabber traceView tracing
    19                               bigStep steppedContextAddress canAbort
    19                               bigStep steppedContextAddress canAbort
    20                               abortButton'
    20                               abortButton
       
    21                               exclusive'
    21        classVariableNames:'cachedDebugger theOneAndOnlyNotifier'
    22        classVariableNames:'cachedDebugger theOneAndOnlyNotifier'
    22        poolDictionaries:''
    23        poolDictionaries:''
    23        category:'Interface-Debugger'
    24        category:'Interface-Debugger'
    24 !
    25 !
    25 
    26 
    27 
    28 
    28 COPYRIGHT (c) 1989 by Claus Gittinger
    29 COPYRIGHT (c) 1989 by Claus Gittinger
    29               All Rights Reserved
    30               All Rights Reserved
    30 
    31 
    31 this class implements a graphical debugger interface.
    32 this class implements a graphical debugger interface.
    32 To get control over the workstation while debugging, I get an exclusive
    33 The debugger usually sits on top of the faulting process,
    33 connection to the display and dispatch on this one. This will be changed
    34 stopping it from further event processing.
    34 using processes soon.
    35 The exception is when an error occurs within the dispatcher process
    35 
    36 or in one of the eventhandler processes - in this case, the debugger
    36 $Header: /cvs/stx/stx/libtool/DebugView.st,v 1.5 1993-12-13 17:05:04 claus Exp $
    37 will sit on an exclusive display connection.
       
    38 
       
    39 $Header: /cvs/stx/stx/libtool/DebugView.st,v 1.6 1993-12-19 23:44:27 claus Exp $
    37 
    40 
    38 written spring/summer 89 by claus
    41 written spring/summer 89 by claus
    39 '!
    42 '!
    40 
    43 
    41 !DebugView class methodsFor:'instance creation'!
    44 !DebugView class methodsFor:'instance creation'!
    44     "return a DebugView - return the standard debugger if it already
    47     "return a DebugView - return the standard debugger if it already
    45      exists"
    48      exists"
    46 
    49 
    47     |debugger|
    50     |debugger|
    48 
    51 
       
    52     "need a blocking debugger if no processes or 
       
    53      or if its a timing/interrupt process (because otherwise we would not get any 
       
    54      events here ..."
       
    55 
    49     ProcessorScheduler isPureEventDriven ifTrue:[
    56     ProcessorScheduler isPureEventDriven ifTrue:[
    50         cachedDebugger isNil ifTrue:[
    57         cachedDebugger isNil ifTrue:[
    51             debugger := super on:ModalDisplay.
    58             cachedDebugger := self newExclusive
    52             debugger label:'Debugger'.
       
    53             debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
       
    54             cachedDebugger := debugger
       
    55         ].
    59         ].
    56         ^ cachedDebugger
    60         ^ cachedDebugger
    57     ].
    61     ].
       
    62     (Processor activeProcess priority > Processor userSchedulingPriority) ifTrue:[
       
    63         ^ self newExclusive
       
    64     ].
       
    65 
    58     (cachedDebugger isNil or:[cachedDebugger busy]) ifTrue:[
    66     (cachedDebugger isNil or:[cachedDebugger busy]) ifTrue:[
    59         debugger := super new.
    67         debugger := super new.
    60         debugger label:'Debugger'.
    68         debugger label:'Debugger'.
    61         debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
    69         debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
    62     ] ifFalse:[
    70     ] ifFalse:[
    66         cachedDebugger := debugger
    74         cachedDebugger := debugger
    67     ].
    75     ].
    68     ^ debugger
    76     ^ debugger
    69 !
    77 !
    70 
    78 
       
    79 newExclusive
       
    80     "return a debugger for exclusive display access"
       
    81 
       
    82     |debugger|
       
    83 
       
    84     debugger := super on:ModalDisplay.
       
    85     debugger label:'Debugger'.
       
    86     debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
       
    87     debugger exclusive:true.
       
    88     ^ debugger
       
    89 !
       
    90 
    71 newDebugger
    91 newDebugger
    72     "force creation of a new debugger"
    92     "force creation of a new debugger"
    73 
    93 
    74     cachedDebugger := nil
    94     cachedDebugger := nil
    75 
    95 
    82 
   102 
    83     |aDebugger name|
   103     |aDebugger name|
    84 
   104 
    85     StepInterruptPending := nil.
   105     StepInterruptPending := nil.
    86     aDebugger := self new.
   106     aDebugger := self new.
    87     name := Processor currentProcess nameOrId.
   107     name := Processor activeProcess nameOrId.
    88     aDebugger label:aString , ' (process: ' , name , ')'.
   108     aDebugger label:aString , ' (process: ' , name , ')'.
    89     aDebugger enter.
   109     aDebugger enter.
    90     ^ nil
   110     ^ nil
    91 
   111 
    92     "nil halt"
   112     "nil halt"
    97 
   117 
    98     |aDebugger name|
   118     |aDebugger name|
    99 
   119 
   100     StepInterruptPending := nil.
   120     StepInterruptPending := nil.
   101     aDebugger := self new.
   121     aDebugger := self new.
   102     name := Processor currentProcess nameOrId.
   122     name := Processor activeProcess nameOrId.
   103     aDebugger label:'Debugger (process: ' , name , ')'.
   123     aDebugger label:'Debugger (process: ' , name , ')'.
   104     aDebugger enter.
   124     aDebugger enter.
   105     ^ nil
   125     ^ nil
   106 
   126 
   107     "Debugger enter"
   127     "Debugger enter"
   234     ^ self
   254     ^ self
   235 !
   255 !
   236 
   256 
   237 createOnTop
   257 createOnTop
   238     ^ false "true"
   258     ^ false "true"
       
   259 !
       
   260 
       
   261 realize
       
   262     super realize.
       
   263     exclusive ifTrue:[
       
   264         windowGroup := nil
       
   265     ].
   239 ! !
   266 ! !
   240 
   267 
   241 !DebugView methodsFor:'error handling'!
   268 !DebugView methodsFor:'error handling'!
   242 
   269 
   243 catch:aSymbol with:someArgument for:anObject
   270 catch:aSymbol with:someArgument for:anObject
   299     ] ifFalse:[
   326     ] ifFalse:[
   300         steppedContextAddress := nil.
   327         steppedContextAddress := nil.
   301         s := 'after send'
   328         s := 'after send'
   302     ].
   329     ].
   303 
   330 
   304     name := Processor currentProcess name.
   331     name := Processor activeProcess name.
   305     name isNil ifTrue:[
   332     name isNil ifTrue:[
   306         name := Processor currentProcess id printString.
   333         name := Processor activeProcess id printString.
   307     ].
   334     ].
   308     self label:(s , ' (process: ' , name , ')').
   335     self label:(s , ' (process: ' , name , ')').
   309 
   336 
   310     "release refs to context"
   337     "release refs to context"
   311     where := nil. here := nil.
   338     where := nil. here := nil.
   314 
   341 
   315 !DebugView methodsFor:'basic'!
   342 !DebugView methodsFor:'basic'!
   316 
   343 
   317 busy
   344 busy
   318     ^ busy
   345     ^ busy
       
   346 !
       
   347 
       
   348 exclusive:aBoolean
       
   349     exclusive := aBoolean
   319 !
   350 !
   320 
   351 
   321 enter
   352 enter
   322     "enter the debugger - get and display the context, then start an
   353     "enter the debugger - get and display the context, then start an
   323      exclusive event loop on top of eveything else"
   354      exclusive event loop on top of eveything else"
   343 
   374 
   344     drawableId notNil ifTrue:[
   375     drawableId notNil ifTrue:[
   345         "not the first time - realize at old position"
   376         "not the first time - realize at old position"
   346         self rerealize
   377         self rerealize
   347     ] ifFalse:[
   378     ] ifFalse:[
   348         self realize.
   379         exclusive ifFalse:[
   349     ].
   380             windowGroup isNil ifTrue:[
       
   381                 windowGroup := WindowGroup new.
       
   382                 windowGroup addTopView:self.
       
   383             ].
       
   384         ].
       
   385         self realize
       
   386     ].
       
   387 
   350     self raise.
   388     self raise.
   351     Display synchronizeOutput.
   389     Display synchronizeOutput.
   352 
   390 
   353     where := thisContext.
   391     where := thisContext.
   354     where := where sender.
   392     where := where sender.
   439                 (exitAction == #terminate) ifTrue:[
   477                 (exitAction == #terminate) ifTrue:[
   440                     selectedContext := nil.
   478                     selectedContext := nil.
   441                     ErrorActive := false.
   479                     ErrorActive := false.
   442                     InInterrupt := nil.
   480                     InInterrupt := nil.
   443                     RecursionLimit := oldRecursionLimit.
   481                     RecursionLimit := oldRecursionLimit.
   444                     Processor currentProcess terminate.
   482                     Processor activeProcess terminate.
   445                     'cannot terminate process' printNewline
   483                     'cannot terminate process' printNewline
   446                 ]
   484                 ]
   447             ]
   485             ]
   448         ]
   486         ]
   449     ].
   487     ].
   492 
   530 
   493 controlLoopCatchingErrors
   531 controlLoopCatchingErrors
   494     "setup a catch-block"
   532     "setup a catch-block"
   495     catchBlock := [^ nil].
   533     catchBlock := [^ nil].
   496 
   534 
   497     "this is a kludge:
   535     exclusive ifTrue:[
   498         we do not have multiple processes
   536         "if we do not have multiple processes or its a system process
   499         therefore we start another dispatch loop, which exits when
   537          we start another dispatch loop, which exits when
   500         either continue, resume or step is pressed
   538          either continue, resume or step is pressed
   501         or (via the catchBlock) if an error occures
   539          or (via the catchBlock) if an error occurs.
   502     "
   540          Since our display is an extra exclusive one (ModalDisplay)
   503     device dispatchWhile:[haveControl]
   541          all processing for normal views stops here ...
       
   542         "
       
   543         device dispatchWhile:[haveControl]
       
   544     ] ifFalse:[
       
   545         "we do have multiple processes -
       
   546          simply enter the DebugViews-Windowgroup event loop.
       
   547          effectively suspending event processing for the currently 
       
   548          active group.
       
   549         "
       
   550         self windowGroup eventLoop
       
   551     ]
   504 !
   552 !
   505 
   553 
   506 setContext:aContext
   554 setContext:aContext
   507     |con text
   555     |con text
   508      index "{ Class: SmallInteger }" |
   556      index "{ Class: SmallInteger }" |
   667     "send from menu"
   715     "send from menu"
   668 
   716 
   669     canContinue ifTrue:[
   717     canContinue ifTrue:[
   670         steppedContextAddress := nil.
   718         steppedContextAddress := nil.
   671         haveControl := false.
   719         haveControl := false.
   672         exitAction := #step
   720         exitAction := #step.
       
   721         ProcessorScheduler isPureEventDriven ifFalse:[
       
   722             "exit private event-loop"
       
   723             catchBlock value
       
   724         ].
   673     ]
   725     ]
   674 !
   726 !
   675 
   727 
   676 doStep
   728 doStep
   677     "step from menu"
   729     "step from menu"
   683         ] ifFalse:[
   735         ] ifFalse:[
   684             bigStep := true.
   736             bigStep := true.
   685             steppedContextAddress := ObjectMemory addressOf:(contextArray at:2)
   737             steppedContextAddress := ObjectMemory addressOf:(contextArray at:2)
   686         ].
   738         ].
   687         haveControl := false.
   739         haveControl := false.
   688         exitAction := #step
   740         exitAction := #step.
       
   741         ProcessorScheduler isPureEventDriven ifFalse:[
       
   742             "exit private event-loop"
       
   743             catchBlock value
       
   744         ].
   689     ]
   745     ]
   690 !
   746 !
   691 
   747 
   692 doTraceStep
   748 doTraceStep
   693     "tracestep from menu"
   749     "tracestep from menu"
   702     "abort from menu"
   758     "abort from menu"
   703 
   759 
   704     steppedContextAddress := nil.
   760     steppedContextAddress := nil.
   705     haveControl := false.
   761     haveControl := false.
   706     exitAction := #abort.
   762     exitAction := #abort.
       
   763     ProcessorScheduler isPureEventDriven ifFalse:[
       
   764         "exit private event-loop"
       
   765         catchBlock value
       
   766     ].
   707     ^ self.
   767     ^ self.
   708 
   768 
   709 "obsolete ..."
   769 "obsolete ..."
   710     Processor currentProcess id == 0 ifTrue:[
   770     Processor activeProcess id == 0 ifTrue:[
   711         "dont allow termination of main-thread"
   771         "dont allow termination of main-thread"
   712         exitAction := #abort
   772         exitAction := #abort
   713     ] ifFalse:[
   773     ] ifFalse:[
   714         exitAction := #terminate 
   774         exitAction := #terminate 
   715     ]
   775     ]
   718 doTerminate
   778 doTerminate
   719     "terminate from menu"
   779     "terminate from menu"
   720 
   780 
   721     steppedContextAddress := nil.
   781     steppedContextAddress := nil.
   722     haveControl := false.
   782     haveControl := false.
   723     exitAction := #terminate 
   783     exitAction := #terminate. 
       
   784     ProcessorScheduler isPureEventDriven ifFalse:[
       
   785         "exit private event-loop"
       
   786         catchBlock value
       
   787     ].
   724 !
   788 !
   725 
   789 
   726 
   790 
   727 doResume
   791 doResume
   728     "resume from menu"
   792     "resume from menu"
   729 
   793 
   730     steppedContextAddress := nil.
   794     steppedContextAddress := nil.
   731     haveControl := false.
   795     haveControl := false.
   732     exitAction := #resume
   796     exitAction := #resume.
       
   797     ProcessorScheduler isPureEventDriven ifFalse:[
       
   798         "exit private event-loop"
       
   799         catchBlock value
       
   800     ].
   733 !
   801 !
   734 
   802 
   735 doRestart
   803 doRestart
   736     "restart from menu"
   804     "restart from menu"
   737 
   805 
   738     steppedContextAddress := nil.
   806     steppedContextAddress := nil.
   739     haveControl := false.
   807     haveControl := false.
   740     exitAction := #restart
   808     exitAction := #restart.
       
   809     ProcessorScheduler isPureEventDriven ifFalse:[
       
   810         "exit private event-loop"
       
   811         catchBlock value
       
   812     ].
   741 !
   813 !
   742 
   814 
   743 doTrace
   815 doTrace
   744     |v b|
   816     |v b|
   745 
   817 
   778 
   850 
   779     canContinue ifTrue:[
   851     canContinue ifTrue:[
   780         steppedContextAddress := nil.
   852         steppedContextAddress := nil.
   781         tracing := false.
   853         tracing := false.
   782         haveControl := false.
   854         haveControl := false.
   783         exitAction := #continue
   855         exitAction := #continue.
       
   856         ProcessorScheduler isPureEventDriven ifFalse:[
       
   857             "exit private event-loop"
       
   858             catchBlock value
       
   859         ].
   784     ]
   860     ]
   785 ! !
   861 ! !