home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / exoten / icon / memsum.icn < prev    next >
Encoding:
Text File  |  1990-03-08  |  6.7 KB  |  234 lines
  1. ############################################################################
  2. #
  3. #    Name:    memsum.icn
  4. #
  5. #    Title:    Summarize Icon memory management
  6. #
  7. #    Author:    Ralph E. Griswold
  8. #
  9. #    Date:    March 8, 1990
  10. #
  11. ############################################################################
  12. #
  13. #     This program is a filter for Icon allocation history files (see IPD113).
  14. #  It tabulates the number of allocations by type and the total amount of
  15. #  storage (in bytes) by type.
  16. #
  17. #     It takes an Icon allocation history file from standard input and writes to
  18. #  standard output.
  19. #
  20. #     The command-line options are:
  21. #
  22. #    -t    produce tab-separated output for use in spreadsheets (the
  23. #           default is a formatted report
  24. #    -d    produce debugging output
  25. #
  26. #  Some assumptions are made about where newlines occur -- specifically
  27. #  that verification commands are on single lines and that refresh and
  28. #  garbage collection data are on multiple lines.
  29. #
  30. ############################################################################
  31. #
  32. #  Links: numbers, options
  33. #
  34. ############################################################################
  35.  
  36. global cmds, highlights, lastlen, alloccnt, alloctot, collections
  37. global mmunits, diagnose, namemap
  38.  
  39. link numbers, options
  40.  
  41. procedure main(args)
  42.    local line, region, s, skip, opts
  43.  
  44.    opts := options(args,"dt")
  45.    diagnose := if \opts["d"] then write else 1
  46.    display := if \opts["t"] then spread else report
  47.  
  48.    cmds := 'cefihLlRrSsTtux"XAF'        # command characters
  49.    highlights := '%$Y'            # highlight commands
  50.    mmunits := 4                # (for most systems)
  51.    namemap := table("*** undefined ***")
  52.    namemap["b"] := "large integer"
  53.    namemap["c"] := "cset"
  54.    namemap["e"] := "table element tv"
  55.    namemap["f"] := "file"
  56.    namemap["h"] := "hash block"
  57.    namemap["i"] := "large integer"
  58.    namemap["L"] := "list header"
  59.    namemap["l"] := "list element"
  60.    namemap["R"] := "record"
  61.    namemap["r"] := "real number"
  62.    namemap["S"] := "set header"
  63.    namemap["s"] := "set element"
  64.    namemap["T"] := "table header"
  65.    namemap["t"] := "table element"
  66.    namemap["u"] := "substring tv"
  67.    namemap["x"] := "refresh block"
  68.    namemap["\""] := "string"
  69.    namemap["X"] := "co-expression"
  70.    namemap["A"] := "alien block"
  71.    namemap["F"] := "free space"
  72.  
  73.    lastlen := table()            # last size
  74.    alloccnt := table(0)            # count of allocations
  75.    alloctot := table(0)            # total allocation
  76.    collections := list(4,0)        # garbage collection counts
  77.  
  78.    every alloccnt[!cmds] := 0
  79.    every alloctot[!cmds] := 0
  80.  
  81.    cmds ++:= highlights
  82.  
  83.    while line := read() do {        # input from MemMon history file
  84.       line ? {                # note: coded for extensions
  85.          if region := tab(upto('{')) then {    # skip refresh sequence
  86.             collections[region] +:= 1
  87.             while line := read() | stop("**** premature eof") do
  88.                line ? if upto('#!') then break next
  89.             }
  90.          case move(1) of {
  91.  
  92.             "=": next            # skip verification command
  93.             "#": next            # skip comment
  94.             ";": next            # skip pause command
  95.             "!" | ">": next        # resynchronize (edited file)
  96.  
  97.             default: {            # data to process
  98.                move(-1)            # back off from move(1) above
  99.                if s := tab(upto('<')) then {
  100.                   mmunits := integer(s)    # covers old case with no mmunits
  101.                   while line := read() | stop("**** premature eof") do
  102.                      line ? if upto('#>') then break next
  103.                   }
  104.                else {
  105.                   repeat {            # process allocation
  106.                      tab(many(' '))    # skip blanks (old files)
  107.                      if pos(0) then break next
  108.                      skip := process(tab(upto(cmds) + 1)) |
  109.                         stop("*** unexpected data: ",line)
  110.                      move(skip)
  111.                      }
  112.                   }
  113.                }
  114.             }
  115.          }
  116.       }
  117.  
  118.    display()
  119.  
  120. end
  121.  
  122. #  Display a table of allocation data
  123. #
  124. procedure report()
  125.    local cnt, cnttotal, i, tot, totalcoll, tottotal
  126.  
  127.    static col1, col2, gutter        # column widths
  128.  
  129.    initial {
  130.       col1 := 16            # name field
  131.       col2 := 10            # number field
  132.       gutter := repl(" ",6)
  133.       }
  134.  
  135.    write(,                # write column headings
  136.       "\n",
  137.       left("type",col1),
  138.       right("number",col2),
  139.       gutter,
  140.       right("bytes",col2),
  141.       gutter,
  142.       right("average",col2),
  143.       gutter,
  144.       right("% bytes",col2),
  145.       "\n"
  146.       )
  147.  
  148.    alloccnt := sort(alloccnt,3)                # get the data
  149.    alloctot := sort(alloctot,3)
  150.  
  151.    cnttotal := 0
  152.    tottotal := 0
  153.  
  154.    every i := 2 to *alloccnt by 2 do {
  155.       cnttotal +:= alloccnt[i]
  156.       tottotal +:= alloctot[i]
  157.       }
  158.  
  159.    while write(                        # write the data
  160.       left(namemap[get(alloccnt)],col1),        # name
  161.       right(cnt := get(alloccnt),col2),            # number of allocations
  162.       gutter,
  163.       get(alloctot) & right(tot := get(alloctot),col2),    # space allocated
  164.       gutter,
  165.       fix(tot,cnt,col2) | repl(" ",col2),
  166.       gutter,
  167.       fix(100.0 * tot,tottotal,col2) | repl(" ",col2)
  168.       )
  169.  
  170.    write(                        # write totals
  171.       "\n",
  172.       left("total:",col1),
  173.       right(cnttotal,col2),
  174.       gutter,
  175.       right(tottotal,col2),
  176.       gutter,
  177.       fix(tottotal,cnttotal,col2) | repl(" ",col2)
  178.       )
  179.  
  180.    totalcoll := 0                    # garbage collections
  181.    every totalcoll +:= !collections
  182.    write("\n",left("collections:",col1),right(totalcoll,col2))
  183.    if totalcoll > 0 then {
  184.       write(left("  static region:",col1),right(collections[1],col2))
  185.       write(left("  string region:",col1),right(collections[2],col2))
  186.       write(left("  block region:",col1),right(collections[3],col2))
  187.       write(left("  no region:",col1),right(collections[4],col2))
  188.       }
  189.  
  190.    return
  191. end
  192.  
  193. #  Produce tab-separated output for a spreadsheet.
  194. #
  195. procedure spread()
  196.  
  197.    alloccnt := sort(alloccnt,3)                # get the data
  198.    alloctot := sort(alloctot,3)
  199.  
  200.    write("*\nname    number    bytes")
  201.  
  202.    while write(                        # write the data
  203.       namemap[get(alloccnt)],
  204.       "\t",
  205.       get(alloccnt),
  206.       "\t",
  207.       get(alloctot) & get(alloctot),
  208.       )
  209.  
  210.    return
  211. end
  212.  
  213. #  Process datm
  214. #
  215. procedure process(s)
  216.    local cmd, len
  217.  
  218.    s ? {
  219.       tab(upto('+') + 1)        # skip address
  220.       len := tab(many(&digits)) | &null
  221.       cmd := move(1)
  222.  
  223.       if cmd == !highlights then return 2 else {
  224.                        # if given len is nonstring, scale
  225.          if cmd ~== "\"" then \len *:= mmunits
  226.          alloccnt[cmd] +:= 1
  227.          (/len := lastlen[cmd]) | (lastlen[cmd] := len)
  228.          diagnose(&errout,"cmd=",cmd,", len=",len)
  229.          alloctot[cmd] +:= len
  230.          return 0
  231.          }
  232.       }
  233. end
  234.