############################################################################
#
#	Name:	memsum.icn
#
#	Title:	Summarize Icon memory management
#
#	Author:	Ralph E. Griswold
#
#	Date:	March 8, 1990
#
############################################################################
#
#     This program is a filter for Icon allocation history files (see IPD113).
#  It tabulates the number of allocations by type and the total amount of
#  storage (in bytes) by type.
#
#     It takes an Icon allocation history file from standard input and writes to
#  standard output.
#
#     The command-line options are:
#
#	-t	produce tab-separated output for use in spreadsheets (the
#		   default is a formatted report
#	-d	produce debugging output
#
#  Some assumptions are made about where newlines occur -- specifically
#  that verification commands are on single lines and that refresh and
#  garbage collection data are on multiple lines.
#
############################################################################
#
#  Links: numbers, options
#
############################################################################

global cmds, highlights, lastlen, alloccnt, alloctot, collections
global mmunits, diagnose, namemap

link numbers, options

procedure main(args)
   local line, region, s, skip, opts

   opts := options(args,"dt")
   diagnose := if \opts["d"] then write else 1
   display := if \opts["t"] then spread else report

   cmds := 'cefihLlRrSsTtux"XAF'		# command characters
   highlights := '%$Y'			# highlight commands
   mmunits := 4				# (for most systems)
   namemap := table("*** undefined ***")
   namemap["b"] := "large integer"
   namemap["c"] := "cset"
   namemap["e"] := "table element tv"
   namemap["f"] := "file"
   namemap["h"] := "hash block"
   namemap["i"] := "large integer"
   namemap["L"] := "list header"
   namemap["l"] := "list element"
   namemap["R"] := "record"
   namemap["r"] := "real number"
   namemap["S"] := "set header"
   namemap["s"] := "set element"
   namemap["T"] := "table header"
   namemap["t"] := "table element"
   namemap["u"] := "substring tv"
   namemap["x"] := "refresh block"
   namemap["\""] := "string"
   namemap["X"] := "co-expression"
   namemap["A"] := "alien block"
   namemap["F"] := "free space"

   lastlen := table()			# last size
   alloccnt := table(0)			# count of allocations
   alloctot := table(0)			# total allocation
   collections := list(4,0)		# garbage collection counts

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

   cmds ++:= highlights

   while line := read() do {		# input from MemMon history file
      line ? {				# note: coded for extensions
         if region := tab(upto('{')) then {	# skip refresh sequence
            collections[region] +:= 1
            while line := read() | stop("**** premature eof") do
               line ? if upto('#!') then break next
            }
         case move(1) of {

            "=": next			# skip verification command
            "#": next			# skip comment
            ";": next			# skip pause command
            "!" | ">": next		# resynchronize (edited file)

            default: {			# data to process
               move(-1)			# back off from move(1) above
               if s := tab(upto('<')) then {
                  mmunits := integer(s)	# covers old case with no mmunits
                  while line := read() | stop("**** premature eof") do
                     line ? if upto('#>') then break next
                  }
               else {
                  repeat {			# process allocation
                     tab(many(' '))	# skip blanks (old files)
                     if pos(0) then break next
                     skip := process(tab(upto(cmds) + 1)) |
                        stop("*** unexpected data: ",line)
                     move(skip)
                     }
                  }
               }
            }
         }
      }

   display()

end

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

   static col1, col2, gutter		# column widths

   initial {
      col1 := 16			# name field
      col2 := 10			# number field
      gutter := repl(" ",6)
      }

   write(,				# write column headings
      "\n",
      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(						# write the data
      left(namemap[get(alloccnt)],col1),		# name
      right(cnt := get(alloccnt),col2),			# number of allocations
      gutter,
      get(alloctot) & right(tot := get(alloctot),col2),	# space allocated
      gutter,
      fix(tot,cnt,col2) | repl(" ",col2),
      gutter,
      fix(100.0 * tot,tottotal,col2) | repl(" ",col2)
      )

   write(						# write totals
      "\n",
      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("\n",left("collections:",col1),right(totalcoll,col2))
   if totalcoll > 0 then {
      write(left("  static region:",col1),right(collections[1],col2))
      write(left("  string region:",col1),right(collections[2],col2))
      write(left("  block region:",col1),right(collections[3],col2))
      write(left("  no region:",col1),right(collections[4],col2))
      }

   return
end

#  Produce tab-separated output for a spreadsheet.
#
procedure spread()

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

   write("*\nname	number	bytes")

   while write(						# write the data
      namemap[get(alloccnt)],
      "\t",
      get(alloccnt),
      "\t",
      get(alloctot) & get(alloctot),
      )

   return
end

#  Process datm
#
procedure process(s)
   local cmd, len

   s ? {
      tab(upto('+') + 1)		# skip address
      len := tab(many(&digits)) | &null
      cmd := move(1)

      if cmd == !highlights then return 2 else {
   					# if given len is nonstring, scale
         if cmd ~== "\"" then \len *:= mmunits
         alloccnt[cmd] +:= 1
         (/len := lastlen[cmd]) | (lastlen[cmd] := len)
         diagnose(&errout,"cmd=",cmd,", len=",len)
         alloctot[cmd] +:= len
         return 0
         }
      }
end