summaryrefslogtreecommitdiff
path: root/ipl/mprogs/memsum.icn
blob: 95ef2c108101d0f2d74c45ff8d97c448594cd43a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
############################################################################
#
#	File:     memsum.icn
#
#	Subject:  Program to tabulate memory allocation
#
#	Author:   Ralph E. Griswold
#
#	Date:     August 17, 1994
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This tool tabulates storage allocation.  It is called as
#
#	memsum prog
#
#  where prog is a program compiled under MT Icon whose events are to
#  be tabulated.
#	
#  The options supported are:
#
#	-o s	write output to file s; default &output.
#
#	-t	record time spent in monitoring.
#
############################################################################
#
#  Requires:  MT Icon and event monitoring.
#
############################################################################
#
#  Links:  evinit, evnames, numbers, options
#
############################################################################
#
#  Includes:  evdefs.icn
#
############################################################################

link evinit
link evnames
link numbers
link options

$include "evdefs.icn"

global highlights, alloccnt, alloctot, collections, output

procedure main(args)
   local opts, itime, mask

   opts := options(args, "to:")
   output := open(\opts["o"], "w") | &output
   if \opts["t"] then itime := &time

   EvInit(args) | stop("*** cannot load program")	# initialize interface

   alloccnt := table(0)			# count of allocations
   alloctot := table(0)			# total allocation
   collections := table(0)		# garbage collection counts

   #  Be sure all allocation types are listed even if there is no allocation
   #  for them.

   every alloccnt[!AllocMask] := 0
   every alloctot[!AllocMask] := 0

   mask := AllocMask ++ E_Collect

   while EvGet(mask) do 
      if &eventcode === E_Collect then collections[&eventvalue] +:= 1
      else {
         alloccnt[&eventcode] +:= 1
         alloctot[&eventcode] +:= &eventvalue
         }

   report()

   write(output, "\nelapsed time: ", &time - \itime, "ms")

end

#  Display a table of allocation data
#
procedure report()
   local i, cnttotal, tottotal, cnt, tot, totalcoll

   static col1, col2, gutter		# column widths

   initial {
      col1 := 20			# name field
      col2 := 10			# number field
      gutter := "  "
      }

   write(output, "\n",			# write column headings
      left("type",col1), right("number",col2), gutter,
      right("bytes",col2), gutter, right("average",col2), gutter,
      right("% bytes",col2), "\n"
      )

   alloccnt := sort(alloccnt, 3)				# get the data
   alloctot := sort(alloctot, 3)

   cnttotal := 0
   tottotal := 0
 
   every i := 2 to *alloccnt by 2 do {
      cnttotal +:= alloccnt[i]
      tottotal +:= alloctot[i]
      }

   while write(output,					# write the data
      left(name(get(alloccnt)), col1),
      right(cnt := get(alloccnt), col2), gutter,
      get(alloctot) & right(tot := get(alloctot), col2), gutter,
      fix(tot, cnt, col2, 2) | right("0.00", col2), gutter,
      fix(100.0 * tot, tottotal, col2, 2) | right("0.00", col2)
      )

   write(output, "\n",					# write totals
      left("total:",col1), right(cnttotal,col2), gutter, right(tottotal,col2),
      gutter, fix(tottotal,cnttotal,col2) | repl(" ",col2)
      )

   totalcoll := 0					# garbage collections
   every totalcoll +:= !collections
   write(output,"\n",left("collections:",col1),right(totalcoll,col2))
   if totalcoll > 0 then {
      write(output,left("  static region:",col1),right(collections[1],col2))
      write(output,left("  string region:",col1),right(collections[2],col2))
      write(output,left("  block region:",col1),right(collections[3],col2))
      write(output,left("  no region:",col1),right(collections[0],col2))
      }

   return
end

#  Produce event name
#
procedure name(code)
   local result

   result := evnames(code)

   result ?:= tab(find(" allocation"))

   result ?:= {
      tab(find("trapped variable")) || "tv"
      }

   return result

end