DebugView.st
changeset 56 d0cb937cbcaa
parent 55 abfd613f95d9
child 57 36e13831b62d
equal deleted inserted replaced
55:abfd613f95d9 56:d0cb937cbcaa
    29 
    29 
    30 DebugView comment:'
    30 DebugView comment:'
    31 COPYRIGHT (c) 1989 by Claus Gittinger
    31 COPYRIGHT (c) 1989 by Claus Gittinger
    32 	      All Rights Reserved
    32 	      All Rights Reserved
    33 
    33 
    34 $Header: /cvs/stx/stx/libtool/DebugView.st,v 1.19 1994-11-22 23:12:17 claus Exp $
    34 $Header: /cvs/stx/stx/libtool/DebugView.st,v 1.20 1994-11-28 21:11:09 claus Exp $
    35 '!
    35 '!
    36 
    36 
    37 !DebugView class methodsFor:'documentation'!
    37 !DebugView class methodsFor:'documentation'!
    38 
    38 
    39 copyright
    39 copyright
    50 "
    50 "
    51 !
    51 !
    52 
    52 
    53 version
    53 version
    54 "
    54 "
    55 $Header: /cvs/stx/stx/libtool/DebugView.st,v 1.19 1994-11-22 23:12:17 claus Exp $
    55 $Header: /cvs/stx/stx/libtool/DebugView.st,v 1.20 1994-11-28 21:11:09 claus Exp $
    56 "
    56 "
    57 !
    57 !
    58 
    58 
    59 documentation
    59 documentation
    60 "
    60 "
    87 ! !
    87 ! !
    88 
    88 
    89 !DebugView class methodsFor:'instance creation'!
    89 !DebugView class methodsFor:'instance creation'!
    90 
    90 
    91 new
    91 new
    92     "return a DebugView - return a cached debugger if it already
    92     "return a new DebugView - return a cached debugger if it already
    93      exists"
    93      exists"
    94 
    94 
    95     |debugger active|
    95     |debugger active|
    96 
    96 
    97     "need a blocking debugger if no processes or 
    97     "need a blocking debugger if no processes or 
   100 
   100 
   101     active := Processor activeProcess.
   101     active := Processor activeProcess.
   102 
   102 
   103     (ProcessorScheduler isPureEventDriven 
   103     (ProcessorScheduler isPureEventDriven 
   104     or:[(active priority >= Processor userInterruptPriority)
   104     or:[(active priority >= Processor userInterruptPriority)
   105     or:[active nameOrId endsWith:'dispatcher']]) ifTrue:[
   105     or:[active id == 0
       
   106     or:[active nameOrId endsWith:'dispatcher']]]) ifTrue:[
   106 	CachedExclusive isNil ifTrue:[
   107 	CachedExclusive isNil ifTrue:[
   107 	    debugger := self newExclusive
   108 	    debugger := self newExclusive
   108 	] ifFalse:[
   109 	] ifFalse:[
   109 	    debugger := CachedExclusive.
   110 	    debugger := CachedExclusive.
   110 	    CachedExclusive := nil.
   111 	    CachedExclusive := nil.
   442     where := here.
   443     where := here.
   443     isWrap := false.
   444     isWrap := false.
   444     wrappedMethod := nil.
   445     wrappedMethod := nil.
   445     5 timesRepeat:[
   446     5 timesRepeat:[
   446 "/ where selector printNL.
   447 "/ where selector printNL.
   447 	method := where method.
   448 	where notNil ifTrue:[
   448 	(method notNil and:[method isWrapped]) ifTrue:[
   449 	    method := where method.
   449 	    "
   450 	    (method notNil and:[method isWrapped]) ifTrue:[
   450 	     in a wrapper method
   451 		"
   451 	    "
   452 		 in a wrapper method
   452 	    wrappedMethod ~~ method ifTrue:[
   453 		"
   453 		wrappedMethod := method.
   454 		wrappedMethod ~~ method ifTrue:[
   454 		lastWrappedConAddr := ObjectMemory addressOf:where.
   455 		    wrappedMethod := method.
   455 		where sender receiver == method originalMethod ifFalse:[
   456 		    lastWrappedConAddr := ObjectMemory addressOf:where.
   456 		    isWrap := true.
   457 		    where sender receiver == method originalMethod ifFalse:[
   457 		]
   458 			isWrap := true.
   458 	    ] ifFalse:[
   459 		    ]
   459 		(ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
   460 		] ifFalse:[
       
   461 		    (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
   460 "/ 'change stepCon from: ' print.
   462 "/ 'change stepCon from: ' print.
   461 "/  (steppedContextAddress printStringRadix:16)print.
   463 "/  (steppedContextAddress printStringRadix:16)print.
   462 "/ ' to: ' print.
   464 "/ ' to: ' print.
   463 "/  (lastWrappedConAddr printStringRadix:16)printNL.
   465 "/  (lastWrappedConAddr printStringRadix:16)printNL.
   464 
   466 
   465 		    steppedContextAddress := lastWrappedConAddr
   467 			steppedContextAddress := lastWrappedConAddr
       
   468 		    ]
   466 		]
   469 		]
   467 	    ]
   470 	    ].
   468 	].
   471 	    where := where sender
   469 	where := where sender
   472 	]
   470     ].
   473     ].
   471 
   474 
   472     isWrap ifTrue:[
   475     isWrap ifTrue:[
   473 "/ 'ignore wrap' printNL.
   476 "/ 'ignore wrap' printNL.
   474 	"
   477 	"
   711     canContinue := true.
   714     canContinue := true.
   712     exitAction := nil.
   715     exitAction := nil.
   713 
   716 
   714     self controlLoop.
   717     self controlLoop.
   715 
   718 
       
   719     "
       
   720      release all context stuff.
       
   721      This is required, since the debugger is reused,
       
   722      to avoid keeping references to the debuggees objects
       
   723      forever.
       
   724     "
   716     contextArray := nil.
   725     contextArray := nil.
       
   726     codeView contents:nil.
       
   727     codeView acceptAction:nil.
       
   728     contextView contents:nil.
   717     receiverInspector release.
   729     receiverInspector release.
   718     contextInspector release.
   730     contextInspector release.
   719 
   731 
   720     (exitAction == #step) ifFalse:[
   732     (exitAction == #step) ifFalse:[
   721 	self unrealize.
   733 	self unrealize.
   722 	device synchronizeOutput.
   734 	device synchronizeOutput.
   723 	(exitAction == #abort) ifTrue:[
   735 	(exitAction == #abort) ifTrue:[
   724 	    selectedContext := nil.
   736 	    selectedContext := nil.
   725 	    InInterrupt := nil.
       
   726 	    busy := false.
   737 	    busy := false.
   727 	    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   738 	    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   728 	    "
   739 	    "
   729 	     have to catch errors occuring in unwind-blocks
   740 	     have to catch errors occuring in unwind-blocks
   730 	    "
   741 	    "
   739 	].
   750 	].
   740 	(exitAction == #return) ifTrue:[
   751 	(exitAction == #return) ifTrue:[
   741 	    selectedContext notNil ifTrue:[
   752 	    selectedContext notNil ifTrue:[
   742 		con := selectedContext.
   753 		con := selectedContext.
   743 		selectedContext := nil.
   754 		selectedContext := nil.
   744 		InInterrupt := nil.
       
   745 		busy := false.
   755 		busy := false.
   746 		exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   756 		exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   747 		"
   757 		"
   748 		 have to catch errors occuring in unwind-blocks
   758 		 have to catch errors occuring in unwind-blocks
   749 		"
   759 		"
   759 	] ifFalse:[
   769 	] ifFalse:[
   760 	    (exitAction == #restart) ifTrue:[
   770 	    (exitAction == #restart) ifTrue:[
   761 		selectedContext notNil ifTrue:[
   771 		selectedContext notNil ifTrue:[
   762 		    con := selectedContext.
   772 		    con := selectedContext.
   763 		    selectedContext := nil.
   773 		    selectedContext := nil.
   764 		    InInterrupt := nil.
       
   765 		    busy := false.
   774 		    busy := false.
   766 		    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   775 		    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   767 		    "
   776 		    "
   768 		     have to catch errors occuring in unwind-blocks
   777 		     have to catch errors occuring in unwind-blocks
   769 		    "
   778 		    "
   777 		    'cannot restart selected context' errorPrintNL
   786 		    'cannot restart selected context' errorPrintNL
   778 		]
   787 		]
   779 	    ] ifFalse:[
   788 	    ] ifFalse:[
   780 		((exitAction == #terminate) or:[exitAction == #quickTerminate]) ifTrue:[
   789 		((exitAction == #terminate) or:[exitAction == #quickTerminate]) ifTrue:[
   781 		    selectedContext := nil.
   790 		    selectedContext := nil.
   782 		    InInterrupt := nil.
       
   783 		    busy := false.
   791 		    busy := false.
   784 		    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   792 		    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
   785 		    exitAction == #quickTerminate ifTrue:[
   793 		    exitAction == #quickTerminate ifTrue:[
   786 			Processor activeProcess terminateNoSignal
   794 			Processor activeProcess terminateNoSignal
   787 		    ] ifFalse:[
   795 		    ] ifFalse:[
   914     haveControl := true.
   922     haveControl := true.
   915     [haveControl] whileTrue:[
   923     [haveControl] whileTrue:[
   916 	self controlLoopCatchingErrors
   924 	self controlLoopCatchingErrors
   917     ].
   925     ].
   918     catchBlock := nil.
   926     catchBlock := nil.
   919 
       
   920     codeView contents:nil.
       
   921     codeView acceptAction:nil.
       
   922     contextView contents:nil.
       
   923     receiverInspector release.
       
   924     contextInspector release
       
   925 !
   927 !
   926 
   928 
   927 controlLoopCatchingErrors
   929 controlLoopCatchingErrors
   928     "setup a self removing catch-block"
   930     "setup a self removing catch-block"
   929     catchBlock := [catchBlock := nil. ^ nil].
   931     catchBlock := [catchBlock := nil. ^ nil].
  1184 !DebugView methodsFor:'user interaction'!
  1186 !DebugView methodsFor:'user interaction'!
  1185 
  1187 
  1186 showSelection:lineNr
  1188 showSelection:lineNr
  1187     "user clicked on a header line - show selected code in textView"
  1189     "user clicked on a header line - show selected code in textView"
  1188 
  1190 
  1189     |con homeContext sel method code
  1191     |con homeContext sel method code canAccept
  1190      implementorClass lineNrInMethod rec m line|
  1192      implementorClass lineNrInMethod rec m line|
  1191 
  1193 
  1192     contextArray notNil ifTrue:[
  1194     contextArray notNil ifTrue:[
  1193 	lineNr <= contextArray size ifTrue:[
  1195 	lineNr <= contextArray size ifTrue:[
  1194 	    con := contextArray at:lineNr.
  1196 	    con := contextArray at:lineNr.
  1219 	    "
  1221 	    "
  1220 	    self showError:'** sorry; cannot show code of optimized blocks (yet) **'
  1222 	    self showError:'** sorry; cannot show code of optimized blocks (yet) **'
  1221 	] ifFalse:[
  1223 	] ifFalse:[
  1222 	    sel := homeContext selector.
  1224 	    sel := homeContext selector.
  1223 	    sel notNil ifTrue:[
  1225 	    sel notNil ifTrue:[
       
  1226 		canAccept := true.
       
  1227 
  1224 "/                implementorClass := homeContext searchClass whichClassImplements:sel.
  1228 "/                implementorClass := homeContext searchClass whichClassImplements:sel.
  1225 		implementorClass := homeContext methodClass.
  1229 		implementorClass := homeContext methodClass.
  1226 		implementorClass isNil ifTrue:[
  1230 		implementorClass isNil ifTrue:[
  1227 		    self showError:'** no method - no source **'
  1231 		    "
       
  1232 		     special: look if this context was create by
       
  1233 		     valueWithReceiver kind of method invocation;
       
  1234 		     if so, grab the method from the sender and show it
       
  1235 		    "
       
  1236 "/                    con sender selector printNL.
       
  1237 		    (con sender notNil
       
  1238 		    and:[(con sender selector == #valueWithReceiver:arguments:selector:search:)
       
  1239 		    and:[con sender receiver isKindOf:Method]]) ifTrue:[
       
  1240 			method := con sender receiver.
       
  1241 			code := method source.
       
  1242 			canAccept := false.
       
  1243 		    ] ifFalse:[
       
  1244 			self showError:'** no method - no source **'
       
  1245 		    ]
  1228 		] ifFalse:[
  1246 		] ifFalse:[
  1229 		    method := implementorClass compiledMethodAt:sel.
  1247 		    method := implementorClass compiledMethodAt:sel.
  1230 		    code := method source.
  1248 		    code := method source.
  1231 		    code isNil ifTrue:[
  1249 		    code isNil ifTrue:[
  1232 			method sourceFilename notNil ifTrue:[
  1250 			method sourceFilename notNil ifTrue:[
  1238 			    self showError:'** no source **'
  1256 			    self showError:'** no source **'
  1239 			]
  1257 			]
  1240 		    ]
  1258 		    ]
  1241 		].
  1259 		].
  1242 		code isNil ifTrue:[
  1260 		code isNil ifTrue:[
  1243 		    codeView acceptAction:nil.
  1261 		    canAccept := false.
  1244 		] ifFalse:[
  1262 		] ifFalse:[
  1245 		    codeView contents:code.
  1263 		    codeView contents:code.
  1246 		    (lineNrInMethod notNil and:[lineNrInMethod ~~ 0]) ifTrue:[
  1264 		    (lineNrInMethod notNil and:[lineNrInMethod ~~ 0]) ifTrue:[
  1247 			lineNrInMethod > codeView list size ifTrue:[
  1265 			lineNrInMethod > codeView list size ifTrue:[
  1248 			    lineNrInMethod := codeView list size + 1
  1266 			    lineNrInMethod := codeView list size + 1
  1249 			].
  1267 			].
  1250 			codeView selectLine:lineNrInMethod.
  1268 			codeView selectLine:lineNrInMethod.
  1251 			codeView makeSelectionVisible
  1269 			codeView makeSelectionVisible
  1252 		    ].
  1270 		    ].
       
  1271 		].
       
  1272 
       
  1273 		canAccept ifTrue:[
  1253 		    codeView acceptAction:[:code | self codeAccept:code asString]
  1274 		    codeView acceptAction:[:code | self codeAccept:code asString]
       
  1275 		] ifFalse:[
       
  1276 		    codeView acceptAction:nil.
  1254 		].
  1277 		].
  1255 
  1278 
  1256 		"fetch rec here - so we wont need context in doItAction"
  1279 		"fetch rec here - so we wont need context in doItAction"
  1257 		rec := homeContext receiver.
  1280 		rec := homeContext receiver.
  1258 	    ]
  1281 	    ]