1 #!/usr/bin/env perl
2 # This is a POC for reading the text represent
3 # page reclaim. It makes an attempt to extract
4 # what is going on. The accuracy of the parser
5 #
6 # Example usage: trace-vmscan-postprocess.pl <
7 # other options
8 # --read-procstat If the trace lacks pro
9 # --ignore-pid Aggregate processes of
10 #
11 # Copyright (c) IBM Corporation 2009
12 # Author: Mel Gorman <mel@csn.ul.ie>
13 use strict;
14 use Getopt::Long;
15
16 # Tracepoint events
17 use constant MM_VMSCAN_DIRECT_RECLAIM_BEGIN
18 use constant MM_VMSCAN_DIRECT_RECLAIM_END
19 use constant MM_VMSCAN_KSWAPD_WAKE
20 use constant MM_VMSCAN_KSWAPD_SLEEP
21 use constant MM_VMSCAN_LRU_SHRINK_ACTIVE
22 use constant MM_VMSCAN_LRU_SHRINK_INACTIVE
23 use constant MM_VMSCAN_LRU_ISOLATE
24 use constant MM_VMSCAN_WRITEPAGE_FILE_SYNC
25 use constant MM_VMSCAN_WRITEPAGE_ANON_SYNC
26 use constant MM_VMSCAN_WRITEPAGE_FILE_ASYNC
27 use constant MM_VMSCAN_WRITEPAGE_ANON_ASYNC
28 use constant MM_VMSCAN_WRITEPAGE_ASYNC
29 use constant EVENT_UNKNOWN
30
31 # Per-order events
32 use constant MM_VMSCAN_DIRECT_RECLAIM_BEGIN_PE
33 use constant MM_VMSCAN_WAKEUP_KSWAPD_PERORDER
34 use constant MM_VMSCAN_KSWAPD_WAKE_PERORDER
35 use constant HIGH_KSWAPD_REWAKEUP_PERORDER
36
37 # Constants used to track state
38 use constant STATE_DIRECT_BEGIN
39 use constant STATE_DIRECT_ORDER
40 use constant STATE_KSWAPD_BEGIN
41 use constant STATE_KSWAPD_ORDER
42
43 # High-level events extrapolated from tracepoi
44 use constant HIGH_DIRECT_RECLAIM_LATENCY
45 use constant HIGH_KSWAPD_LATENCY
46 use constant HIGH_KSWAPD_REWAKEUP
47 use constant HIGH_NR_SCANNED
48 use constant HIGH_NR_TAKEN
49 use constant HIGH_NR_RECLAIMED
50 use constant HIGH_NR_FILE_SCANNED
51 use constant HIGH_NR_ANON_SCANNED
52 use constant HIGH_NR_FILE_RECLAIMED
53 use constant HIGH_NR_ANON_RECLAIMED
54
55 my %perprocesspid;
56 my %perprocess;
57 my %last_procmap;
58 my $opt_ignorepid;
59 my $opt_read_procstat;
60
61 my $total_wakeup_kswapd;
62 my ($total_direct_reclaim, $total_direct_nr_sc
63 my ($total_direct_nr_file_scanned, $total_dire
64 my ($total_direct_latency, $total_kswapd_laten
65 my ($total_direct_nr_reclaimed);
66 my ($total_direct_nr_file_reclaimed, $total_di
67 my ($total_direct_writepage_file_sync, $total_
68 my ($total_direct_writepage_anon_sync, $total_
69 my ($total_kswapd_nr_scanned, $total_kswapd_wa
70 my ($total_kswapd_nr_file_scanned, $total_kswa
71 my ($total_kswapd_writepage_file_sync, $total_
72 my ($total_kswapd_writepage_anon_sync, $total_
73 my ($total_kswapd_nr_reclaimed);
74 my ($total_kswapd_nr_file_reclaimed, $total_ks
75
76 # Catch sigint and exit on request
77 my $sigint_report = 0;
78 my $sigint_exit = 0;
79 my $sigint_pending = 0;
80 my $sigint_received = 0;
81 sub sigint_handler {
82 my $current_time = time;
83 if ($current_time - 2 > $sigint_receiv
84 print "SIGINT received, report
85 $sigint_report = 1;
86 } else {
87 if (!$sigint_exit) {
88 print "Second SIGINT r
89 }
90 $sigint_exit++;
91 }
92
93 if ($sigint_exit > 3) {
94 print "Many SIGINTs received,
95 exit;
96 }
97
98 $sigint_received = $current_time;
99 $sigint_pending = 1;
100 }
101 $SIG{INT} = "sigint_handler";
102
103 # Parse command line options
104 GetOptions(
105 'ignore-pid' => \$opt_ignorepi
106 'read-procstat' => \$opt_read_pro
107 );
108
109 # Defaults for dynamically discovered regex's
110 my $regex_direct_begin_default = 'order=([0-9]
111 my $regex_direct_end_default = 'nr_reclaimed=(
112 my $regex_kswapd_wake_default = 'nid=([0-9]*)
113 my $regex_kswapd_sleep_default = 'nid=([0-9]*)
114 my $regex_wakeup_kswapd_default = 'nid=([0-9]*
115 my $regex_lru_isolate_default = 'classzone=([0
116 my $regex_lru_shrink_inactive_default = 'nid=(
117 my $regex_lru_shrink_active_default = 'lru=([A
118 my $regex_writepage_default = 'page=([0-9a-f]*
119
120 # Dyanically discovered regex
121 my $regex_direct_begin;
122 my $regex_direct_end;
123 my $regex_kswapd_wake;
124 my $regex_kswapd_sleep;
125 my $regex_wakeup_kswapd;
126 my $regex_lru_isolate;
127 my $regex_lru_shrink_inactive;
128 my $regex_lru_shrink_active;
129 my $regex_writepage;
130
131 # Static regex used. Specified like this for r
132 # (process_pid) (cpus
133 my $regex_traceevent = '\s*([a-zA-Z0-9-]*)\s*(
134 my $regex_statname = '[-0-9]*\s\((.*)\).*';
135 my $regex_statppid = '[-0-9]*\s\(.*\)\s[A-Za-z
136
137 sub generate_traceevent_regex {
138 my $event = shift;
139 my $default = shift;
140 my $regex;
141
142 # Read the event format or use the def
143 if (!open (FORMAT, "/sys/kernel/tracin
144 print("WARNING: Event $event f
145 return $default;
146 } else {
147 my $line;
148 while (!eof(FORMAT)) {
149 $line = <FORMAT>;
150 $line =~ s/, REC->.*//
151 if ($line =~ /^print f
152 $regex = $1;
153 $regex =~ s/%s
154 $regex =~ s/%p
155 $regex =~ s/%d
156 $regex =~ s/%l
157 $regex =~ s/%l
158 }
159 }
160 }
161
162 # Can't handle the print_flags stuff b
163 # script, it really doesn't matter
164 $regex =~ s/\(REC.*\) \? __print_flags
165
166 # Verify fields are in the right order
167 my $tuple;
168 foreach $tuple (split /\s/, $regex) {
169 my ($key, $value) = split(/=/,
170 my $expected = shift;
171 if ($key ne $expected) {
172 print("WARNING: Format
173 $regex =~ s/$key=\((.*
174 }
175 }
176
177 if (defined shift) {
178 die("Fewer fields than expecte
179 }
180
181 return $regex;
182 }
183
184 $regex_direct_begin = generate_traceevent_rege
185 "vmscan/mm_vmscan_dire
186 $regex_direct_begin_de
187 "order", "gfp_flags");
188 $regex_direct_end = generate_traceevent_regex(
189 "vmscan/mm_vmscan_dire
190 $regex_direct_end_defa
191 "nr_reclaimed");
192 $regex_kswapd_wake = generate_traceevent_regex
193 "vmscan/mm_vmscan_kswa
194 $regex_kswapd_wake_def
195 "nid", "order");
196 $regex_kswapd_sleep = generate_traceevent_rege
197 "vmscan/mm_vmscan_kswa
198 $regex_kswapd_sleep_de
199 "nid");
200 $regex_wakeup_kswapd = generate_traceevent_reg
201 "vmscan/mm_vmscan_wake
202 $regex_wakeup_kswapd_d
203 "nid", "order", "gfp_f
204 $regex_lru_isolate = generate_traceevent_regex
205 "vmscan/mm_vmscan_lru_
206 $regex_lru_isolate_def
207 "classzone", "order",
208 "nr_requested", "nr_sc
209 "lru");
210 $regex_lru_shrink_inactive = generate_traceeve
211 "vmscan/mm_vmscan_lru_
212 $regex_lru_shrink_inac
213 "nid", "nr_scanned", "
214 "nr_congested", "nr_im
215 "nr_activate_file", "n
216 "nr_unmap_fail", "prio
217 $regex_lru_shrink_active = generate_traceevent
218 "vmscan/mm_vmscan_lru_
219 $regex_lru_shrink_acti
220 "nid", "nr_taken", "nr
221 "priority", "flags");
222 $regex_writepage = generate_traceevent_regex(
223 "vmscan/mm_vmscan_writ
224 $regex_writepage_defau
225 "page", "pfn", "flags"
226
227 sub read_statline($) {
228 my $pid = $_[0];
229 my $statline;
230
231 if (open(STAT, "/proc/$pid/stat")) {
232 $statline = <STAT>;
233 close(STAT);
234 }
235
236 if ($statline eq '') {
237 $statline = "-1 (UNKNOWN_PROCE
238 }
239
240 return $statline;
241 }
242
243 sub guess_process_pid($$) {
244 my $pid = $_[0];
245 my $statline = $_[1];
246
247 if ($pid == 0) {
248 return "swapper-0";
249 }
250
251 if ($statline !~ /$regex_statname/o) {
252 die("Failed to math stat line
253 }
254 return "$1-$pid";
255 }
256
257 # Convert sec.usec timestamp format
258 sub timestamp_to_ms($) {
259 my $timestamp = $_[0];
260
261 my ($sec, $usec) = split (/\./, $times
262 return ($sec * 1000) + ($usec / 1000);
263 }
264
265 sub process_events {
266 my $traceevent;
267 my $process_pid;
268 my $cpus;
269 my $timestamp;
270 my $tracepoint;
271 my $details;
272 my $statline;
273
274 # Read each line of the event log
275 EVENT_PROCESS:
276 while ($traceevent = <STDIN>) {
277 if ($traceevent =~ /$regex_tra
278 $process_pid = $1;
279 $timestamp = $4;
280 $tracepoint = $5;
281
282 $process_pid =~ /(.*)-
283 my $process = $1;
284 my $pid = $2;
285
286 if ($process eq "") {
287 $process = $la
288 $process_pid =
289 }
290 $last_procmap{$pid} =
291
292 if ($opt_read_procstat
293 $statline = re
294 if ($opt_read_
295 $proce
296 }
297 }
298 } else {
299 next;
300 }
301
302 # Perl Switch() sucks majorly
303 if ($tracepoint eq "mm_vmscan_
304 $timestamp = timestamp
305 $perprocesspid{$proces
306 $perprocesspid{$proces
307
308 $details = $6;
309 if ($details !~ /$rege
310 print "WARNING
311 print "
312 print "
313 next;
314 }
315 my $order = $1;
316 $perprocesspid{$proces
317 $perprocesspid{$proces
318 } elsif ($tracepoint eq "mm_vm
319 # Count the event itse
320 my $index = $perproces
321 $perprocesspid{$proces
322
323 # Record how long dire
324 if (defined $perproces
325 $timestamp = t
326 my $order = $p
327 my $latency =
328 $perprocesspid
329 }
330 } elsif ($tracepoint eq "mm_vm
331 $details = $6;
332 if ($details !~ /$rege
333 print "WARNING
334 print "
335 print "
336 next;
337 }
338
339 my $order = $2;
340 $perprocesspid{$proces
341 if (!$perprocesspid{$p
342 $timestamp = t
343 $perprocesspid
344 $perprocesspid
345 $perprocesspid
346 } else {
347 $perprocesspid
348 $perprocesspid
349 }
350 } elsif ($tracepoint eq "mm_vm
351
352 # Count the event itse
353 my $index = $perproces
354 $perprocesspid{$proces
355
356 # Record how long kswa
357 $timestamp = timestamp
358 my $order = $perproces
359 my $latency = ($timest
360 $perprocesspid{$proces
361 $perprocesspid{$proces
362 } elsif ($tracepoint eq "mm_vm
363 $perprocesspid{$proces
364
365 $details = $6;
366 if ($details !~ /$rege
367 print "WARNING
368 print "
369 print "
370 next;
371 }
372 my $order = $2;
373 $perprocesspid{$proces
374 } elsif ($tracepoint eq "mm_vm
375 $details = $6;
376 if ($details !~ /$rege
377 print "WARNING
378 print "
379 print "
380 next;
381 }
382 my $nr_scanned = $4;
383 my $lru = $7;
384
385 # To closer match vmst
386 # inactive lru as scan
387 if ($lru =~ /inactive_
388 $perprocesspid
389 if ($lru =~ /_
390 $perpr
391 } else {
392 $perpr
393 }
394 }
395 } elsif ($tracepoint eq "mm_vm
396 $details = $6;
397 if ($details !~ /$rege
398 print "WARNING
399 print "
400 print "
401 next;
402 }
403
404 my $nr_reclaimed = $3;
405 my $flags = $13;
406 my $file = 0;
407 if ($flags =~ /RECLAIM
408 $file = 1;
409 }
410 $perprocesspid{$proces
411 if ($file) {
412 $perprocesspid
413 } else {
414 $perprocesspid
415 }
416 } elsif ($tracepoint eq "mm_vm
417 $details = $6;
418 if ($details !~ /$rege
419 print "WARNING
420 print "
421 print "
422 next;
423 }
424
425 my $flags = $3;
426 my $file = 0;
427 my $sync_io = 0;
428 if ($flags =~ /RECLAIM
429 $file = 1;
430 }
431 if ($flags =~ /RECLAIM
432 $sync_io = 1;
433 }
434 if ($sync_io) {
435 if ($file) {
436 $perpr
437 } else {
438 $perpr
439 }
440 } else {
441 if ($file) {
442 $perpr
443 } else {
444 $perpr
445 }
446 }
447 } else {
448 $perprocesspid{$proces
449 }
450
451 if ($sigint_pending) {
452 last EVENT_PROCESS;
453 }
454 }
455 }
456
457 sub dump_stats {
458 my $hashref = shift;
459 my %stats = %$hashref;
460
461 # Dump per-process stats
462 my $process_pid;
463 my $max_strlen = 0;
464
465 # Get the maximum process name
466 foreach $process_pid (keys %perprocess
467 my $len = length($process_pid)
468 if ($len > $max_strlen) {
469 $max_strlen = $len;
470 }
471 }
472 $max_strlen += 2;
473
474 # Work out latencies
475 printf("\n") if !$opt_ignorepid;
476 printf("Reclaim latencies expressed as
477 foreach $process_pid (keys %stats) {
478
479 if (!$stats{$process_pid}->{HI
480 !$stats{$proce
481 next;
482 }
483
484 printf "%-" . $max_strlen . "s
485 my $index = 0;
486 while (defined $stats{$process
487 defined $stats{$proces
488
489 if ($stats{$process_pi
490 printf("%s ",
491 my ($dummy, $l
492 $total_direct_
493 } else {
494 printf("%s ",
495 my ($dummy, $l
496 $total_kswapd_
497 }
498 $index++;
499 }
500 print "\n" if !$opt_ignorepid;
501 }
502
503 # Print out process activity
504 printf("\n");
505 printf("%-" . $max_strlen . "s %8s %10
506 printf("%-" . $max_strlen . "s %8s %10
507 foreach $process_pid (keys %stats) {
508
509 if (!$stats{$process_pid}->{MM
510 next;
511 }
512
513 $total_direct_reclaim += $stat
514 $total_wakeup_kswapd += $stats
515 $total_direct_nr_scanned += $s
516 $total_direct_nr_file_scanned
517 $total_direct_nr_anon_scanned
518 $total_direct_nr_reclaimed +=
519 $total_direct_nr_file_reclaime
520 $total_direct_nr_anon_reclaime
521 $total_direct_writepage_file_s
522 $total_direct_writepage_anon_s
523 $total_direct_writepage_file_a
524
525 $total_direct_writepage_anon_a
526
527 my $index = 0;
528 my $this_reclaim_delay = 0;
529 while (defined $stats{$process
530 my ($dummy, $latency)
531 $this_reclaim_delay +=
532 $index++;
533 }
534
535 printf("%-" . $max_strlen . "s
536 $process_pid,
537 $stats{$process_pid}->
538 $stats{$process_pid}->
539 $stats{$process_pid}->
540 $stats{$process_pid}->
541 $stats{$process_pid}->
542 $stats{$process_pid}->
543 $stats{$process_pid}->
544 $stats{$process_pid}->
545 $stats{$process_pid}->
546 $stats{$process_pid}->
547 $this_reclaim_delay /
548
549 if ($stats{$process_pid}->{MM_
550 print " ";
551 for (my $order = 0; $o
552 my $count = $s
553 if ($count !=
554 print
555 }
556 }
557 }
558 if ($stats{$process_pid}->{MM_
559 print " ";
560 for (my $order = 0; $o
561 my $count = $s
562 if ($count !=
563 print
564 }
565 }
566 }
567
568 print "\n";
569 }
570
571 # Print out kswapd activity
572 printf("\n");
573 printf("%-" . $max_strlen . "s %8s %10
574 printf("%-" . $max_strlen . "s %8s %10
575 foreach $process_pid (keys %stats) {
576
577 if (!$stats{$process_pid}->{MM
578 next;
579 }
580
581 $total_kswapd_wake += $stats{$
582 $total_kswapd_nr_scanned += $s
583 $total_kswapd_nr_file_scanned
584 $total_kswapd_nr_anon_scanned
585 $total_kswapd_nr_reclaimed +=
586 $total_kswapd_nr_file_reclaime
587 $total_kswapd_nr_anon_reclaime
588 $total_kswapd_writepage_file_s
589 $total_kswapd_writepage_anon_s
590 $total_kswapd_writepage_file_a
591 $total_kswapd_writepage_anon_a
592
593 printf("%-" . $max_strlen . "s
594 $process_pid,
595 $stats{$process_pid}->
596 $stats{$process_pid}->
597 $stats{$process_pid}->
598 $stats{$process_pid}->
599 $stats{$process_pid}->
600 $stats{$process_pid}->
601 $stats{$process_pid}->
602 $stats{$process_pid}->
603 $stats{$process_pid}->
604 $stats{$process_pid}->
605
606 if ($stats{$process_pid}->{MM_
607 print " ";
608 for (my $order = 0; $o
609 my $count = $s
610 if ($count !=
611 print
612 }
613 }
614 }
615 if ($stats{$process_pid}->{HIG
616 print " ";
617 for (my $order = 0; $o
618 my $count = $s
619 if ($count !=
620 print
621 }
622 }
623 }
624 printf("\n");
625 }
626
627 # Print out summaries
628 $total_direct_latency /= 1000;
629 $total_kswapd_latency /= 1000;
630 print "\nSummary\n";
631 print "Direct reclaims:
632 print "Direct reclaim pages scanned:
633 print "Direct reclaim file pages scann
634 print "Direct reclaim anon pages scann
635 print "Direct reclaim pages reclaimed:
636 print "Direct reclaim file pages recla
637 print "Direct reclaim anon pages recla
638 print "Direct reclaim write file sync
639 print "Direct reclaim write anon sync
640 print "Direct reclaim write file async
641 print "Direct reclaim write anon async
642 print "Wake kswapd requests:
643 printf "Time stalled direct reclaim:
644 print "\n";
645 print "Kswapd wakeups:
646 print "Kswapd pages scanned:
647 print "Kswapd file pages scanned:
648 print "Kswapd anon pages scanned:
649 print "Kswapd pages reclaimed:
650 print "Kswapd file pages reclaimed:
651 print "Kswapd anon pages reclaimed:
652 print "Kswapd reclaim write file sync
653 print "Kswapd reclaim write anon sync
654 print "Kswapd reclaim write file async
655 print "Kswapd reclaim write anon async
656 printf "Time kswapd awake:
657 }
658
659 sub aggregate_perprocesspid() {
660 my $process_pid;
661 my $process;
662 undef %perprocess;
663
664 foreach $process_pid (keys %perprocess
665 $process = $process_pid;
666 $process =~ s/-([0-9])*$//;
667 if ($process eq '') {
668 $process = "NO_PROCESS
669 }
670
671 $perprocess{$process}->{MM_VMS
672 $perprocess{$process}->{MM_VMS
673 $perprocess{$process}->{MM_VMS
674 $perprocess{$process}->{HIGH_K
675 $perprocess{$process}->{HIGH_N
676 $perprocess{$process}->{HIGH_N
677 $perprocess{$process}->{HIGH_N
678 $perprocess{$process}->{HIGH_N
679 $perprocess{$process}->{HIGH_N
680 $perprocess{$process}->{HIGH_N
681 $perprocess{$process}->{MM_VMS
682 $perprocess{$process}->{MM_VMS
683 $perprocess{$process}->{MM_VMS
684 $perprocess{$process}->{MM_VMS
685
686 for (my $order = 0; $order < 2
687 $perprocess{$process}-
688 $perprocess{$process}-
689 $perprocess{$process}-
690
691 }
692
693 # Aggregate direct reclaim lat
694 my $wr_index = $perprocess{$pr
695 my $rd_index = 0;
696 while (defined $perprocesspid{
697 $perprocess{$process}-
698 $rd_index++;
699 $wr_index++;
700 }
701 $perprocess{$process}->{MM_VMS
702
703 # Aggregate kswapd latencies
704 my $wr_index = $perprocess{$pr
705 my $rd_index = 0;
706 while (defined $perprocesspid{
707 $perprocess{$process}-
708 $rd_index++;
709 $wr_index++;
710 }
711 $perprocess{$process}->{MM_VMS
712 }
713 }
714
715 sub report() {
716 if (!$opt_ignorepid) {
717 dump_stats(\%perprocesspid);
718 } else {
719 aggregate_perprocesspid();
720 dump_stats(\%perprocess);
721 }
722 }
723
724 # Process events or signals until neither is a
725 sub signal_loop() {
726 my $sigint_processed;
727 do {
728 $sigint_processed = 0;
729 process_events();
730
731 # Handle pending signals if an
732 if ($sigint_pending) {
733 my $current_time = tim
734
735 if ($sigint_exit) {
736 print "Receive
737 $sigint_pendin
738 }
739 if ($sigint_report) {
740 if ($current_t
741 report
742 $sigin
743 $sigin
744 $sigin
745 }
746 }
747 }
748 } while ($sigint_pending || $sigint_pr
749 }
750
751 signal_loop();
752 report();
Linux® is a registered trademark of Linus Torvalds in the United States and other countries.
TOMOYO® is a registered trademark of NTT DATA CORPORATION.