[m-rev.] for review: Generalise and tidy-up mdprof_feedback.m

Paul Bone pbone at csse.unimelb.edu.au
Tue Jul 29 17:54:04 AEST 2008


For review by anyone.

Estimated hours taken: 2.5
Branches: main

Modify mdprof_feedback in order to generalize it to extract different types
of information from deep profiling data for different compiler optimizations.

deep_profiler/mdprof_feedback.m:
	Alter command line options so that each type of feedback information can
	be specifically requested, and compiler optimizations can be specified
	that describe one or more types of information to request.
	Modify program structure to read in any existing feedback information, add
	any and all new information to the in memory structure, then write that
	back out.


Index: deep_profiler/mdprof_feedback.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/mdprof_feedback.m,v
retrieving revision 1.5
diff -u -p -r1.5 mdprof_feedback.m
--- deep_profiler/mdprof_feedback.m	23 Jul 2008 23:20:34 -0000	1.5
+++ deep_profiler/mdprof_feedback.m	29 Jul 2008 07:47:56 -0000
@@ -31,7 +31,6 @@
 :- implementation.
 
 :- import_module conf.
-:- import_module dump.
 :- import_module mdbcomp.
 :- import_module mdbcomp.feedback.
 :- import_module mdbcomp.program_representation.
@@ -44,14 +43,18 @@
 :- import_module char.
 :- import_module getopt.
 :- import_module int.
 :- import_module library.
 :- import_module list.
 :- import_module map.
 :- import_module maybe.
-:- import_module require.
 :- import_module string.
+:- import_module svmap.
 
 %-----------------------------------------------------------------------------%
+%
+% This section contains the main predicate as well as code to read the deep
+% profiling data and display usage and version messages to the user.
+%
 
 main(!IO) :-
     io.progname_base("mdprof_feedback", ProgName, !IO),
@@ -64,56 +67,55 @@ main(!IO) :-
         lookup_bool_option(Options, version, Version),
         lookup_string_option(Options, program_name, ProfileProgName0),
         ProfileProgName = string.strip(ProfileProgName0),
-        ( Version = yes ->
+        ( 
+            Version = yes
+        ->
             write_version_message(ProgName, !IO)
         ; 
-            ( Help = yes
-            ; ProfileProgName = "" )
+            Help = yes
         ->
             write_help_message(ProgName, !IO)
         ; 
-            ( Args = [Input, Output] ->
-                lookup_string_option(Options, measure, Measure),
-                ( construct_measure(Measure, MeasureType) ->
-                    lookup_int_option(Options, threshold, Threshold),
-                    lookup_bool_option(Options, verbose, Verbose),
-                    lookup_accumulating_option(Options, dump_stages,
-                        DumpStages),
-                    lookup_accumulating_option(Options, dump_options,
-                        DumpArrayOptionStrs),
-                    dump_array_options_to_dump_options(DumpArrayOptionStrs,
-                        DumpOptions),
-                    read_deep_file(Input, Verbose, DumpStages, DumpOptions,
-                        MaybeProfile, !IO),
-                    (
-                        MaybeProfile = ok(Deep),
-                        compute_css_list_above_threshold(0, Deep, Threshold, 
-                            MeasureType, [], CSSListAboveThreshold),
-                        generate_feedback_file(CSSListAboveThreshold, Deep,
-                            ProfileProgName, MeasureType, Threshold, Output,
-                            !IO)
-                    ;
-                        MaybeProfile = error(Error),
-                        io.stderr_stream(Stderr, !IO),
-                        io.set_exit_status(1, !IO),
-                        io.format(Stderr, "%s: error reading deep file: %s\n",
-                            [s(ProgName), s(Error)], !IO)
-                    )   
+            ProfileProgName \= "",
+            Args = [Input, Output],
+            check_options(Options, RequestedFeedbackInfo)
+        ->
+            lookup_bool_option(Options, verbose, Verbose),
+            read_deep_file(Input, Verbose, MaybeDeep, !IO),
+            (
+                MaybeDeep = ok(Deep),
+                feedback.read_or_create(Output, Feedback0, !IO),
+                process_deep_to_feedback(RequestedFeedbackInfo, 
+                    Deep, Feedback0, Feedback),
+                write_feedback_file(Output, ProfileProgName, Feedback,
+                    WriteResult, !IO),
+                (
+                    WriteResult = ok
                 ;
-                    io.set_exit_status(1, !IO),
-                    write_help_message(ProgName, !IO)
+                    ( WriteResult = open_error(Error)
+                    ; WriteResult = write_error(Error) ),
+                    io.error_message(Error, ErrorMessage),
+                    io.format("%s: %s\n", [s(Output), s(ErrorMessage)], !IO),
+                    io.set_exit_status(1, !IO)
                 )
             ;
+                MaybeDeep = error(Error),
+                io.stderr_stream(Stderr, !IO),
                 io.set_exit_status(1, !IO),
-                write_help_message(ProgName, !IO)
-            )
+                io.format(Stderr, "%s: error reading deep file: %s\n",
+                    [s(ProgName), s(Error)], !IO)
+            )   
+        ;
+            io.set_exit_status(1, !IO),
+            write_help_message(ProgName, !IO)
         )
     ;
         MaybeOptions = error(Msg),
         io.stderr_stream(Stderr, !IO),
         io.set_exit_status(1, !IO),
         io.format(Stderr, "%s: error parsing options: %s\n",
-            [s(ProgName), s(Msg)], !IO)
+            [s(ProgName), s(Msg)], !IO),
+        write_help_message(ProgName, !IO)
     ).
 
 :- pred write_help_message(string::in, io::di, io::uo) is det.
@@ -121,28 +123,32 @@ main(!IO) :-
 write_help_message(ProgName, !IO) :- 
     Message0 = [
         "Usage: %s --program-name <ProgName> [<options>] <input> <output>",
-        "    <input> must name a deep profiling data file.",
-        "    <output> is the file generated by this program.",
-        "    You may specify the following options:",
-        "    --help      Generate this help message.",
-        "    --version   Report the program's version number.",
-        "    --verbose   Generate progress messages.",
-        "    --threshold <value>",
-        "                Set the threshold to <value>.",
-        "    --measure mean|median",
-        "                mean : Write to <output> the call sites",
-        "                static whose call sites dynamic's mean",
-        "                call sequence counts exceed the given",
-        "                threshold (default option).",
-        "                median : Write to <output> the call sites",
-        "                static whose call sites dynamic's median",
-        "                call sequence counts exceed the given",
-        "                threshold.",
-        "    --program-name <name>",
-        "                The name of the program that generated the",
-        "                profiling data.  This is stored in the",
-        "                feedback file"],
-    string.join_list("\n", Message0) = Message,
+        "   <input> must name a deep profiling data file.",
+        "   <output> is the file generated by this program.",
+        "   You may specify the following options:",
+        "   --help      Generate this help message.",
+        "   --version   Report the program's version number.",
+        "   --verbose   Generate progress messages.",
+        "   --program-name <name>",
+        "               The name of the program that generated the",
+        "               profiling data.  This is stored in the",
+        "               feedback file",
+        "\nThe following options select sets of feedback information useful",
+        "for particular compiler optimizations",
+        "   --implicit-parallelism",
+        "\nThe following options select specific types of feedback",
+        "information and parameterise them",
+        "   --calls-above-threshold-sorted",
+        "               A list of calls whose typical cost (in call sequence",
+        "               counts is above a given threshold, the definition of",
+        "               'typical' may be specified.",
+        "   --calls-above-threshold-sorted-threshold <value>",
+        "               Set the threshold to <value>.",
+        "   --calls-above-threshold-sorted-measure mean|median",
+        "               mean : Use mean(call site dynamic cost), this is the",
+        "                      default.",
+        "               median : Use median(call site dynamic cost)."],
+    string.join_list("\n", Message0) ++ "\n" = Message,
     io.format(Message, [s(ProgName)], !IO).
 
 :- pred write_version_message(string::in, io::di, io::uo) is det.
@@ -155,15 +161,12 @@ write_version_message(ProgName, !IO) :-
     io.write_string(Version, !IO),
     io.nl(!IO).
 
-%-----------------------------------------------------------------------------%
-
     % Read a deep profiling data file.
     % 
 :- pred read_deep_file(string::in, bool::in,
-    list(string)::in, dump_options::in,
     maybe_error(deep)::out, io::di, io::uo) is det.
 
-read_deep_file(Input, Verbose, DumpStages, DumpOptions, MaybeProfile, !IO) :-
+read_deep_file(Input, Verbose, MaybeProfile, !IO) :-
     server_name_port(Machine, !IO),
     script_name(ScriptName, !IO),
     (
@@ -175,7 +178,177 @@ read_deep_file(Input, Verbose, DumpStage
         MaybeOutput = no
     ),
     read_and_startup(Machine, ScriptName, [Input], no, MaybeOutput,
-        DumpStages, DumpOptions, MaybeProfile, !IO).
+        [], MaybeProfile, !IO).
+
+%----------------------------------------------------------------------------%
+%
+% This section describes and processes command line options.  Individual
+% feedback information can be requested by the user, as well as options named
+% after optimizations that may imply one or more feedback inforemation types,
+% which that optimization uses.
+%
+
+    % Command line options.
+    %
+:- type option
+    --->    help
+    ;       program_name
+    ;       verbose
+    ;       version
+            
+            % The calls above threshold sorted feedback information
+    ;       calls_above_threshold_sorted
+    ;       calls_above_threshold_sorted_measure
+    ;       calls_above_threshold_sorted_threshold
+    
+            % Provide suitable feedback information for implicit parallelism
+    ;       implicit_parallelism.
+
+:- pred short(char::in, option::out) is semidet.
+
+short('h',  help).
+short('p',  program_name).
+short('V',  verbose).
+short('v',  version).
+
+:- pred long(string::in, option::out) is semidet.
+
+long("help",                help).
+long("verbose",             verbose).
+long("version",             version).
+long("program-name",        program_name).
+
+long("calls-above-threshold-sorted", calls_above_threshold_sorted).
+long("calls-above-threshold-sorted-measure",
+    calls_above_threshold_sorted_measure).
+long("calls-above-threshold-sorted-threshold",
+    calls_above_threshold_sorted_threshold).
+
+long("implicit-parallelism",    implicit_parallelism).
+
+:- pred defaults(option::out, option_data::out) is multi.
+
+defaults(help,              bool(no)).
+defaults(program_name,      string("")).
+defaults(verbose,           bool(no)).
+defaults(version,           bool(no)).
+
+defaults(calls_above_threshold_sorted,              bool(no)).
+defaults(calls_above_threshold_sorted_measure,      string("mean")).
+defaults(calls_above_threshold_sorted_threshold,    int(100000)).
+
+defaults(implicit_parallelism,  bool(no)).
+
+:- pred construct_measure(string::in, stat_measure::out) is semidet.
+
+construct_measure("mean",       stat_mean).
+construct_measure("median",     stat_median).
+
+    % This type defines the set of feedback_types that are to be calculated and
+    % put into the feedback info file,  They should correspond with the values
+    % of feedback_type.
+    %
+:- type requested_feedback_info 
+    --->    requested_feedback_info(
+                maybe_calls_above_threshold_sorted
+                    :: maybe(calls_above_threshold_sorted_opts) 
+            ).
+
+:- type calls_above_threshold_sorted_opts
+    --->    calls_above_threshold_sorted_opts(
+                measure         :: stat_measure,
+                threshold       :: int
+            ).
+
+
+    % Check all the command line options and return a well-typed representation
+    % of the user's request.  Some command line options imply other options,
+    % those implications are also handled here.
+    %
+:- pred check_options(option_table(option)::in, requested_feedback_info::out)
+    is semidet.
+
+check_options(Options0, RequestedFeedbackInfo) :-
+    % Handle options that imply other options here.
+    option_implies(implicit_parallelism, calls_above_threshold_sorted, yes,
+        Options0, Options), 
+
+    % For each feedback type determine if it is requested and fill in the the
+    % field in the RequestedFeedbackInfo structure.
+    lookup_bool_option(Options, calls_above_threshold_sorted,
+        CallsAboveThresholdSorted),
+    (
+        CallsAboveThresholdSorted = yes,
+        lookup_string_option(Options, calls_above_threshold_sorted_measure,
+            Measure),
+        % TODO: this goal is semidet, but this predicate should be det.
+        construct_measure(Measure, MeasureType),
+        CallsAboveThresholdSortedOpts ^ measure = MeasureType,
+        lookup_int_option(Options, calls_above_threshold_sorted_threshold,
+            Threshold),
+        CallsAboveThresholdSortedOpts ^ threshold = Threshold,
+        MaybeCallsAboveThresholdSortedOpts =
+            yes(CallsAboveThresholdSortedOpts)
+    ;
+        CallsAboveThresholdSorted = no,
+        MaybeCallsAboveThresholdSortedOpts = no
+    ),
+    RequestedFeedbackInfo ^ maybe_calls_above_threshold_sorted =
+        MaybeCallsAboveThresholdSortedOpts.
+
+    % Adjust command line options when one option implies other options.
+    %
+:- pred option_implies(option::in, option::in, bool::in,
+    option_table(option)::in, option_table(option)::out) is det.
+
+option_implies(Option, ImpliedOption, ImpliedValue, !Options) :-
+    (
+        lookup_bool_option(!.Options, Option, yes)
+    ->
+        svmap.set(ImpliedOption, bool(ImpliedValue), !Options)
+    ;
+        true
+    ).
+
+%----------------------------------------------------------------------------%
+
+    % process_deep_to_feedback(RequestedFeedbackInfo, Deep, !Feedback)
+    %
+    % Process a deep profiling structure and update the feedback information
+    % according to the RequestedFeedbackInfo parameter.
+    %
+:- pred process_deep_to_feedback(requested_feedback_info::in, deep::in,
+    feedback_info::in, feedback_info::out) is det.
+
+process_deep_to_feedback(RequestedFeedbackInfo, Deep, !Feedback) :-
+    MaybeCallsAboveThresholdSorted = 
+        RequestedFeedbackInfo ^ maybe_calls_above_threshold_sorted,
+    (
+        MaybeCallsAboveThresholdSorted = yes(Opts),
+        css_list_above_threshold(Opts, Deep, !Feedback)
+    ;
+        MaybeCallsAboveThresholdSorted = no
+    ).
+
+%----------------------------------------------------------------------------%
+%
+% Jerome's implicit parallelism feedback information.
+%
+
+    % Perform Jerome's analysis and update the feedback info structure.
+    %
+:- pred css_list_above_threshold(calls_above_threshold_sorted_opts::in,
+    deep::in, feedback_info::in, feedback_info::out) is det. 
+
+css_list_above_threshold(Options, Deep, !Feedback) :-
+    Options = calls_above_threshold_sorted_opts(MeasureType, Threshold),
+    compute_css_list_above_threshold(0, Deep, Threshold, 
+        MeasureType, [], CSSList),
+    map(css_to_call(Deep), CSSList, Calls), 
+    FeedbackData = feedback_data_calls_above_threshold_sorted(Threshold,
+        MeasureType, Calls),
+    FeedbackType = feedback_type_calls_above_threshold_sorted, 
+    put_feedback_data(FeedbackType, FeedbackData, !Feedback).
 
     % Determine those CSSs whose CSDs' average/median call sequence counts 
     % exceed the given threshold.
@@ -244,35 +417,6 @@ compare_csd_ptr(Deep, CSDPtrA, CSDPtrB, 
     sum_callseqs_csd_ptr(Deep, CSDPtrB, 0, SumB),
     compare(Result, SumA, SumB).
 
-    % Generate a profiling feedback file that contains the CSSs whose CSDs' 
-    % mean/median call sequence counts (own and desc) exceed the given 
-    % threshold. 
-    % 
-:- pred generate_feedback_file(list(call_site_static)::in, deep::in, string::in,
-    stat_measure::in, int::in, string::in, io::di, io::uo) is det.
-
-generate_feedback_file(CSSList, Deep, ProgName, StatMeasure, Threshold, Output,
-    !IO) :-
-    some [!Feedback]
-    (
-        feedback.read_or_create(Output, !:Feedback, !IO),
-        map(css_to_call(Deep), CSSList, Calls), 
-        FeedbackData = feedback_data_calls_above_threshold_sorted(Threshold,
-            StatMeasure, Calls),
-        FeedbackType = feedback_type_calls_above_threshold_sorted, 
-        put_feedback_data(FeedbackType, FeedbackData, !Feedback),
-        write_feedback_file(Output, ProgName, !.Feedback, WriteResult, !IO)
-    ),
-    (
-        WriteResult = ok
-    ;
-        ( WriteResult = open_error(Error)
-        ; WriteResult = write_error(Error) ),
-        io.error_message(Error, ErrorMessage),
-        io.format("%s: %s\n", [s(Output), s(ErrorMessage)], !IO),
-        io.set_exit_status(1, !IO)
-    ).
-
     % Write to the output the list of CSSs.     
     % 
 :- pred css_to_call(deep::in, call_site_static::in, call_site::out) is det.
@@ -308,57 +452,5 @@ css_to_call(Deep, CSS, Call) :-
     Call = call_site(Caller, Slot, CallTypeAndCallee).
 
 %-----------------------------------------------------------------------------%
-
-:- type option
-    --->    threshold
-    ;       help
-    ;       verbose
-    ;       version
-    ;       measure
-    ;       program_name
-    ;       dump_stages
-    ;       dump_options.
-
-:- type option_table == option_table(option).
-
-:- pred short(char::in, option::out) is semidet.
-
-short('V',  verbose).
-short('t',  threshold).
-short('h',  help).
-short('v',  version).
-short('m',  measure).
-short('p',  program_name).
-short('d',  dump_stages).
-short('D',  dump_options).
-
-:- pred long(string::in, option::out) is semidet.
-
-long("threshold",           threshold).
-long("help",                help).
-long("verbose",             verbose).
-long("version",             version).
-long("measure",             measure).
-long("program-name",        program_name).
-long("dump-stages",         dump_stages).
-long("dump-options",        dump_options).
-
-:- pred defaults(option::out, option_data::out) is multi.
-
-defaults(threshold,         int(100000)).
-defaults(help,              bool(no)).
-defaults(verbose,           bool(no)).
-defaults(version,           bool(no)).
-defaults(measure,           string("mean")).
-defaults(program_name,      string("")).
-defaults(dump_stages,       accumulating([])).
-defaults(dump_options,      accumulating([])).
-
-:- pred construct_measure(string::in, stat_measure::out) is semidet.
-
-construct_measure("mean",       stat_mean).
-construct_measure("median",     stat_median).
-
-%-----------------------------------------------------------------------------%
 :- end_module mdprof_feedback.
 %-----------------------------------------------------------------------------%


-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
URL: <http://lists.mercurylang.org/archives/reviews/attachments/20080729/3d280e6d/attachment.sig>


More information about the reviews mailing list