|
1 # Copyright (c) 2005-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
2 # Copyright (c) 2005-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # To Do: |
|
16 # - excludeByAddr{} and multiple objects using same memory address ? |
|
17 # - distinguish between threads for context, eg $lastDispatchDestination |
|
18 # parselog.pl [<arguments>] <log file> |
|
19 # Arguments: |
|
20 # -x <ini file> Specify ini file containing, amongst other things, names of classes and/or messages |
|
21 # to exclude. Contains sections named "[ExcludeClass]", "[ExcludeMessage]", |
|
22 # "[ExcludeShortName]" and "[ExcludeIpc]" each followed by the names |
|
23 # to exclude, one per line. Note that "ExcludeShortName" section refers |
|
24 # to the shortened class name as displayed on the output, whereas "ExcludeClass" |
|
25 # refers to original full class names. Also contains a "[MessageArguments]" section |
|
26 # for describing which arguments to display for specified messages. |
|
27 # -p Include posted messages in the output as well as received messages |
|
28 # -X<n> Exclude certain information from the display. <n> is a decimal number which |
|
29 # is composed of one or more of the following values logical-or'ed together: |
|
30 # 1 exclude activities being started |
|
31 # 2 exclude activity transitions |
|
32 # 4 exclude parking+unparking |
|
33 # 8 mark source .LOG line milestones in left column |
|
34 # -s<n> Include additional information. <n> is a decimal number which |
|
35 # is composed of one or more of the following values logical-or'ed together: |
|
36 # 1 include client IPC requests |
|
37 # 2 include client IPC completions (async requests only) |
|
38 # 4 include ESOCK session creation |
|
39 # 8 display activity name along with each tuple line (e.g. "(IpCprNoBearer) (CoreNetStates::TSendBindTo, CoreNetStates::TAwaitingBindToComplete)") |
|
40 # 16 display AddClient/RemoveClient operations |
|
41 |
|
42 use strict; |
|
43 |
|
44 require 'getopts.pl'; |
|
45 |
|
46 my $version = "2.1 (24/02/09)"; |
|
47 |
|
48 # |
|
49 # Internal Options |
|
50 # |
|
51 # BUG BEWARE: A timestamp or milestone displayed on lefthand side overwrites any fast count delta that would have been displayed there |
|
52 my $fastCount = 0; # Add fast count delta on lefthand side. |
|
53 |
|
54 my $globalIndex = 1; |
|
55 my $lifeStage = 0; # 0 = not running or shutting down, 1 = during boot, 2 = main phase |
|
56 |
|
57 |
|
58 our($opt_p,$opt_s,$opt_x,$opt_X); |
|
59 |
|
60 Getopts("ps:x:X:"); |
|
61 |
|
62 |
|
63 ### to get 1st line of latest log: type log.txt | perl -e "while(<>){if(/^#Logging started/){$a=$.;print $a.' '}};print $a" |
|
64 |
|
65 # |
|
66 # objectNameParse is an array of hashes used to shorten class names and specify left-to-right |
|
67 # object placement order. It is an array of: |
|
68 # |
|
69 # { SubString => <sub-string>, Replacement => <sub-string replacement>, Order => <order> } |
|
70 # |
|
71 # For each object name, the array is scanned. Any occurrences of <sub-string> are |
|
72 # replaced with <sub-string replacement>. The first non-zero value of <order> is taken |
|
73 # to be the placement order. |
|
74 # |
|
75 # Note that order of hashes within the array is important - for example, "ConnectionProvider" must appear after all |
|
76 # entries that specify sub-strings that themselves contain the string "ConnectionProvider". |
|
77 |
|
78 my @objectNameParse; |
|
79 |
|
80 # |
|
81 # Variables/constants concerned with Arguments file. |
|
82 # |
|
83 |
|
84 use constant ArgumentSignedDecimal => 0; |
|
85 use constant ArgumentNode => 1; |
|
86 my %argumentFormatToConstant = ( "node" => ArgumentNode ); # used to have several other options |
|
87 my %arguments; |
|
88 |
|
89 # Support for AddClient/RemoveClient |
|
90 my %clients; |
|
91 my %clientTypeToDirection = ( "100" => "<", "200" => "^", "400" => "v", "800" => ">"); |
|
92 |
|
93 # Support for EThreadIdentification |
|
94 my $pendingProcessCreate; |
|
95 my %NThreadToName; |
|
96 my %DProcessToName; |
|
97 my %processUsingESock = ( "DhcpServ" => 1, "TE_RConnectionSuite" => 1, "dnd" => 1 ); |
|
98 my $sessionGenerationCount = 1; |
|
99 my %uniqueProcessName; |
|
100 |
|
101 my $logline = 1; |
|
102 my $mileStoneInterval = 250; |
|
103 my $lastMileStone = 1; |
|
104 my $lastDispatchDestination; |
|
105 my $excludeAllSingleTuples; |
|
106 my $lastTimestamp; |
|
107 my $lastFastCount; |
|
108 |
|
109 my %excludeByAddr; |
|
110 my %excludeMessage; |
|
111 my %excludeClass; |
|
112 my %excludeShortName; |
|
113 my %excludeSingleTuple; |
|
114 |
|
115 my %activityNode; |
|
116 my %activityName; |
|
117 |
|
118 my %msgAddrToIpc; |
|
119 my %msgAddrToExe; |
|
120 my %symtab; |
|
121 my %excludeIpc; |
|
122 my %uniqueNames; |
|
123 my %deadList; |
|
124 my %subSessTab; # maps subsession addr to node addr |
|
125 my @notableText; |
|
126 my @mangled; |
|
127 |
|
128 readIniFile(); |
|
129 |
|
130 while (<>) { |
|
131 if(!($opt_X & 8) && ($logline - $lastMileStone) > $mileStoneInterval) |
|
132 { |
|
133 $lastMileStone += $mileStoneInterval; |
|
134 print "l #$lastMileStone\n"; |
|
135 } |
|
136 |
|
137 print stderr "WARNING: Probable deleted heap at $logline:\n$_\n" if(m/-555819298|dededede/i); |
|
138 print stderr "WARNING: Probable uninitialised stack at $logline:\n$_\n" if(m/-858993460|cccccccc|690563369|29292929/i); |
|
139 |
|
140 #OLD: |
|
141 #esock Mesh a 47 W6: TCFSignatureBase: DispatchL(): Sender=0c181b9c, Recipient=0c181b9c, Message=ECFStateChange, Activity=ECFActivityNull [0000] 1000,0 |
|
142 #NEW: |
|
143 #12362,194,2,3745950947,0,0x00a1c488,ENodeMessages: [STARTBLOCK=TransportReceiver::DispatchMessage] aSender: [Address=[iPtr=0x0d9fa138] ] aRecipient: [Address=[iPtr=0x0db79148] [iNodeCtx=ActivityNoBearer] ] aMessage: [Signature=TSigAddrUpdate] [iMessageId=0x10285a57:DataClientRouted] [iAddrUpdate=[iSrcSockAddr=] [iDestSockAddr=] [iProtocolId=0x00000011] [iIapId=0x00000001] ] [ENDBLOCK=TransportReceiver::DispatchMessage] |
|
144 |
|
145 if (/.*BLOCK=Dispatch/) { |
|
146 doFastCount() if ($fastCount); |
|
147 parsePostDispatchMessageLine("BLOCK=Dispatch", "r"); |
|
148 } |
|
149 #OLD: |
|
150 #esock DCMsgs a 47 W6: RClientII: PostMessage(): Sender=0c18241c, Recipient=0c182374, Message=ECFSelect, Activity=ECFActivityNull [0000] |
|
151 #NEW: |
|
152 #5072,194,2,4009228503,0,0x00a1b628,ENodeMessages: [STARTBLOCK=TransportSender::PostMessage] aPostFrom: [Address=[iPtr=0x0d925558] ] aPostTo: [Address=[iPtr=0x0d925558] ] args: [Signature=TSigStateChange] [Message=StateChange] [iMessageId=[iMessageId=EStateChange] [iRealmId=0x10285a56] ] [iStateChange=[iStage=0x000009c5] [iError=0x00000000] ] [ENDBLOCK=TransportSender::PostMessage] |
|
153 elsif ($opt_p == 1 && (/.*BLOCK=Post/)) { |
|
154 doFastCount() if ($fastCount); |
|
155 parsePostDispatchMessageLine("BLOCK=Post", "p"); |
|
156 } |
|
157 #OLD: |
|
158 #CFNode MetaConn a 47 W6: CIpTierManagerFactory 0c1822d0: created [MCFNode 0c1822d8] [96] |
|
159 #NEW: |
|
160 #250,194,1,1864213751,0,0x00f3e114,ENodeMessages: CFactoryContainerNode 0e571204: created [MNode 0e571220] [44] |
|
161 elsif (/.*created \[ANode=0x([0-9A-Fa-f]{8})\]/) { |
|
162 my ($name,$realaddr,$nodeaddr) = m/(\w+) ([0-9A-Fa-f]{8}):\tcreated \[ANode=0x([0-9A-Fa-f]{8})\]/; |
|
163 $realaddr =~ s/^0x//; |
|
164 $nodeaddr =~ s/^0x//; |
|
165 my $doExclude = 1; |
|
166 if (! defined $excludeClass{$name}) |
|
167 { |
|
168 my $order = parseObjectName(\$name); |
|
169 $name = uniquifyName($name); |
|
170 if (!defined $excludeShortName{$name}) |
|
171 { |
|
172 # if (defined $symtab{$nodeaddr}) |
|
173 # { |
|
174 # print "**** SYMTAB already defined - $nodeaddr, $name, $symtab{$nodeaddr}\n"; |
|
175 # } |
|
176 $symtab{$nodeaddr} = $name; |
|
177 doFastCount() if ($fastCount); |
|
178 print "oc $name $order $nodeaddr\n"; |
|
179 print "t $name ($nodeaddr created)\n"; |
|
180 $doExclude = 0; |
|
181 delete $deadList{$nodeaddr} if defined($deadList{$nodeaddr}); |
|
182 $subSessTab{$realaddr} = $nodeaddr; |
|
183 } |
|
184 } |
|
185 if ($doExclude) |
|
186 { |
|
187 $excludeByAddr{$nodeaddr} = 1; |
|
188 } |
|
189 } |
|
190 elsif (/:\t~.*\[ANode=0x([0-9A-Fa-f]{8})\]/) { |
|
191 my ($name,$realaddr,$nodeaddr) = m/(\w+) ([0-9A-Fa-f]{8}):\t~.*\[ANode=0x([0-9A-Fa-f]{8})\]/; |
|
192 $realaddr =~ s/^0x//; |
|
193 $nodeaddr =~ s/^0x//; |
|
194 if (! defined $excludeClass{$name} && defined($symtab{$nodeaddr}) && !defined($deadList{$nodeaddr})) |
|
195 { |
|
196 $deadList{$nodeaddr} = 1; |
|
197 $name = $symtab{$nodeaddr}; |
|
198 doFastCount() if ($fastCount); |
|
199 print "od $name $nodeaddr\n"; |
|
200 print "t $name ($nodeaddr destroyed)\n"; |
|
201 delete $subSessTab{$realaddr}; |
|
202 } |
|
203 } |
|
204 elsif (/^#Time = (.*)$/) |
|
205 { |
|
206 print "l $1\n"; |
|
207 } |
|
208 elsif (/W0: SocketServer::InitL\(\) Done/) |
|
209 { |
|
210 print "l ^Booting\n"; |
|
211 $lifeStage = 1; |
|
212 } |
|
213 elsif ($lifeStage == 1 && /CDealer::ProcessConfigurationComplete\(\)/) |
|
214 { |
|
215 print "l ^Booted\n"; |
|
216 $lifeStage = 2; |
|
217 } |
|
218 elsif ($lifeStage == 2 && /CFUnbindMessageReceived/) |
|
219 { |
|
220 print "l ^Shutting-down\n"; |
|
221 $lifeStage = 0; |
|
222 } |
|
223 #1061,194,2,1212990838,0,0x00a1b488,ENodeMessages: [STARTBLOCK=Context] CNodeActivityBase 0d922584: StartL->starting activity Node: [MNode=0x0d9229e0] Sender: [Address=[iThread=0x0006] [iPtr=0x0d922338] ] Recipient: [Address=[iThread=0x0006] [iPtr=0x0d9229e0] ] aContext.iMessage: [Signature=0x00000000:0xfdfdfdfd] [STARTBLOCK=Activity] [Activity=MCprControlClientJoin] [CurrentTriple=Idle] [ENDBLOCK=Activity] [ENDBLOCK=Context] |
|
224 elsif (/starting activity.*?\[ANode=0x([0-9A-Fa-f]{8})\].*\[Activity=(\w*)\]/) |
|
225 { |
|
226 if (!($opt_X & 1)) |
|
227 { |
|
228 my $dest = $1; |
|
229 my $activity = $2; |
|
230 |
|
231 if ($activity eq "Undefined") { |
|
232 # An activity name of "Undefined" may mean that the non-debug macros for defining |
|
233 # the activity and triples have been used, as these do not compile-in the activity name. |
|
234 $activity = "Activity name unknown" |
|
235 } |
|
236 |
|
237 if (! defined $excludeByAddr{$dest}) |
|
238 { |
|
239 if (m/C\w+ ([0-9a-fA-F]{8}):/) { |
|
240 my $activityAddr = $1; |
|
241 $activityNode{$activityAddr} = $dest; |
|
242 $activityName{$activityAddr} = $activity; |
|
243 # emit activity create tag |
|
244 doFastCount() if ($fastCount); |
|
245 print "ac ", objectName($dest), " $activityAddr $activity\n"; |
|
246 print "t ", objectName($dest), " {0,200,0} ($activity)\n"; |
|
247 } |
|
248 else { |
|
249 # OLD OLD OLD |
|
250 # Hackery - "Node=" in the "starting activity" line actually contains the |
|
251 # address of the ACFNodeBase rather than the MCFNode - the latter of which we work |
|
252 # with in this script - hence the use of $lastDispatchDestination. However, sanity check |
|
253 # whether the two addresses are at least within 8 bytes of each other. |
|
254 # |
|
255 #if (abs(hex($dest) - hex ($lastDispatchDestination)) <= 8) |
|
256 # { |
|
257 # print "t ", objectName($lastDispatchDestination), " {0,200,0} ($activity)\n"; |
|
258 # } |
|
259 } |
|
260 } |
|
261 else |
|
262 { |
|
263 # print "Ignored $logline - $_\n"; |
|
264 } |
|
265 } |
|
266 } |
|
267 elsif ($opt_s != 0 && (/CSockSession[\(\s]/ || /CSockSubSession\(.*\):/ || /CWorkerSubSession\(/ || |
|
268 /RSafeMessage\(/) || /RMessage2::Complete/) |
|
269 { |
|
270 if (($opt_s & 1) && /CSockSession\(.{8}\):\s+ServiceL, Message\((.{8})\) \[(\w+)\] "(.*)" int3=(.{8})/) |
|
271 { |
|
272 my $msgAddr = $1; |
|
273 my $exe = $3; |
|
274 my $ipc = $2; |
|
275 my $subSessNode = $subSessTab{$4}; |
|
276 $ipc .= "($symtab{$subSessNode})" if defined $subSessNode; # append the name of the node |
|
277 $msgAddrToIpc{$msgAddr} = $ipc; |
|
278 $msgAddrToExe{$msgAddr} = $exe; |
|
279 if (! excludeIpc($ipc)) |
|
280 { |
|
281 $exe = truncateExeName($exe); |
|
282 $exe = uniqueProcessName($exe); |
|
283 # adding "!" to beginning of object name forces the parseseq.pl script to display |
|
284 # the object despite the fact that it would normally hide objects from the final display |
|
285 # that have no actual messages to/from them. |
|
286 doFastCount() if ($fastCount); |
|
287 print "pn line $logline\n"; |
|
288 print "t !$exe $ipc\n"; |
|
289 } |
|
290 } |
|
291 elsif (($opt_s & 4) && /CSockSession\s*(.{8}):\s+ConstructL.*"(.*)"/) |
|
292 { |
|
293 # W0: CSockSession 0be839a8: ConstructL() pid=4c "Te_Cap_RConnDHCP_sc.exe" |
|
294 my $session = $1; |
|
295 my $exe = $2; |
|
296 $exe = truncateExeName($exe); |
|
297 $exe = uniqueProcessName($exe); |
|
298 # print "oc !$exe\n"; |
|
299 if ($opt_s & 32) { |
|
300 print "ac !$exe $session Session-$session-$sessionGenerationCount\n"; |
|
301 ++$sessionGenerationCount; |
|
302 } |
|
303 print "t !$exe CSockSession $session\n"; |
|
304 $processUsingESock{$exe} = 1; |
|
305 } |
|
306 elsif (($opt_s & 4) && /~CSockSession\s*\((.{8})\):\s*"(.*)"/) |
|
307 { |
|
308 #W0: ~CSockSession(00682bf0): "Te_RConnectionSuite.exe" |
|
309 my $session = $1; |
|
310 my $exe = $2; |
|
311 $exe = truncateExeName($exe); |
|
312 $exe = uniqueProcessName($exe); |
|
313 print "t !$exe ~CSockSession $session\n"; |
|
314 if ($opt_s & 32) { |
|
315 print "ad $session\n"; |
|
316 } |
|
317 } |
|
318 elsif (($opt_s & 2) && |
|
319 (/CWorkerSubSession\(.{8}\):\s*CompleteMessage\((.{8})\) with (.+), session .{8}/ || |
|
320 # /ProcessMessageL, session=.{8}, RMessage2::Complete \((.{8})\) with ([-\d]+)\./ || |
|
321 /~CESockClientActivityBase..{8}.\s*RMessage2::Complete \((.{8})\) with ([-\d]+)\./ || |
|
322 /RSafeMessage\((.{8})\)::Complete\((\d+)\) - session .{8}/)) |
|
323 { |
|
324 # W6: CPlayer: ProcessMessageL, session=0be839a8, RMessage2::Complete (00de5538) with 0. |
|
325 # W0: CWorkerSubSession(0c941bc4): CompleteMessage(00de1a6c) with -3, session 0be839a8. |
|
326 # W6: ~CESockClientActivityBase=0c941f8c, RMessage2::Complete (00de5538) with 0. |
|
327 |
|
328 my $msgAddr = $1; |
|
329 my $ret = $2; |
|
330 my $exe = $msgAddrToExe{$msgAddr}; |
|
331 my $ipc = $msgAddrToIpc{$msgAddr}; |
|
332 if($ipc =~ /^E.+Create$/) |
|
333 { |
|
334 # For subsession creation try to add the generated name of the object (which necessarily wasn't available when the request arrived) |
|
335 my $subSessNode = $subSessTab{$4}; |
|
336 $ipc .= "($symtab{$subSessNode})" if defined $subSessNode; # append the name of the node |
|
337 } |
|
338 |
|
339 $exe = truncateExeName($exe); |
|
340 $exe = uniqueProcessName($exe); |
|
341 if ($ipc ne "") |
|
342 { |
|
343 doFastCount() if ($fastCount); |
|
344 print "pn line $logline\n"; |
|
345 print "t !$exe $ipc = $ret\n"; |
|
346 $msgAddrToIpc{$msgAddr} = ""; |
|
347 $msgAddrToExe{$msgAddr} = ""; |
|
348 } |
|
349 if (/~CESockClientActivityBase.(.{8})/) { |
|
350 print "ad $1\n"; |
|
351 ClearActivity($1); |
|
352 } |
|
353 } |
|
354 } |
|
355 elsif (/stray message received.*\[iMessageId=.*?:(.*)\]/i) |
|
356 { |
|
357 print "t ", objectName($lastDispatchDestination), " (STRAY $1)\n"; |
|
358 } |
|
359 #1077,194,2,1212991263,0,0x00a1b488,ENodeMessages: [STARTBLOCK=Context] CNodeActivityBase 0d922584: StartL->activity started Node: [MNode=0x0d9229e0] Sender: [Address=[iThread=0x0006] [iPtr=0x0d922338] ] Recipient: [Address=[iThread=0x0006] [iPtr=0x0d9229e0] ] aContext.iMessage: [Signature=0x00000000:0xfdfdfdfd] [STARTBLOCK=Activity] [Activity=MCprControlClientJoin] [CurrentTriple=MCprStates::TDecrementBlockingDestoryAndAddControlClientAndSendJoinCompleteIfRequest->NULL] [ENDBLOCK=Activity] [ENDBLOCK=Context] |
|
360 #843,195,1,1212618492,0,0x00a1b488,EMeshMachine: CNodeActivityBase: Accept->First transition: ConnStates::TProcessStateChange->MeshMachine::TAwaitingStateChange [MNode=0x0b1ff948] |
|
361 #897,194,2,1212884309,0,0x00a1b488,ENodeMessages: [STARTBLOCK=Activity] CNodeActivityBase 0d921eb8: Next->transition happened [MNode=0x0b1ff948] [Activity=ConnectionStart] [CurrentTriple=ConnStates::TSelectMetaPlane->TECABState<CoreNetStates::TAwaitingBindTo>] [ENDBLOCK=Activity] |
|
362 #1237,195,1,2340065279,0,0x00dfff38,EMeshMachine: CNodeActivityBase 0cb427ec: Next->match [ANode=0x0cb42c48] [Activity=MCprBinderRequest] [Triple=PRStates::TCreateDataClient->CoreNetStates::TAwaitingDataClientJoin] |
|
363 |
|
364 elsif (($opt_X & 2) == 0 && (/(StartL)->activity started.*?\[ANode=0x([0-9a-f]{8})\].*\[Activity=(\S*)\].*\[Triple=(\S*)\]/ || |
|
365 /(Accept)->first transition.*?\[ANode=0x([0-9a-f]{8})\].*\[Activity=(\S*)\].*\[Triple=(\S*)\]/) || |
|
366 /(Next)->transition\s*\[ANode=0x([0-9a-f]{8})\].*\[Activity=(\S*)\].*\[Triple=(\S*)\]/ || |
|
367 /(Next)->match\s*\[ANode=0x([0-9a-f]{8})\].*\[Activity=(\S*)\].*\[Triple=(\S*)\]/) |
|
368 { |
|
369 # $2 = ANode, $3 = Activity, $4 = Triple |
|
370 my $matchType = $1; |
|
371 my $text; |
|
372 my $objAddr; |
|
373 my $prefix = ""; |
|
374 if ($matchType eq "Accept") { |
|
375 if ($excludeAllSingleTuples || $excludeSingleTuple{$3}) { |
|
376 # skip any excluded single tuples |
|
377 next; |
|
378 } |
|
379 $objAddr = $2; |
|
380 $text = $4; |
|
381 $prefix = "($3) "; |
|
382 # for first transitions, the normal activity creation/idle log lines don't appear |
|
383 # so prefix the transition line with the activity name: "activity: (transition, state)" |
|
384 } else { |
|
385 $objAddr = $2; |
|
386 $text = $4; |
|
387 if ($opt_s & 8) { |
|
388 $prefix = "($3) "; |
|
389 } |
|
390 } |
|
391 if ($text ne "" && $text ne "Idle" && $text ne "Undefined") |
|
392 { |
|
393 $text =~ s/->/, /; |
|
394 if ($objAddr ne "") |
|
395 { |
|
396 doFastCount() if ($fastCount); |
|
397 print "t ", objectName($objAddr), " $prefix", "($text)\n"; |
|
398 } |
|
399 else |
|
400 { |
|
401 print "t ", objectName($lastDispatchDestination), " $prefix","($text)\n"; |
|
402 } |
|
403 } |
|
404 |
|
405 if (m/C\w+ ([0-9a-fA-F]{8}):/) { |
|
406 my $actAddr = $1; |
|
407 # if (defined $activityToNode{$actAddr}) |
|
408 # { |
|
409 # map activity address to object address for "t" tag |
|
410 # $objAddr = $activityToNode{$actAddr}; |
|
411 # } |
|
412 if ($text eq "Idle" || $text =~ m/, NULL/) |
|
413 { |
|
414 print "ad $actAddr\n"; |
|
415 ClearActivity($actAddr); |
|
416 } |
|
417 } |
|
418 } |
|
419 #1044,195,1,322007694,0,0x00a1c5e4,EMeshMachine: CNodeActivityBase 0dbe2584: SetIdle |
|
420 #1044,195,1,322007694,0,0x00a1c5e4,EMeshMachine: CNodeActivityBase 0dbe2584: Abort |
|
421 # CAREFUL: this catches all "CNodeActivityBase" log lines not captured earlier - carefulof positioning of this! |
|
422 elsif (($opt_X & 2) == 0 && /CNodeActivityBase ([0-9a-fA-F]{8}):\s*(\S+)\s*/) { |
|
423 my $actAddr = $1; |
|
424 my $action = $2; |
|
425 doFastCount() if ($fastCount); |
|
426 if ($action eq "SetIdle") { |
|
427 print "ad $actAddr\n"; |
|
428 ClearActivity($actAddr); |
|
429 } |
|
430 elsif ($action eq "Abort") { |
|
431 print "t ", objectName($activityNode{$actAddr}), " (Abort ", $activityName{$actAddr}, ")\n"; |
|
432 } |
|
433 elsif ($action eq "Next->cancel") { |
|
434 my $tuple = ""; |
|
435 if (m/\[Triple=([^]]+)\]/) { |
|
436 $tuple = $1; |
|
437 print "t ", objectName($activityNode{$actAddr}), " (Cancel $activityName{$actAddr}, $tuple)\n"; |
|
438 } |
|
439 else { |
|
440 print "t ", objectName($activityNode{$actAddr}), " (Cancel ", $activityName{$actAddr}, ")\n"; |
|
441 } |
|
442 } |
|
443 } |
|
444 elsif (($opt_X & 4) == 0 && /UnparkState->unparked\s+\[MNode=0x([0-9a-fA-F]{8})\].*\[Activity=(\w+)\].*\[Triple=(.*?)\]/) |
|
445 { |
|
446 print "t ", objectName($1), " {50,200,50} (Unparked $2, $3)\n"; |
|
447 } |
|
448 elsif (($opt_X & 4) == 0 && /ParkState->parked\s+\[MNode=0x([0-9a-fA-F]{8})\].*\[Activity=(\w+)\].*\[Triple=(.*?)\]/) { |
|
449 print "t ", objectName($1), " {50,200,50} (Parked $2, $3)\n"; |
|
450 } |
|
451 elsif (/Synchronous call:/) { |
|
452 my ($src,$dest,$msg) = m/Synchronous call: From=(\S+)\s*To=(\S+) Func=(.+)$/; |
|
453 $lastDispatchDestination = $dest; |
|
454 if ((! defined $excludeByAddr{$src}) && (! defined $excludeByAddr{$dest}) && !defined($excludeMessage{$msg})) |
|
455 { |
|
456 doFastCount() if ($fastCount); |
|
457 print "pn line $logline\n"; |
|
458 print "sc \"$msg ()\" ", objectName($src), " ", objectName($dest), "\n"; |
|
459 } |
|
460 } |
|
461 elsif (($opt_s & 16) && (/AddClient/ || /RemoveClient/)) { |
|
462 # ... ANodeBase 00983774: AddClientL(00982c74, flags=0000, type=0200) |
|
463 if (/ANodeBase ([0-9a-f]{8}):\s*(\w*)\(([0-9a-f]{8}), flags=([0-9a-f]{4}), type=([0-9a-f]{4})\)/) { |
|
464 my ($node,$op,$client,$flags,$type) = ($1,$2,$3,$4,$5); |
|
465 $flags =~ s/^0+(\d)/\1/; # remove leading zeroes |
|
466 $type =~ s/^0+(\d)/\1/; # remove leading zeroes |
|
467 $node = objectName($node); |
|
468 $client = objectName($client); |
|
469 if ($op eq "AddClientL") { |
|
470 $op = "added"; |
|
471 $clients{$node}{$client} = $type; |
|
472 } |
|
473 elsif ($op eq "RemoveClient") { |
|
474 $op = "removed"; |
|
475 delete $clients{$node}{$client}; |
|
476 } |
|
477 my $clientList = ""; |
|
478 foreach $client (keys %{$clients{$node}}) { |
|
479 my $direction = $clientTypeToDirection{$clients{$node}{$client}}; |
|
480 $clientList .= " $client$direction"; |
|
481 } |
|
482 if ($clientList) { |
|
483 $clientList = ": $clientList"; |
|
484 } |
|
485 print "t ", $node, " {35,60,110} (${op} client ", $client, ", flags $flags, type $type)$clientList\n"; |
|
486 } |
|
487 } |
|
488 elsif (($opt_s & 32) && /EThreadIdentification/) { |
|
489 if (/Process Create:\s*\[DProcess=0x(.{8})\]/) { |
|
490 # Process Create: [DProcess=0xc8057f38] |
|
491 $pendingProcessCreate = $1; |
|
492 } |
|
493 elsif (/Process Name:\s*\[NThread=0x(.{8})\] \[DProcess=0x(.{8})\] \[Name=(.*)\]/) { |
|
494 # Process Name: [NThread=0xc805b050] [DProcess=0xc8057f38] [Name=centralrepositorysrv.exe[10202be9]0001] |
|
495 my $NThread = $1; |
|
496 my $DProcess = $2; |
|
497 my $processName = $3; |
|
498 $processName =~ s/\[[0-9a-f]{8}\][0-9a-f]{4}$//; |
|
499 $processName = truncateExeName($processName); |
|
500 if ($pendingProcessCreate && processUsingESock($processName)) { |
|
501 #print STDERR "Process Name: NThread $NThread (($NThreadToName{$NThread})), DProcess $DProcess ($processName)\n"; |
|
502 $processName = createUniqueProcessName($processName); |
|
503 print "oc !$processName 0 $DProcess\n"; |
|
504 print "t !$processName (Process Created)\n"; |
|
505 } |
|
506 $pendingProcessCreate = ""; |
|
507 $DProcessToName{$DProcess} = $processName; |
|
508 } |
|
509 elsif (/Thread Create: \[NThread=0x(.{8})\] \[DProcess=0x(.{8})\] \[Name=(.*)\]\s*$/) { |
|
510 # Thread Create: [NThread=0xc805b050] [DProcess=0xc8057f38] [Name=Main] |
|
511 if ($3 ne "Main" && DProcessUsingESock($2)) { |
|
512 #print STDERR "Thread Create: NThread $1 ($3), DProcess $2 ($DProcessToName{$2})\n"; |
|
513 my $name = $DProcessToName{$2}; |
|
514 if ($name) { |
|
515 print "t !$name (Thread \"$3\" Created)\n"; |
|
516 } |
|
517 |
|
518 } |
|
519 $NThreadToName{$1} = $3; |
|
520 } |
|
521 elsif (/Thread Destroy: \[NThread=0x(.{8})\] \[DProcess=0x(.{8})\]/) { |
|
522 # Thread Destroy: [NThread=0xc8057140] [DProcess=0xc80561d0] |
|
523 if (DProcessUsingESock($2)) { |
|
524 #print STDERR "Thread Destroy: NThread $1 ($NThreadToName{$1}), DProcess $2 ($DProcessToName{$2})\n"; |
|
525 my $processName = $DProcessToName{$2}; |
|
526 my $threadName = $NThreadToName{$1}; |
|
527 if ($processName && $threadName ne "Main") { |
|
528 print "t !$processName (Thread \"$threadName\" Destroyed)\n"; |
|
529 } |
|
530 } |
|
531 delete $NThreadToName{$1}; |
|
532 } |
|
533 elsif (/Process Destroy: \[DProcess=0x(.{8})\]/) { |
|
534 # Process Destroy: [DProcess=0xc80561d0] |
|
535 if (DProcessUsingESock($1)) { |
|
536 #print STDERR "Process Destroy: $1 ($DProcessToName{$1})\n"; |
|
537 my $name = $DProcessToName{$1}; |
|
538 if ($name) { |
|
539 $name = uniqueProcessName($name); |
|
540 print "od !$name $1\n"; |
|
541 print "t !$name (Process Destroyed)\n"; |
|
542 } |
|
543 } |
|
544 delete $DProcessToName{$1}; |
|
545 # do not delete the $processUsingESock{} entry - it identifies processes that use ESock and whose |
|
546 # process/thread activity is worth display. It is both statically initialised and dynamically built up. |
|
547 } |
|
548 } |
|
549 else { |
|
550 my $text = matchNotableText($_); |
|
551 if ($text ne "") { |
|
552 print "t ", objectName($lastDispatchDestination), " $text\n"; |
|
553 } |
|
554 } |
|
555 } continue { |
|
556 ++$logline; |
|
557 } |
|
558 |
|
559 sub uniqueProcessName($) |
|
560 { |
|
561 my $name = $_[0]; |
|
562 if (! ($opt_s & 32)) { |
|
563 return $name; |
|
564 } |
|
565 my $unique = $uniqueProcessName{$name}; |
|
566 if (!$unique || $unique == 1) { |
|
567 return $name; |
|
568 } else { |
|
569 return $name . "-" . $uniqueProcessName{$name}; |
|
570 } |
|
571 } |
|
572 |
|
573 sub createUniqueProcessName($) |
|
574 { |
|
575 my $name = $_[0]; |
|
576 if (! ($opt_s & 32)) { |
|
577 return $name; |
|
578 } |
|
579 if (!defined($uniqueProcessName{$name})) { |
|
580 $uniqueProcessName{$name} = 1; |
|
581 return $name; |
|
582 } else { |
|
583 return $name . "-" . ++$uniqueProcessName{$name}; |
|
584 } |
|
585 } |
|
586 |
|
587 sub DProcessUsingESock($) |
|
588 { |
|
589 return processUsingESock($DProcessToName{$_[0]}); |
|
590 } |
|
591 |
|
592 sub processUsingESock($) |
|
593 { |
|
594 return $processUsingESock{$_[0]}; |
|
595 } |
|
596 |
|
597 outputSymbols(); |
|
598 |
|
599 sub doFastCount() |
|
600 { |
|
601 if (m/^\d+,\d+,\d+,(\d+),/) { |
|
602 if ($lastFastCount) { |
|
603 print "l ", $1 - $lastFastCount, "\n"; |
|
604 $lastFastCount = $1; |
|
605 } else { |
|
606 $lastFastCount = $1; |
|
607 } |
|
608 } |
|
609 } |
|
610 |
|
611 # |
|
612 # Parse log lines related to posting and dispatching messages and output appropriate command in log.seq file. |
|
613 # |
|
614 # Arguments: |
|
615 # $type String at beginning of line to match (either "TransportReceiver::DispatchMessage" or "TransportSender::PostMessage") |
|
616 # $cmd Type of command to output to log.seq file (either "r" for dispatch or "p" for post). |
|
617 |
|
618 sub parsePostDispatchMessageLine($$) |
|
619 { |
|
620 my ($type, $cmd) = @_; |
|
621 my ($mark,$src, $srcAfter, $dest, $rest) = m/$type\s*(.*?)iPtr=0x([^\]]+)(.*?)iPtr=0x([^\]]+)(.*)/; |
|
622 $_ = $rest; |
|
623 my ($destAfter, $msgRealm, $msg, $args) = m/(.*?)iMessageId=(.+?):(.+?)\]\s*(.*)/; |
|
624 if ($msgRealm eq "" || ($msgRealm eq "0x00000000" && $msg eq "0x0000")) { |
|
625 # If message is not available, try extracting the signature, which can be decoded or not |
|
626 # (e.g. "... aMessage: [Signature=0x102822da:0x00000003] ..." or "... aMessage: [Signature=TCprRetrieveProgress] ...") |
|
627 # Use the signature as the message. |
|
628 ($destAfter, $msg, $args) = m/(.*?)\[Signature=(.+?)\]\s*(.*)/; |
|
629 if ($msg =~ m/(.+?):(.+)/) { |
|
630 # undecoded signature - arrange to display hex values |
|
631 $msgRealm = $1; |
|
632 $msg = $2; |
|
633 } |
|
634 } |
|
635 |
|
636 # For decoded signatures with undecoded messages |
|
637 # (e.g. "... aMessage: [Signature=TSigNumber] [iMessageId=0x10281ded:0x0001] ... ") |
|
638 # display message realm and id in hex. |
|
639 if ($msg =~ s/^0x//) { |
|
640 $msgRealm =~ s/^0x//; |
|
641 $msg = "$msgRealm:$msg"; |
|
642 } |
|
643 my $activity = parseActivityIds(\$srcAfter, \$destAfter); |
|
644 $lastDispatchDestination = $dest; |
|
645 |
|
646 # Deal with any markers (which are added to the popup after the line number) and timestamps |
|
647 # (which are displayed on the left). |
|
648 my $popup; |
|
649 if ($mark =~ s/(w\d+\:\d+)//) { |
|
650 $popup = ", $1"; |
|
651 if ($mark =~ m/(\d\d:\d\d:\d\d.\d)/) { |
|
652 # remove duplicate times |
|
653 if ($lastTimestamp ne $1) { |
|
654 $lastTimestamp = $1; |
|
655 print "l $1\n"; |
|
656 } |
|
657 } |
|
658 } |
|
659 outputMessageSequenceCommand($cmd, $msg, $src, $dest, $activity, \$args, $popup); |
|
660 } |
|
661 |
|
662 # |
|
663 # Output command to log.seq file |
|
664 # |
|
665 # Arguments: |
|
666 # $cmd Command to output to log.seq ("r" or "p") |
|
667 # $msg Message name (e.g. "Stop") |
|
668 # $src Source node address in hex |
|
669 # $dest Destination node address in hex |
|
670 # $activity Activity name (e.g. "CprBindToRequest") |
|
671 # $lineRef Reference to original log line. |
|
672 # $popup Additional string to add to popup |
|
673 |
|
674 sub outputMessageSequenceCommand($$$$$$) |
|
675 { |
|
676 my ($cmd,$msg,$src,$dest,$activity,$lineRef,$popup) = @_; |
|
677 if ((! defined $excludeByAddr{$src}) && (! defined $excludeByAddr{$dest}) && !defined($excludeMessage{$msg})) { |
|
678 print "pn line $logline$popup\n"; |
|
679 # extract any arguments from the end of the log line |
|
680 my $args = getArguments($lineRef, $msg); |
|
681 if ($args ne "") { |
|
682 if ($activity) { |
|
683 $cmd .= " \"$msg ($activity, $args)\""; |
|
684 } else { |
|
685 $cmd .= " \"$msg ($args)\""; |
|
686 } |
|
687 } else { |
|
688 $cmd .= " \"$msg ($activity)\""; |
|
689 } |
|
690 print "$cmd ", objectName($src), " ", objectName($dest), "\n"; |
|
691 } |
|
692 } |
|
693 |
|
694 # |
|
695 # Extract message arguments from the log and return them in a formatted string ready to be displayed |
|
696 # |
|
697 # Arguments: |
|
698 # $lineRef Reference to original log line |
|
699 # $msg Name of message (e.g. "Start"). |
|
700 # Return: |
|
701 # String containing comma-seperated arguments of the message (e.g. "-3, 0") |
|
702 |
|
703 sub getArguments($$) |
|
704 { |
|
705 my $args; |
|
706 my ($lineRef, $msg) = @_; |
|
707 # Check if arguments are to be displayed for this message. |
|
708 if (exists($arguments{$msg})) { |
|
709 # Extract arguments: |
|
710 # "... args: [Signature=TSigStateChange] [iMessageId=0x10285a56:StateChange] <arguments> [ENDBLOCK=TransportSender::PostMessage]" |
|
711 # if (${$lineRef} =~ m/(.*?)\s*\[ENDBLOCK=/) { |
|
712 if (${$lineRef} =~ m/(.*)\s*\[ENDBLOCK=/) { |
|
713 # place message argument values into a hash |
|
714 my $valuesHashRef = convertDecoderArgumentsToPerlHash($1); |
|
715 if ($valuesHashRef) { |
|
716 $args = formatArguments($arguments{$msg}, $valuesHashRef); |
|
717 } else { |
|
718 handleMangleError($logline, $lineRef, $msg); |
|
719 } |
|
720 # hash should be deleted when $valuesHashRef goes out of scope (?) |
|
721 } |
|
722 } |
|
723 return $args; |
|
724 } |
|
725 |
|
726 # |
|
727 # Parse the "[iNodeCtx=...]" strings to extract activity ids. Return a string of the form: |
|
728 # |
|
729 # [<src activity>] "->" [<dest activity>] |
|
730 # |
|
731 # Source and/or destination activity may not be present. Examples: "Start->", "->NoBearer", "Start->NoBearer" |
|
732 # |
|
733 |
|
734 sub parseActivityIds($$) |
|
735 { |
|
736 my ($srcRef,$destRef) = @_; |
|
737 my $activity; |
|
738 if (${$srcRef} =~ m/\[iNodeCtx=(\S*)\]/) { |
|
739 $activity = $1; |
|
740 $activity =~ s/^Activity//; |
|
741 } |
|
742 |
|
743 if (${$destRef} =~ m/\[iNodeCtx=(\S*)\]/) { |
|
744 my $ctx = $1; |
|
745 $ctx =~ s/^Activity//; |
|
746 $activity .= "->$ctx"; |
|
747 } |
|
748 elsif ($activity) { |
|
749 $activity .= "->"; |
|
750 } |
|
751 return $activity; |
|
752 } |
|
753 |
|
754 # |
|
755 # Return a string containing containing comma-seperated arguments of the message (e.g. "-3, 0") |
|
756 # |
|
757 # Arguments: |
|
758 # $formatRef Reference to a hash containing the arguments to be displayed for each message (see processArgumentLine()) |
|
759 # $h Reference to a hash containing the argument values (see convertDecoderArgumentsToPerlHash()) |
|
760 # |
|
761 # Returns: |
|
762 # String containing message arguments |
|
763 |
|
764 sub formatArguments($$) |
|
765 { |
|
766 my ($formatRef, $h) = @_; |
|
767 my $index = 0; |
|
768 my $buf; |
|
769 while ($index < scalar(@{$formatRef})) { |
|
770 # extract the argument value from the hash |
|
771 if ($index > 0) { |
|
772 $buf .= ", "; |
|
773 } |
|
774 my $hashAccess = "\$h->" . $formatRef->[$index++]; # "$h" refers to argument variable passed in |
|
775 my $value = eval $hashAccess; |
|
776 my $format = $formatRef->[$index++]; |
|
777 if ($format == ArgumentNode) { |
|
778 # for ":node" arguments, convert node address to node name via symbol table |
|
779 my $hexval; |
|
780 if ($value =~ s/^0x//) { |
|
781 $hexval = $value; |
|
782 } else { |
|
783 $hexval = sprintf "%08x", $value; |
|
784 } |
|
785 if (defined $symtab{$hexval}) { |
|
786 $buf .= $symtab{$hexval}; |
|
787 } else { |
|
788 # if we couldn't convert node address to node name, just show hex value |
|
789 # (display "00000000" as "0". We could also do "$hexval = sprintf "%x" $value") |
|
790 if ($value == 0) { |
|
791 $hexval = "0"; |
|
792 } |
|
793 $buf .= $hexval; |
|
794 } |
|
795 } elsif ($value =~ m/^0x[0-9a-fA-F]+$/ || $value =~ m/^[\-\d]\d+$/) { |
|
796 # hex or decimal number - convert to signed decimal |
|
797 if ($value =~ m/^0x/) { |
|
798 $value = hex($value); |
|
799 } |
|
800 $buf .= sprintf "%d", $value; |
|
801 } else { |
|
802 $buf .= $value; |
|
803 } |
|
804 } |
|
805 return $buf; |
|
806 } |
|
807 |
|
808 sub uniquifyName() |
|
809 { |
|
810 my ($name) = @_; |
|
811 my $index = 0; |
|
812 my $proposedName = $name; |
|
813 while (defined $uniqueNames{$proposedName}) |
|
814 { |
|
815 $proposedName = $name . ++$index; |
|
816 } |
|
817 |
|
818 $uniqueNames{$proposedName} = 1; |
|
819 return $proposedName; |
|
820 } |
|
821 |
|
822 # |
|
823 # Shorten object name and return its placement order |
|
824 # |
|
825 |
|
826 sub parseObjectName($) |
|
827 { |
|
828 my ($nameRef) = @_; |
|
829 my $ref; |
|
830 my $order = 0; |
|
831 foreach $ref (@objectNameParse) { |
|
832 if (${$nameRef} =~ s/$ref->{SubString}/$ref->{Replacement}/) { |
|
833 if ($order == 0 && $ref->{Order} != 0) { |
|
834 $order = $ref->{Order}; |
|
835 } |
|
836 } |
|
837 } |
|
838 ${$nameRef} =~ s/^C//; # remove leading 'C', if any |
|
839 return $order; |
|
840 } |
|
841 |
|
842 sub objectName($) { |
|
843 my ($name) = @_; |
|
844 if (defined ($symtab{$name})) { |
|
845 return $symtab{$name}; |
|
846 } else { |
|
847 return $name; |
|
848 } |
|
849 } |
|
850 |
|
851 sub readIniFile() |
|
852 { |
|
853 my $sectionName; |
|
854 if ($opt_x) { |
|
855 open (INI, $opt_x) || die "Cannot open ini file $opt_x\n"; |
|
856 while (<INI>) { |
|
857 chomp; |
|
858 # remove leading and trailing blanks and ignore blank lines |
|
859 s/^\s+//; |
|
860 s/\s+$//; |
|
861 if (! $_|| m/^#/) |
|
862 { next; }; |
|
863 |
|
864 if (/^\[(.+)\]/) { |
|
865 # parse section name from "[<section>]" lines |
|
866 $sectionName = $1; |
|
867 } |
|
868 else { |
|
869 if ($sectionName eq "ExcludeClass") { |
|
870 $excludeClass{$_} = 1; |
|
871 } |
|
872 elsif ($sectionName eq "ExcludeMessage") { |
|
873 $excludeMessage{$_} = 1; |
|
874 } |
|
875 elsif ($sectionName eq "ExcludeShortName") { |
|
876 $excludeShortName{$_} = 1; |
|
877 } |
|
878 elsif ($sectionName eq "ExcludeIpc") { |
|
879 $excludeIpc{$_} = 1; |
|
880 } |
|
881 elsif ($sectionName eq "ExcludeSingleTuple") { |
|
882 if ($_ eq "*") { |
|
883 $excludeAllSingleTuples = 1; |
|
884 } else { |
|
885 $excludeSingleTuple{$_} = 1; |
|
886 } |
|
887 } |
|
888 elsif ($sectionName eq "MessageArguments") { |
|
889 processArgumentLine($_); |
|
890 } |
|
891 elsif ($sectionName eq "ObjectNameTruncateAndOrder") { |
|
892 print $_; |
|
893 processObjectNameTruncateAndOrder($_); |
|
894 } |
|
895 elsif ($sectionName eq "NotableTextToDisplay") { |
|
896 processNotableText($_); |
|
897 } |
|
898 } |
|
899 } |
|
900 close INI; |
|
901 } |
|
902 } |
|
903 |
|
904 sub excludeIpc($) |
|
905 { |
|
906 my $ipc = $_[0]; |
|
907 $ipc =~ s/\(.*\)$//; # "ESoGetOpt(Socket1)" => "ESoGetOpt" |
|
908 return $excludeIpc{$ipc}; |
|
909 } |
|
910 |
|
911 printMangleErrors(); |
|
912 |
|
913 sub printMangleErrors() |
|
914 { |
|
915 if (scalar(@mangled) > 0) { |
|
916 print STDERR "\n", scalar(@mangled), " possibly mangled log lines:\n"; |
|
917 foreach my $i (@mangled) { |
|
918 print STDERR "$i->{num} "; |
|
919 } |
|
920 } |
|
921 print STDERR "\n\n"; |
|
922 foreach my $i (@mangled) { |
|
923 my $line = $i->{line}; |
|
924 # decode node and activity names when printing out the mangled log lines |
|
925 $line =~ s/\[Address=\[iPtr=0x([0-9a-f]{8})\]/&objectName($1)/ge; |
|
926 $line =~ s/CNodeActivityBase ([0-9a-f]{8})/"CNodeActivityBase " . $activityName{$1}/ge; |
|
927 print STDERR $line, "\n\n"; |
|
928 } |
|
929 } |
|
930 |
|
931 sub handleMangleError($$$) |
|
932 { |
|
933 my ($logline, $lineRef, $msg) = @_; |
|
934 push @mangled, { num => $logline, line => "($msg @ $logline): ..." . ${$lineRef} }; |
|
935 } |
|
936 |
|
937 sub truncateExeName($) |
|
938 { |
|
939 my ($exeName) = @_; |
|
940 $exeName =~ s/\.exe$//; |
|
941 $exeName =~ s/\.EXE$//; |
|
942 return $exeName; |
|
943 } |
|
944 |
|
945 sub outputSymbols() |
|
946 { |
|
947 open SYM, ">logsym.html" || die "Cannot open logsym.html for writing\n"; |
|
948 print SYM "<html>\n<body><code>\n"; |
|
949 my @keys = sort keys %symtab; |
|
950 for my $i (@keys) { |
|
951 print SYM "$i\t$symtab{$i}<br>\n"; |
|
952 } |
|
953 print SYM "</code></body></html>\n"; |
|
954 close SYM; |
|
955 } |
|
956 |
|
957 # |
|
958 # Process a single line from the "[Arguments]" section of the config file. |
|
959 # This section contains a list of messages and the corresponding message arguments to display. |
|
960 # |
|
961 # Format: |
|
962 # <message> <argument> [<argument>]* |
|
963 # where: |
|
964 # <argument> := <member>[.<member>]*[:<output format>] |
|
965 # <output format> := "node" |
|
966 # <member> := class data member name (e.g. iStateChange.iError) |
|
967 # |
|
968 # Output format values: |
|
969 # node take the hex address as a node address and display the human readable node name (e.g. "IPCPR2") |
|
970 # By default, display as signed decimal. |
|
971 # |
|
972 # For example: |
|
973 # |
|
974 # [Arguments] |
|
975 # StateChange iStateChange.iStage iStateChange.iError |
|
976 # BindTo iCommsBinder.iCommsId.iPtr:node iProviderInfo.iAPId |
|
977 # SelectComplete iNodeId.iPtr:node |
|
978 # |
|
979 # Each line is read into the hash %argument which is keyed on message name and contains a (mixed type) array |
|
980 # giving each argument (in corresponding Perl hash access format) and output format (constant ArgumentSignedDecimal, |
|
981 # ArgumentNode). For example: |
|
982 # |
|
983 # %arguments: StateChange => [ "{iStateChange}->{iStage}", ArgumentSignedDecimal, "{iStateChange}->{iError}", ArgumentSignedDecimal ] |
|
984 # BindTo => [ "{iCommsBinder}->{iCommsId}->{iPtr}", ArgumentNode, "{iProviderInfo}->{iAPId}", ArgumentSignedDecimal ] |
|
985 |
|
986 |
|
987 sub processArgumentLine($) |
|
988 { |
|
989 my $line = $_[0]; |
|
990 if (!($line =~ s/^(\w+)\s*//)) { |
|
991 die "Incorrectly formatted arguments file\n"; |
|
992 } |
|
993 my $msg = $1; |
|
994 if (exists $arguments{$msg}) { |
|
995 die "Duplicate line for message $msg in arguments file\n"; |
|
996 } |
|
997 my @args = split ' ', $line; |
|
998 my $format; |
|
999 foreach my $i (@args) { |
|
1000 # extract the output format specifier after the ":" (if any) - e.g. "iPtr:node". |
|
1001 # Default to signed decimal, if not specified. |
|
1002 if ($i =~ s/:(\w+)//) { |
|
1003 $format = $argumentFormatToConstant{$1}; |
|
1004 } else { |
|
1005 $format = ArgumentSignedDecimal; |
|
1006 } |
|
1007 # convert from period seperated fields to Perl hash access format, e.g. "a.b.c" to "$h->{a}->{b}->{c}" |
|
1008 $i =~ s/(\w+)/{\1}/g; |
|
1009 $i =~ s/\./->/g; |
|
1010 # add hash access string and output format to array associated with the message |
|
1011 push @{$arguments{$msg}}, ($i,$format); |
|
1012 } |
|
1013 # printArguments(); |
|
1014 } |
|
1015 |
|
1016 # |
|
1017 # Convert the nested bracketted field/value format used by the decoder into a Perl hash. |
|
1018 # For example: |
|
1019 # "[A=[B=[C=x1][D=x2]][E=x3]][F=[G=x4]]" |
|
1020 # becomes: |
|
1021 # "{A => { B=C => x1, D => x2, }, E => x3, }, F => {G => x4, }, }" |
|
1022 # Note: extraneous commas are harmless and hence not removed. |
|
1023 # |
|
1024 # This is then passed to "eval" to become an actual hash. Accessing any field is then via standard Perl hash access, |
|
1025 # e.g. "$hash->{A}->{B}->{D}" for accessing A.B.D. |
|
1026 # |
|
1027 # Arguments: |
|
1028 # - decoder nested bracketted format string for arguments |
|
1029 # Return: |
|
1030 # - reference to hash |
|
1031 |
|
1032 sub convertDecoderArgumentsToPerlHash($) |
|
1033 { |
|
1034 my $arg = "{" . $_[0]; |
|
1035 # Remove any empty fields, e.g. "[Bad=]" as these will result in us generating hash initialisers without a value |
|
1036 # (e.g. "..., Good => Value, Bad => , Good2 => Value2, ...") which causes undefined behaviour when initialising |
|
1037 # the hash. |
|
1038 |
|
1039 $arg =~ s/\[\w+=\]\s*//g; |
|
1040 |
|
1041 # NOTE: order in which the substitutions happens below is important |
|
1042 |
|
1043 # "[X=[" -> "X => { " |
|
1044 $arg =~ s/\[(\w+)=\[/\1 => { /g; |
|
1045 |
|
1046 # "X=[" -> "X => { " |
|
1047 $arg =~ s/(\w+)=\[/\1 => { /g; |
|
1048 |
|
1049 # "[X=Y]" -> "X => Y, " |
|
1050 # Note: allows for empty values, e.g. "[A=]" |
|
1051 # $arg =~ s/\[(\w+)=(\w*)\]/\1 => \2, /g; |
|
1052 $arg =~ s/\[([^\]=]+)=([^\]=]*)\]/\1 => \2, /g; |
|
1053 |
|
1054 # "X=Y]" -> "X => Y, " |
|
1055 # Note: allows for empty values, e.g. "[A=]" |
|
1056 # $arg =~ s/[^[](\w+)=(\w*)\]/\1 => \2, /g; |
|
1057 # $arg =~ s/[^\[]([^\]\=]+)\=([^\>][^\]\=]*)\]/\1 \=> \2, /g; |
|
1058 $arg =~ s/([\w\d_]+)\s*\=([^\>][^\]\=]*)\]/\1 \=> \2, /g; |
|
1059 |
|
1060 # "]" -> "}, " |
|
1061 $arg =~ s/\]/}, /g; |
|
1062 |
|
1063 # "[" -> "{ " |
|
1064 $arg =~ s/\[/{ /g; |
|
1065 |
|
1066 # KLUDGE: " , " becomes " } ". This is mainly to deal with placing the correct number |
|
1067 # of "}" at the end. |
|
1068 $arg =~ s/ , / } /g; |
|
1069 |
|
1070 $arg .= "}"; |
|
1071 |
|
1072 # we must quote any non-numeric values. Not an ideal expression - just looks at first character. |
|
1073 # $arg =~ s/=> ([^{][a-zA-Z]+),/=> "\1",/g; |
|
1074 $arg =~ s/=> ([^{,]+),/=> "\1",/g; |
|
1075 return eval $arg; |
|
1076 } |
|
1077 |
|
1078 # |
|
1079 # Process Object name truncation and ordering lines from ini file. |
|
1080 # |
|
1081 # Each line contains: |
|
1082 # <sub string> <replacement> <order> |
|
1083 # |
|
1084 # each occurrence of <string> in any object name is replaced with <replacement>. |
|
1085 # <order> indicates how objects containing <string> are placed on the display. |
|
1086 # |
|
1087 |
|
1088 sub processObjectNameTruncateAndOrder($_) |
|
1089 { |
|
1090 my $line = $_[0]; |
|
1091 my ($substr, $replacement, $order) = split ' ', $line; |
|
1092 push @objectNameParse, { SubString => $substr, Replacement => $replacement, Order => $order }; |
|
1093 } |
|
1094 |
|
1095 sub printRecursiveHash($) |
|
1096 { |
|
1097 print "Printing hash: "; |
|
1098 printRecursiveHashWorker($_[0]); |
|
1099 print "\n\n"; |
|
1100 } |
|
1101 |
|
1102 sub printRecursiveHashWorker($) |
|
1103 { |
|
1104 my $hashRef = $_[0]; |
|
1105 foreach my $i (keys %{$hashRef}) { |
|
1106 print "$i => "; |
|
1107 my $type = ref($hashRef->{$i}); |
|
1108 if ($type eq "HASH") { |
|
1109 print "{ "; |
|
1110 printRecursiveHashWorker($hashRef->{$i}); |
|
1111 print "}, "; |
|
1112 } else { |
|
1113 print $hashRef->{$i}, ", "; |
|
1114 } |
|
1115 } |
|
1116 } |
|
1117 |
|
1118 sub printArguments() |
|
1119 { |
|
1120 print "Arguments:\n"; |
|
1121 foreach my $key (keys %arguments) { |
|
1122 print "$key: @{$arguments{$key}}\n"; |
|
1123 } |
|
1124 } |
|
1125 |
|
1126 sub processNotableText($) |
|
1127 { |
|
1128 my $text = $_[0]; |
|
1129 my ($matchText,$displayText) = m/"(.*)"\s*"(.*)"/; |
|
1130 push @notableText, [ $matchText, $displayText ]; |
|
1131 } |
|
1132 |
|
1133 sub matchNotableText($) |
|
1134 { |
|
1135 my $text = $_; |
|
1136 foreach my $ref (@notableText) { |
|
1137 if ($text =~ m/$ref->[0]/) { |
|
1138 return $ref->[1]; |
|
1139 } |
|
1140 } |
|
1141 return ""; |
|
1142 } |
|
1143 |
|
1144 sub ClearActivity($) |
|
1145 { |
|
1146 my $actAddr = $_[0]; |
|
1147 if (defined $activityNode{$actAddr}) { |
|
1148 delete $activityNode{$actAddr}; |
|
1149 } |
|
1150 if (defined $activityName{$actAddr}) { |
|
1151 delete $activityName{$actAddr}; |
|
1152 } |
|
1153 } |