MessageTracer.st
changeset 4547 39478d06eadd
parent 4533 d75502a4c955
equal deleted inserted replaced
4546:88e32ac10e79 4547:39478d06eadd
       
     1 "{ Encoding: utf8 }"
       
     2 
     1 "
     3 "
     2  COPYRIGHT (c) 1994 by Claus Gittinger
     4  COPYRIGHT (c) 1994 by Claus Gittinger
     3 	      All Rights Reserved
     5 	      All Rights Reserved
     4 
     6 
     5  This software is furnished under a license and may be used
     7  This software is furnished under a license and may be used
  3930     |s|
  3932     |s|
  3931 
  3933 
  3932     anObject isProtoObject ifTrue:[
  3934     anObject isProtoObject ifTrue:[
  3933         s := anObject class nameWithArticle
  3935         s := anObject class nameWithArticle
  3934     ] ifFalse:[
  3936     ] ifFalse:[
  3935         s := anObject printString.
  3937         Exception handle:[:ex |
  3936         s size > 40 ifTrue:[
  3938             "/ in case an error happens when we try to print an uninitialized object
  3937             s := s contractTo:40.
  3939             "/ (eg. when tracing OrderedCollection new initContents)
  3938         ].
  3940             s := anObject class nameWithArticle,'(**error in printString**)'
       
  3941         ] do:[
       
  3942             s := anObject printString.
       
  3943             s size > 40 ifTrue:[
       
  3944                 s := s contractTo:40.
       
  3945             ].
       
  3946         ]
  3939     ].
  3947     ].
  3940     aStream nextPutAll:s
  3948     aStream nextPutAll:s
  3941 !
  3949 !
  3942 
  3950 
  3943 printSender:aSenderContext on:aStream
  3951 printSender:aSenderContext on:aStream
  4165     "Created: / 05-03-2007 / 15:32:43 / cg"
  4173     "Created: / 05-03-2007 / 15:32:43 / cg"
  4166 ! !
  4174 ! !
  4167 
  4175 
  4168 !MessageTracer::PrintingMessageTracer methodsFor:'accessing'!
  4176 !MessageTracer::PrintingMessageTracer methodsFor:'accessing'!
  4169 
  4177 
  4170 output:something
  4178 output:aWriteStream
  4171     output := something.
  4179     output := aWriteStream.
  4172 ! !
  4180 ! !
  4173 
  4181 
  4174 !MessageTracer::PrintingMessageTracer methodsFor:'trace helpers'!
  4182 !MessageTracer::PrintingMessageTracer methodsFor:'trace helpers'!
       
  4183 
       
  4184 callLevelOf:sender
       
  4185     "called for every send while tracing"
       
  4186 
       
  4187     |level con rcvr|
       
  4188 
       
  4189     level := 0.
       
  4190     con := sender.
       
  4191     [con notNil
       
  4192       and:[(rcvr := con receiver) ~~ self
       
  4193       and:[rcvr ~~ tracedBlock]]
       
  4194     ] whileFalse:[
       
  4195         con := con sender.
       
  4196         level := level + 1.
       
  4197     ].
       
  4198     ^ level
       
  4199 !
  4175 
  4200 
  4176 stepInterrupt
  4201 stepInterrupt
  4177     "called for every send while tracing"
  4202     "called for every send while tracing"
  4178 
  4203 
  4179     |ignore sel con r outStream senderContext|
  4204     |ignore sel con r outStream senderContext level|
  4180 
  4205 
  4181     StepInterruptPending := nil.
  4206     StepInterruptPending := nil.
  4182     con := senderContext := thisContext sender.
  4207     con := senderContext := thisContext sender.
       
  4208 
       
  4209     outStream := output notNil 
       
  4210                     ifTrue:[output] 
       
  4211                     ifFalse:[Processor activeProcess stderr].
       
  4212 
  4183     ignore := false.
  4213     ignore := false.
  4184     outStream := output notNil ifTrue:[output] ifFalse:[Processor activeProcess stderr].
       
  4185 
       
  4186     con receiver == Processor ifTrue:[
  4214     con receiver == Processor ifTrue:[
  4187         (sel := con selector) == #threadSwitch: ifTrue:[
  4215         (sel := con selector) == #threadSwitch: ifTrue:[
  4188             ignore := true.
  4216             ignore := true.
  4189         ].
  4217         ].
  4190         sel == #timerInterrupt ifTrue:[
  4218         sel == #timerInterrupt ifTrue:[
  4199     ignore ifFalse:[
  4227     ignore ifFalse:[
  4200         con markForInterruptOnUnwind.
  4228         con markForInterruptOnUnwind.
  4201 
  4229 
  4202         ((r := con receiver) ~~ self
  4230         ((r := con receiver) ~~ self
  4203         and:[r ~~ tracedBlock]) ifTrue:[
  4231         and:[r ~~ tracedBlock]) ifTrue:[
  4204             traceDetail == #fullIndent ifTrue:[
  4232             ((traceDetail == #fullIndent) or:[traceDetail == #indent]) ifTrue:[
  4205                 [con notNil
  4233                 level := self callLevelOf:con.
  4206                 and:[(r := con receiver) ~~ self
  4234                 outStream spaces:level.
  4207                 and:[r ~~ tracedBlock]]] whileTrue:[
  4235             ].
  4208                     '  ' printOn:outStream.
  4236             ((traceDetail == #fullIndent) or:[traceDetail == true]) ifTrue:[
  4209                     con := con sender.
  4237                 self class printFull:senderContext on:outStream withSender:false.
  4210                 ].
       
  4211                 con := senderContext.
       
  4212                 self class printFull:con on:outStream withSender:false.
       
  4213             ] ifFalse:[
  4238             ] ifFalse:[
  4214                 traceDetail == #indent ifTrue:[
  4239                 senderContext printOn:outStream.
  4215                     [con notNil
  4240                 outStream cr.
  4216                     and:[(r := con receiver) ~~ self
       
  4217                     and:[r ~~ tracedBlock]]] whileTrue:[
       
  4218                         '  ' printOn:outStream.
       
  4219                         con := con sender.
       
  4220                     ].
       
  4221                     con := senderContext.
       
  4222                     con printOn:outStream.
       
  4223                     outStream cr.
       
  4224                 ] ifFalse:[
       
  4225                     traceDetail == true ifTrue:[
       
  4226                         self class printFull:con on:outStream withSender:true.
       
  4227                     ] ifFalse:[
       
  4228                         con printOn:outStream.
       
  4229                         outStream cr.
       
  4230                     ]
       
  4231                 ]
       
  4232             ].
  4241             ].
  4233         ].
  4242         ].
  4234     ].
  4243     ].
  4235 
  4244 
  4236     ObjectMemory flushInlineCaches.
  4245     ObjectMemory flushInlineCaches.