module:    devel-dbg-ui
synopsis:  Class for the profiled app, methods to process & print profile data
author:    Andy Armstrong, Paul Howard, Keith Dennison
Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
              All rights reserved.
License:      See License.txt in this distribution for details.
Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND

define method ip-to-name 
    (application :: <debug-target>, ip :: <remote-value>)
 => (name :: false-or(<string>), dll :: false-or(<symbol>), 
     filename :: false-or(<string>), linenumber :: false-or(<integer>))

  let st = debug-target-symbol-table(application);
  let (nearest, offset) = symbol-table-symbol-relative-address (st, ip);
  if (nearest)
    let dll-context = nearest.remote-symbol-library;
    let dll
      = if (dll-context)
	  as(<symbol>, as-lowercase(dll-context.library-core-name))
	else
	  "INTERACTIVE"
	end;
    let source-locator-map
      = function-source-location-map
          (application.debug-target-access-path, nearest);
    let filename
      = source-locator-map & source-filename(source-locator-map);
    let linenumber
      = source-locator-map & base-linenumber(source-locator-map);
    let name = nearest.remote-symbol-name;
    values(name, dll, filename, linenumber)
  else
    values(#f, #f, #f, #f)
  end if
end method;


//////
// Updates the counts for a thread given its profile. A thread's profile
// consists of a sequence of snapshots, each snapshot having a weight based
// on the cpu-time the thread had since the previous snapshot and a sequence
// of instruction pointers associated with the frames on the stack when the
// snapshot was taken.
//
define method process-thread-profile-data
    (application :: <application>, profiler-run :: <profiler-run>,
     thread :: <remote-thread>, snapshots :: <sequence>)
 => ()
  let options = profiler-run.profiler-options;
  let results = application.application-profiler-run.profiler-results;

  // Find the thread-counter-group for the thread
  let group = element(results.counter-groups-table, thread, default: #f);

  // If there isn't one for this thread, then make one.
  unless (group)
    let ap = application.debug-target-access-path;
    group := make(<thread-counter-group>, debug-target: application);
    results.counter-groups-table[thread] := group;
  end unless;

  let inclusive? = application-profile-inclusive?(application);
  let exclusive? = application-profile-exclusive?(application);
  let (weight-function, thread-value?)
    = select (options.profiler-style)
	#"cpu-time"         => values(cpu-time-increment,    #t);
	#"allocation"       => values(allocation-increment,  #t);
	#"class-allocation" => values(allocation-increment,  #t);
	#"wall-clock-time"  => values(wall-time-increment,   #f);
	#"page-faults"      => values(page-faults-increment, #f);
      end;
  let last-thread-snapshot = #f;
  // Update the counter group with each snapshot
  for (snapshot :: <application-snapshot> in snapshots,
       last-snapshot = #f then snapshot)
    let thread-snapshot = application-thread-snapshot(snapshot, thread);
    if (~thread-value? | thread-snapshot)
      let weight
	= if (thread-value?)
	    weight-function(thread-snapshot)
	  else
	    weight-function(snapshot)
	  end;
      thread-counter-group-process-snapshot
	(group, weight, thread-snapshot, last-thread-snapshot,
	 inclusive?: inclusive?, exclusive?: exclusive?);
      last-thread-snapshot := thread-snapshot
    end
  end;
  group.thread-counter-group-samples := size(snapshots);
end method;


//////
// Take the data generated by the profiler manager and process it to get the
// counts we are interested in.
//
define method process-profile-data (application :: <application>)
  let profiler-run = application.application-profiler-run;
  profiler-run.profiler-results := make(<profiler-results>);
  let profile = application.profile-data;
  let snapshots = profile.application-snapshots;
  for (thread in profile.application-profile-threads)
    process-thread-profile-data(application, profiler-run, thread, snapshots)
  end
end method;

define method print-profile-results
    (application :: <application>) => ()
  let profiler-run = application.application-profiler-run;
  let results = profiler-run.profiler-results;
  let options = profiler-run.profiler-options;
  let path = *open-application*.debug-target-access-path;
  let name = path.access-path-application;
  select(options.profiler-style)
    #"cpu-time" =>
      print-cpu-time-profile-results(application, name, options, results);
    #"wall-clock-time" =>
      print-wall-time-profile-results(application, name, options, results);
    #"allocation", #"class-allocation" =>
      print-allocation-profile-results(application, name, options, results);
    #"page-faults" =>
      print-page-fault-profile-results(application, name, options, results);
  end select;
end method;

//////
// Prints the counts calculated for the target application. This should only
// be called after process-profile-data. This function gets the count data
// from the same table process-profile-data uses to generate it. It finds the
// count data for each thread that was profiled, sorts and prints the seen on
// stack and top of stack counts.
//
define method print-cpu-time-profile-results
    (application :: <application>, name :: <string>, 
     options :: <profiler-options>, results :: <profiler-results>,
     #key function-name :: false-or(<string>) = #f)
 => ()
  format-out ("\nCPU Usage Profile Report for %s\n", name);
  format-out ("Profile interval was %dms\n", options.profiler-interval);
  if (function-name)
    format-out("Profiled in function \"%s\"\n", function-name);
  end if;
  for (counter-group keyed-by thread in results.counter-groups-table)
    format-out ("\n\nData for thread %s:\n", thread-name (thread));
    thread-counter-group-display
      (counter-group, "CPU mSec |   #   |  %%  | CUM %%",
       inclusive?: application-profile-inclusive?(application),
       exclusive?: application-profile-exclusive?(application));
  end for;
  format-out ("\n\n");
end method;

define method print-wall-time-profile-results
    (application :: <application>, name :: <string>, 
     options :: <profiler-options>, results :: <profiler-results>,
     #key function-name :: false-or(<string>) = #f)
 => ()
  format-out ("\nWall Clock Time Profile Report for %s\n", name);
  format-out ("Profile interval was %dms\n", options.profiler-interval);
  if (function-name)
    format-out("Profiled in function \"%s\"\n", function-name);
  end if;
  for (counter-group keyed-by thread in results.counter-groups-table)
    format-out ("\n\nData for thread %s:\n", thread-name (thread));
    thread-counter-group-display
      (counter-group, "CLK mSec |   #   |  %%  | CUM %%",
       inclusive?: application-profile-inclusive?(application),
       exclusive?: application-profile-exclusive?(application));
  end for;
  format-out ("\n\n");
end method;

define method print-page-fault-profile-results
    (application :: <application>, name :: <string>,
     options :: <profiler-options>, results :: <profiler-results>,
     #key function-name :: false-or(<string>) = #f)
 => ()
  format-out ("\nPage Fault Count Profile Report for %s\n", name);
  format-out ("Profile interval was %dms\n", options.profiler-interval);
  if (function-name)
    format-out("Profiled in function \"%s\"\n", function-name);
  end if;
  for (counter-group keyed-by thread in results.counter-groups-table)
    format-out ("\n\nData for thread %s:\n", thread-name (thread));
    thread-counter-group-display (counter-group, "Faults   |   #   |   %%   | CUM %%");
  end for;
  format-out ("\n\n");
end method;

define method print-allocation-profile-results
    (application :: <application>, name :: <string>,
     options :: <profiler-options>, results :: <profiler-results>,
     #key function-name :: false-or(<string>) = #f)
 => ()
  format-out ("\nAllocation Profile Report for %s\n", name);
  if (function-name)
    format-out("Profiled in function \"%s\"\n", function-name);
  end if;
  for (counter-group keyed-by thread in results.counter-groups-table)
    format-out ("\n\nData for thread %s:\n", thread-name (thread));
    thread-counter-group-display (counter-group, "Alloc'd  |   #   |   %%   | CUM %%");
  end for;
  format-out ("\n\n");
end method;

////
//// PROFILE-SETS
////


define class <profile-set> (<object>)
  slot profile-set-name :: false-or(<symbol>) = #f, init-keyword: name:;
  slot profile-set-function-descriptor :: <aggregate-function-descriptor>;
end class;

define method initialize (set :: <profile-set>, #key, #all-keys) => ()
  next-method();
  profile-set-function-descriptor(set)
    := make(<aggregate-function-descriptor>, set: set);
end method;

define generic profile-set-member? 
  (function :: <single-function-descriptor>, set :: <profile-set>) => (well? :: <boolean>);
define generic profile-set-print
  (set :: <profile-set>);

define class <profile-set-empty> (<profile-set>)
end class;

define method profile-set-print (set :: <profile-set-empty>)
  format-out("EMPTY");
end method;

define method profile-set-member? 
    (function :: <single-function-descriptor>, set :: <profile-set-empty>)
 => (well? :: <boolean>)
  #f
end method;

define class <profile-set-full> (<profile-set>)
end class;

define method profile-set-print (set :: <profile-set-full>)
  format-out("FULL");
end method;

define method profile-set-member? 
    (function :: <single-function-descriptor>, set :: <profile-set-full>)
 => (well? :: <boolean>)
  #t
end method;

define class <profile-set-function> (<profile-set>)
  constant slot profile-set-function, init-keyword: function:;
end class;

define method profile-set-print (set :: <profile-set-function>)
  format-out("FUNCTION %=", profile-set-function(set));
end method;

define method profile-set-member? 
    (function :: <single-function-descriptor>, set :: <profile-set-function>)
 => (well? :: <boolean>)
  let r = function-descriptor-name(function) = profile-set-function(set);
  // debugger-message("%= = %= %=", 
  // 	              function-descriptor-name(function), profile-set-function(set), r);
  r
end method;

define class <profile-set-contains> (<profile-set>)
  constant slot profile-set-contains, init-keyword: contains:;
end class;

define method profile-set-print (set :: <profile-set-contains>)
  format-out("CONTAINS %=", profile-set-contains(set));
end method;

define method profile-set-member? 
    (function :: <single-function-descriptor>, set :: <profile-set-contains>)
 => (well? :: <boolean>)
  let name = function-descriptor-raw-name(function);
  if (name)
    let r = subsequence-position(name, profile-set-contains(set));
    // debugger-message("CONTAINS? %= %= %=", 
    // 	              function-descriptor-raw-name(function), profile-set-contains(set), r);
    r ~== #f
  end if;
end method;

define class <profile-set-dll> (<profile-set>)
  constant slot profile-set-dll, init-keyword: dll:;
end class;

define method profile-set-print (set :: <profile-set-dll>)
  format-out("DLL %=", profile-set-dll(set));
end method;

define method profile-set-member?
    (function :: <single-function-descriptor>, set :: <profile-set-dll>)
 => (well? :: <boolean>)
  let r = function-descriptor-dll(function) == profile-set-dll(set);
  // debugger-message("DLL %= = %= %=", 
  // 	              function-descriptor-dll(function), profile-set-dll(set), r);
  r
end method;

define class <profile-set-library> (<profile-set>)
  constant slot profile-set-library, init-keyword: library:;
end class;

define method profile-set-print (set :: <profile-set-library>)
  format-out("LIBRARY %=", profile-set-library(set));
end method;

define method profile-set-member?
    (function :: <single-function-descriptor>, set :: <profile-set-library>)
 => (well? :: <boolean>)
  let r = function-descriptor-library(function) == profile-set-library(set);
  // debugger-message("LIBRARY %= = %= %=", 
  // 	              function-descriptor-library(function), profile-set-library(set), r);
  r
end method;

define class <profile-set-module> (<profile-set>)
  constant slot profile-set-module, init-keyword: module:;
end class;

define method profile-set-print (set :: <profile-set-module>)
  format-out("MODULE %=", profile-set-module(set));
end method;

define method profile-set-member?
    (function :: <single-function-descriptor>, set :: <profile-set-module>) => (well? :: <boolean>)
  function-descriptor-module(function) == profile-set-module(set)
end method;

define class <profile-set-file> (<profile-set>)
  constant slot profile-set-file, init-keyword: file:;
end class;

define method profile-set-print (set :: <profile-set-file>)
  format-out("FILE %=", profile-set-file(set));
end method;

define method profile-set-member?
    (function :: <single-function-descriptor>, set :: <profile-set-file>) => (well? :: <boolean>)
  let r = function-descriptor-filename(function) = profile-set-file(set);
  // debugger-message("FILE %= = %= %=", 
  // 	           function-descriptor-filename(function), profile-set-file(set), r);
  r
end method;

define class <profile-set-complement> (<profile-set>)
  constant slot profile-set-complementee, init-keyword: complementee:;
end class;

define method profile-set-print (set :: <profile-set-complement>)
  format-out("NOT ");
  profile-set-print(profile-set-complementee(set));
end method;

define method profile-set-member?
    (function :: <single-function-descriptor>, set :: <profile-set-complement>)
 => (well? :: <boolean>)
  ~profile-set-member?(function, profile-set-complementee(set))
end method;

define class <profile-set-union> (<profile-set>)
  constant slot profile-set-unionees, init-keyword: unionees:;
end class;

define method profile-set-print (set :: <profile-set-union>)
  format-out("UNION");
  for (unionee in profile-set-unionees(set))
    format-out(" ");
    profile-set-print(unionee);
  end for;
end method;

define method profile-set-member? 
    (function :: <single-function-descriptor>, set :: <profile-set-union>)
 => (well? :: <boolean>)
  any?(curry(profile-set-member?, function), profile-set-unionees(set))
end method;

define class <profile-set-intersection> (<profile-set>)
  constant slot profile-set-intersectionees, init-keyword: intersectionees:;
end class;

define method profile-set-print (set :: <profile-set-intersection>)
  format-out("INTERSECTION");
  for (intersectionee in profile-set-intersectionees(set))
    format-out(" ");
    profile-set-print(intersectionee);
  end for;
end method;

define method profile-set-member? 
    (function :: <single-function-descriptor>, set :: <profile-set-intersection>)
 => (well? :: <boolean>)
  every?(curry(profile-set-member?, function), profile-set-intersectionees(set))
end method;

define method profile-sets-print (sets :: <table>)
  for (value keyed-by key in sets)
    format-out(";;; %s = ", key);
    profile-set-print(value);
    format-out("\n");
  end for;
end method;

// define class <profile-set-top-percentile> (<profile-set-top-percentile>)
//   slot profile-set-top-percentile, init-keyword: top-percentile:;
// end class;
// 
// define method profile-set-member? 
//     (id, set :: <profile-set-top-percentile>) => (well? :: <boolean>)
//   #t
// end method;

