[m-rev.] For review: Compiler feedback system.

Paul Bone pbone at csse.unimelb.edu.au
Wed Jul 23 11:43:30 AEST 2008


I've placed comments inline and an updated changelog and diff at the end
of the e-mail.

Thanks.


On Mon, Jul 21, 2008 at 01:57:43PM +1000, Julien Fischer wrote:
> 
> On Sun, 20 Jul 2008, Paul Bone wrote:
> 
> >Estimated hours taken: 8
> >Branches: main
> >
> >Introduce a feedback system and modify Jerome's implicit parallelism work 
> >to
> >use it.  Generic information can now be fed back into the compiler to aid 
> >with
> >optimizations.
> 
> Include a little more detail about the feedback system in the log
> message.
> 
> Separate out the first change from the second in the above, e.g.
> 
> 
> 	Introduce a feedback system ...
> 
> 	Modify the implicity parallelism ...
> 

Done,  Now reads:

Introduce a feedback system that allows analysis tools to feed information
back into the compiler.  This can be used with the deep profiler to improve
many optimizations.  Tools update information in the feedback file rather than
clobbering existing un-related information.

Modify the implicit parallelism work to make use of the new feedback system.
mdprof_feedback updates a feedback file and in the future will be able to
collect more information from the deep profiler.


> >@@ -458,6 +477,53 @@ postprocess_options_2(OptionTable0, Targ
> >        globals.lookup_bool_option(!.Globals,
> >            automatic_intermodule_optimization, AutoIntermodOptimization),
> >
> >+        % Implicit parallelism requires feedback information.
> >+        globals.lookup_bool_option(!.Globals, implicit_parallelism,
> >+            ImplicitParallelism),
> >+        (
> >+            ImplicitParallelism = yes,
> >+            globals.lookup_string_option(!.Globals, feedback_file,
> >+                FeedbackFile),
> >+            (
> >+                FeedbackFile = ""
> >+            ->
> >+                add_error("'--implicit-parallelism' requires 
> >'--feedback'",
> >+                    !Errors)
> >+            ;
> >+                true
> >+            ),
> >+            % TODO: should 'implicit_parallism' imply 'parallel'?
> 
> No, --parallel is a component of the chosen grade.  If I only enable
> --implicit-parallelism for individual modules (e.g. by listing them
> separately in a Mercury.options file) then those modules might be
> compiled in a different grade.
> 

In that case should this produce an error when --implicit-parallelism is
used in a non-parallel grade?

In this predicate I've found it hard to work out where things should be
put that makes some kind of sense, I've put this change near the top but
is there a better way to maintain the code in this predicate?

> >+            globals.lookup_bool_option(!.Globals, parallel, Parallel),
> >+            (
> >+                Parallel = yes
> >+            ;
> >+                Parallel = no,
> >+                add_error("'--implicit_parallelism' requires 
> >'--parallel'",
> >+                    !Errors)
> >+            ),
> >+            globals.lookup_bool_option(!.Globals, highlevel_code, 
> >HighLevelCode),
> >+            (
> >+                HighLevelCode = yes,
> >+                add_error("'--implicit-parallelism' is not compatible 
> >with "
> >+                    ++ "'--highlevel-code'", !Errors)
> >+            ;
> >+                HighLevelCode = no
> >+            ),
> >+            (
> >+                Target = target_c
> >+            ;
> >+                ( Target = target_il
> >+                ; Target = target_java
> >+                ; Target = target_asm
> >+                ; Target = target_x86_64
> >+                ; Target = target_erlang ),
> >+                add_error("'--implicit-parallelism' is not compatible 
> >with "
> >+                    ++ "target " ++ string(Target), !Errors)
> >+            )
> >+        ;
> >+            ImplicitParallelism = no
> >+        ),
> >+
> >        % Generating IL implies:
> >        %   - gc_method `automatic' and no heap reclamation on failure
> >        %     Because GC is handled automatically by the .NET CLR



> >@@ -301,12 +315,14 @@ write_css_list([ CSS | CSSList0 ], Deep,
> >    ;       verbose
> >    ;       version
> >    ;       measure
> >+    ;       program_name
> >    ;       dump_stages
> >    ;       dump_options.
> >
> >-:- type measure_type
> >-    --->    average
> >-    ;       median.
> >+% XXX: Moved to program_representation.
> >+%:- type measure_type
> >+%    --->    average
> >+%    ;       median.
> 
> 
> In which case you should delete it here rather than leaving the
> commented out copy lying about.
> 

Sorry.  human error.  I forgot to delete this.


> >Index: mdbcomp/feedback.m
> >===================================================================
> >RCS file: mdbcomp/feedback.m
> >diff -N mdbcomp/feedback.m
> >--- /dev/null	1 Jan 1970 00:00:00 -0000
> >+++ mdbcomp/feedback.m	20 Jul 2008 04:40:56 -0000
> >@@ -0,0 +1,416 @@
> >+%-----------------------------------------------------------------------------%
> >+% vim: ft=mercury ts=4 sw=4 et
> >+%-----------------------------------------------------------------------------%
> >+% Copyright (C) 2008 The University of Melbourne.
> >+% This file may only be copied under the terms of the GNU General
> >+% Public License - see the file COPYING in the Mercury distribution.
> >+%-----------------------------------------------------------------------------%
> >+%
> >+% File: feedback.m.
> >+% Main author: pbone.
> >+%
> >+% This module defines routines implementing a compiler feedback system.  
> >It
> >+% should be complied into the compiler and any tools that write feedback 
> >data
> >+% for use by the compiler.
> 
> I suggest:
> 
> 	This module defines data structures for representing feedback
> 	information as well as procedures for reading and writing
> 	feedback files.  It is included in the compiler and in any tools that
> 	generate feedback data.
> 

Thanks.  I've used your words here.

> >+%-----------------------------------------------------------------------------%
> >+%-----------------------------------------------------------------------------%
> >+
> >+:- module mdbcomp.feedback.
> >+
> >+:- interface.
> >+
> >+:- import_module mdbcomp.program_representation.
> >+
> >+:- import_module int.
> >+:- import_module io.
> >+:- import_module list.
> >+:- import_module maybe.
> >+:- import_module string.
> >+
> >+%-----------------------------------------------------------------------------%
> >+
> >+    % Feedback information is stored in this datatype when in memory.
> >+    %
> >+:- type feedback_state.
> 
> I would rename this type to feedback_info.  And the feedback_info type
> below to feedback_data.
> 

Done.

> >+%-----------------------------------------------------------------------------%
> >+
> >+    % This type is used as a key for the data that may be fed back into 
> >the
> >+    % complier.  When making changes to this structure be sure to 
> >increment the
> >+    % file format version number towards the bottom of this file.
> >+    %
> >+:- type feedback_info_type
> >+    --->    feedback_info_calls_above_threshold_sorted.
> 
> You should document the meaning of this constructor -- it will matter
> later when more are added.  (With my suggested renamings I would make
> this just feedback_type.)
> 

Done.

> >+%-----------------------------------------------------------------------------%
> >+
> >+    % This type stores the data that may be fed back into the compiler.  
> >Each
> >+    % constructor here corrisponds to a value of the above type.  When 
> >making
> 
> s/corrisponds/corresponds/
> 

Thanks.

> >+    % changes to this structure or structures in 
> >mdbcomp.program_representation
> >+    % be sure to increment the file format version number towards the 
> >bottom of
> >+    % this file.
> >+    %
> >+    % TODO: Somehow need to constrain the instantiations of this type so 
> >that
> >+    % they are always paired with instantitations of the above type, and
> >+    % hopefuly the complier can assert this.
> >+    %
> >+:- type feedback_info
> >+    --->    feedback_info_calls_above_threshold_sorted(
> >+                threshold       :: int,
> >+                stat_measure    :: stat_measure,
> >+                calls           :: list(call)
> >+            ).
> >+
> >+:- type stat_measure
> >+    --->    stat_average
> >+    ;       stat_median.
> 
> I know you didn't name this but average is not a good name - it's not
> precisely defined in the sense that the median is.  By average here we
> mean `arithemtic mean', do we not?
>

It's called stat_mean now.


> >+%-----------------------------------------------------------------------------%
> >+
> >+    % put(InfoType, Info, !State)
> >+    %
> >+    % 'Put' feedback data into the feedback files.  Data is stored based 
> >on
> >+    % the type of information being stored.
> >+    %
> >+    % Data loaded from file (not added with put) will be removed from the
> >+    % internal state when data for the same info type is added.
> >+    %
> >+:- pred put(feedback_info_type::in, feedback_info::in,
> >+    feedback_state::in, feedback_state::out) is det.
> >+
> 
> I would name these operations something other than put or get (which are
> already used in the stdlib's queue and stream modules.), e.g.
> {get, put}_feedback_info.
> 

I've called them *_feedback_data.  Since we renamed the feedback_info
type to feedback_data.  I think this name makes the most sense.


> >+%-----------------------------------------------------------------------------%
> >+
> >+    % get(InfoType, MaybeInfo, State).
> >+    %
> >+    % To query the feedback files 'get' will give a value for a given 
> >info type
> >+    % if it exists.
> >+    %
> >+:- pred get(feedback_info_type::in, maybe(feedback_info)::out,
> >+    feedback_state::in) is det.
> >+
> >+%-----------------------------------------------------------------------------%
> >+
> >+    % read(Path, FeedbackState, !IO)
> >+    %
> >+    % This predicate reads in feedback data from a specified file.  It 
> >should
> >+    % be called once per compiler invokation, after this the feedback 
> >data is
> 
> s/invokation/invocation/
>

Thanks.

> >+    % kept in the generated feedback_state variable.
> 
> What does that last bit mean?
> 

I've removed it, it's talking about stuff that should happen in other
modules.

> >+:- pred read(string::in, feedback_read_result(feedback_state)::out,
> >+    io::di, io::uo) is det.
> >+
> >+:- type feedback_read_result(T)
> >+    --->    ok(T)
> >+    ;       error(feedback_read_error).
> >+
> >+:- type feedback_read_error
> >+    --->    open_error(io.error)
> >+    ;       read_error(io.error)
> >+    ;       parse_error(
> >+                message     :: string,
> >+                line_no     :: int)
> >+    ;       unexpected_eof
> >+    ;       incorrect_version
> >+    ;       incorrect_first_line
> >+    ;       incorrect_program_name.
> >+
> >+%-----------------------------------------------------------------------------%
> >+
> >+    % read_error_message_string(File, Error, Message)
> >+    %
> >+    % Create a string describing the read error.
> >+    %
> >+:- pred read_error_message_string(string::in, feedback_read_error::in,
> >+    string::out) is det.
> >+
> >+%-----------------------------------------------------------------------------%
> >+
> >+    % Try to read in a feedback file, if the file doesn't exist create a 
> >new
> >+    % empty feedback state in memory.
> >+    %
> >+:- pred read_or_create(string::in, feedback_state::out, io::di, io::uo) 
> >is det.
> >+
> >+%-----------------------------------------------------------------------------%
> >+
> >+    % init = FeedbackState
> >+    %
> >+    % Create a new empty feedback state.
> >+    %
> >+:- func init = feedback_state.
> 
> Likewise init is not a good name since many functions in the stdlib
> already use this name.

It's now init_feedback_info

> >+
> >+read(Path, ReadResultFeedbackState, !IO) :-
> 
> I suggest naming this read_feedback_file (and renaming write below to 
> write_feedback_file).
>

Done.

> >+
> >+:- func feedback_first_line = string.
> >+
> >+feedback_first_line = "Mercury Complier Feedback".
> 
> s/Complier/Compiler/
>

Thanks

> >Index: mdbcomp/program_representation.m
> >===================================================================
> >RCS file: 
> >/home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
> >retrieving revision 1.30
> >diff -u -p -r1.30 program_representation.m
> >--- mdbcomp/program_representation.m	19 Mar 2008 05:30:00 -0000	1.30
> >+++ mdbcomp/program_representation.m	20 Jul 2008 04:40:56 -0000
> >@@ -285,6 +285,30 @@
> >
> >%-----------------------------------------------------------------------------%
> >
> >+% These types are used to describe parts of a program.  They are used by
> 
> "parts of a program" is a bit vague - they are used to describe call
> sites are they not?
> 

I'm trying to talk about all types in the following section, which is
just two types.  Since there are ownly two types I've removed this
comment.

> >+% mdbcomp.feedback
> >+
> >+
> >+    % Describe a call.
> >+    %
> >+:- type call
> >+    --->    call(
> >+                caller                  :: string_proc_label,
> >+                slot                    :: int,
> >+                call_type_and_callee    :: call_type_and_callee
> >+            ).
> 
> call/N is a Mercury builtin - I suggest calling this type and the
> data constructor something else.
>

call_site

> >+
> >+    % The type of call.
> >+    %
> >+:- type call_type_and_callee
> >+    --->    callback_call
> >+    ;       higher_order_call
> >+    ;       method_call
> >+    ;       plain_call(string_proc_label)
> >+    ;       special_call.
> 
> What is the "_and_callee" bit referring to?
> 

Although Zoltan pointed this out I've changed the comment to describe
this more clearly.



Estimated hours taken: 8
Branches: main

Introduce a feedback system that allows analysis tools to feed information
back into the compiler.  This can be used with the deep profiler to improve
many optimizations.  Tools update information in the feedback file rather than
clobbering existing un-related information.

Modify the implicit parallelism work to make use of the new feedback system.
mdprof_feedback updates a feedback file and in the future will be able to
collect more information from the deep profiler.

mdbcomp/feedback.m:
	Created a new module for the feedback system, types representing feedback
	information and predicates for reading and writing feedback files, and
	manipulating feedback information are defined here.

mdbcomp/mdbcomp.m:
	Updated to include the mdbcomp/feedback.m in this library.

mdbcomp/program_representation.m:
	Created a new type to describe a call.  This is used by the current
	implicit parallelism implementation.

deep_profiler/mdprof_feedback.m:
	Updated to use the new feedback system.  The old feedback file code has
	been removed.
	--program-name option has been added, a program name must be provided to
	be included in the header of the feedback file.
	Conform to changes in mdbcomp/program_representation.m

compiler/globals.m:
	Added feedback data to globals structure.
	Added predicates to get and set the feedback information stored in the
	globals structure.
	Modified predicates that create the globals structure.

compiler/handle_options.m:
	Set feedback information in globals structure when it is created in
	postprocess_options.
	Read feedback information in from file in check_option_values.
	Code added to postprocess_options2 to check the usage of the
	--implicit-parallelism option.

compiler/implicit_parallelism.m:
	This module no-longer reads the feedback file it's self, this code has
	been removed, as has the IO state.
	Information from the feedback state is retrieved and used to control
	implicit parallelism.

compiler/mercury_compile.m:
	No-longer checks options for implicit parallelization, this is now done in
	compiler/handle_options.m.
	Conform to changes in implicit_parallelism.m

deep_profiler/Mmakefile:
slice/Mmakefile:
	Modified to include mdbcomp/feedback.m for compilation in this directory.


Index: compiler/globals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.89
diff -u -p -r1.89 globals.m
--- compiler/globals.m	2 Jun 2008 02:27:26 -0000	1.89
+++ compiler/globals.m	23 Jul 2008 01:33:38 -0000
@@ -24,6 +24,7 @@
 :- import_module libs.trace_params.
 :- import_module mdbcomp.
 :- import_module mdbcomp.prim_data. % for module_name
+:- import_module mdbcomp.feedback.
 
 :- import_module bool.
 :- import_module getopt_io.
@@ -152,7 +153,8 @@
 :- pred globals_init(option_table::in, compilation_target::in, gc_method::in,
     tags_method::in, termination_norm::in, termination_norm::in,
     trace_level::in, trace_suppress_items::in,
-    may_be_thread_safe::in, c_compiler_type::in, globals::out) is det.
+    may_be_thread_safe::in, c_compiler_type::in, feedback_info::in, 
+    globals::out) is det.
 
 :- pred get_options(globals::in, option_table::out) is det.
 :- pred get_target(globals::in, compilation_target::out) is det.
@@ -167,6 +169,7 @@
 :- pred get_source_file_map(globals::in, maybe(source_file_map)::out) is det.
 :- pred get_maybe_thread_safe(globals::in, may_be_thread_safe::out) is det.
 :- pred get_c_compiler_type(globals::in, c_compiler_type::out) is det.
+:- pred get_feedback_info(globals::in, feedback_info::out) is det.
 
 :- pred set_option(option::in, option_data::in, globals::in, globals::out)
     is det.
@@ -177,6 +180,8 @@
 :- pred set_trace_level_none(globals::in, globals::out) is det.
 :- pred set_source_file_map(maybe(source_file_map)::in,
     globals::in, globals::out) is det.
+:- pred set_feedback_info(feedback_info::in, globals::in, globals::out) 
+    is det.
 
 :- pred lookup_option(globals::in, option::in, option_data::out) is det.
 
@@ -224,7 +229,8 @@
 :- pred globals_io_init(option_table::in, compilation_target::in,
     gc_method::in, tags_method::in, termination_norm::in,
     termination_norm::in, trace_level::in, trace_suppress_items::in,
-    may_be_thread_safe::in, c_compiler_type::in, io::di, io::uo) is det.
+    may_be_thread_safe::in, c_compiler_type::in, feedback_info::in, 
+    io::di, io::uo) is det.
 
 :- pred io_get_target(compilation_target::out, io::di, io::uo) is det.
 :- pred io_get_backend_foreign_languages(list(foreign_language)::out,
@@ -393,7 +399,8 @@ gc_is_conservative(gc_automatic) = no.
                 source_file_map         :: maybe(source_file_map),
                 have_printed_usage      :: bool,
                 may_be_thread_safe      :: bool,
-                c_compiler_type         :: c_compiler_type
+                c_compiler_type         :: c_compiler_type,
+                feedback                :: feedback_info
             ).
 
 :- mutable(globals, univ, univ(0), ground,
@@ -420,10 +427,10 @@ gc_is_conservative(gc_automatic) = no.
 
 globals_init(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
-        MaybeThreadSafe, C_CompilerType, Globals) :-
+        MaybeThreadSafe, C_CompilerType, Feedback, Globals) :-
     Globals = globals(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
-        no, no, MaybeThreadSafe, C_CompilerType).
+        no, no, MaybeThreadSafe, C_CompilerType, Feedback).
 
 get_options(Globals, Globals ^ options).
 get_target(Globals, Globals ^ target).
@@ -436,6 +443,7 @@ get_trace_suppress(Globals, Globals ^ tr
 get_source_file_map(Globals, Globals ^ source_file_map).
 get_maybe_thread_safe(Globals, Globals ^ may_be_thread_safe).
 get_c_compiler_type(Globals, Globals ^ c_compiler_type).
+get_feedback_info(Globals, Globals ^ feedback).
 
 get_backend_foreign_languages(Globals, ForeignLangs) :-
     lookup_accumulating_option(Globals, backend_foreign_languages, LangStrs),
@@ -466,6 +474,9 @@ set_trace_level_none(Globals,
 set_source_file_map(SourceFileMap, Globals,
     Globals ^ source_file_map := SourceFileMap).
 
+set_feedback_info(Feedback, Globals,
+    Globals ^ feedback := Feedback).
+
 lookup_option(Globals, Option, OptionData) :-
     get_options(Globals, OptionTable),
     map.lookup(OptionTable, Option, OptionData).
@@ -601,10 +612,10 @@ want_return_var_layouts(Globals, WantRet
 
 globals_io_init(Options, Target, GC_Method, TagsMethod, TerminationNorm,
         Termination2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, !IO) :-
+        C_CompilerType, Feedback, !IO) :-
     globals_init(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel,
-        TraceSuppress, MaybeThreadSafe, C_CompilerType, Globals),
+        TraceSuppress, MaybeThreadSafe, C_CompilerType, Feedback, Globals),
     io_set_globals(Globals, !IO),
     getopt_io.lookup_bool_option(Options, solver_type_auto_init,
         AutoInitSupported),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.320
diff -u -p -r1.320 handle_options.m
--- compiler/handle_options.m	2 Jun 2008 02:27:26 -0000	1.320
+++ compiler/handle_options.m	23 Jul 2008 01:33:38 -0000
@@ -81,6 +81,8 @@
 :- import_module analysis.
 :- import_module libs.compiler_util.
 :- import_module libs.trace_params.
+:- import_module mdbcomp.
+:- import_module mdbcomp.feedback.
 :- import_module parse_tree.
 :- import_module parse_tree.error_util.
 
@@ -187,12 +189,12 @@ postprocess_options(error(ErrorMessage),
 postprocess_options(ok(OptionTable0), Errors, !IO) :-
     check_option_values(OptionTable0, OptionTable, Target, GC_Method,
         TagsMethod, TermNorm, Term2Norm, TraceLevel, TraceSuppress,
-        MaybeThreadSafe, C_CompilerType, [], CheckErrors),
+        MaybeThreadSafe, C_CompilerType, FeedbackInfo, [], CheckErrors, !IO),
     (
         CheckErrors = [],
         postprocess_options_2(OptionTable, Target, GC_Method,
             TagsMethod, TermNorm, Term2Norm, TraceLevel,
-            TraceSuppress, MaybeThreadSafe, C_CompilerType,
+            TraceSuppress, MaybeThreadSafe, C_CompilerType, FeedbackInfo,
             [], Errors, !IO)
     ;
         CheckErrors = [_ | _],
@@ -203,12 +205,12 @@ postprocess_options(ok(OptionTable0), Er
     compilation_target::out, gc_method::out, tags_method::out,
     termination_norm::out, termination_norm::out, trace_level::out,
     trace_suppress_items::out, may_be_thread_safe::out,
-    c_compiler_type::out,
-    list(string)::in, list(string)::out) is det.
+    c_compiler_type::out, feedback_info::out,
+    list(string)::in, list(string)::out, io::di, io::uo) is det.
 
 check_option_values(!OptionTable, Target, GC_Method, TagsMethod,
         TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, !Errors) :-
+        C_CompilerType, FeedbackInfo, !Errors, !IO) :-
     map.lookup(!.OptionTable, target, Target0),
     (
         Target0 = string(TargetStr),
@@ -354,6 +356,24 @@ check_option_values(!OptionTable, Target
         add_error("Invalid argument to option " ++
             "`--c-compiler-type'\n\t(must be" ++
             "`gcc', `lcc', `cl, or `unknown').", !Errors)
+    ),
+    map.lookup(!.OptionTable, feedback_file, FeedbackFile0),
+    (
+        FeedbackFile0 = string(FeedbackFile),
+        FeedbackFile \= ""
+    ->
+        read_feedback_file(FeedbackFile, FeedbackReadResult, !IO),
+        (
+            FeedbackReadResult = ok(FeedbackInfo)
+        ;
+            FeedbackReadResult = error(Error),
+            read_error_message_string(FeedbackFile, Error, ErrorMessage),
+            add_error(ErrorMessage, !Errors),
+            FeedbackInfo = init_feedback_info
+        )
+    ;
+        % No feedback info.
+        FeedbackInfo = init_feedback_info
     ). 
         
 :- pred add_error(string::in, list(string)::in, list(string)::out) is det.
@@ -368,15 +388,15 @@ add_error(Error, Errors0, Errors) :-
 :- pred postprocess_options_2(option_table::in, compilation_target::in,
     gc_method::in, tags_method::in, termination_norm::in,
     termination_norm::in, trace_level::in, trace_suppress_items::in,
-    may_be_thread_safe::in, c_compiler_type::in,
+    may_be_thread_safe::in, c_compiler_type::in, feedback_info::in,
     list(string)::in, list(string)::out, io::di, io::uo) is det.
 
 postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
         TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, !Errors, !IO) :-
+        C_CompilerType, FeedbackInfo, !Errors, !IO) :-
     globals_io_init(OptionTable0, Target, GC_Method, TagsMethod0,
         TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, !IO),
+        C_CompilerType, FeedbackInfo, !IO),
 
     some [!Globals] (
         globals.io_get_globals(!:Globals, !IO),
@@ -458,6 +478,52 @@ postprocess_options_2(OptionTable0, Targ
         globals.lookup_bool_option(!.Globals,
             automatic_intermodule_optimization, AutoIntermodOptimization),
 
+        % Implicit parallelism requires feedback information.
+        globals.lookup_bool_option(!.Globals, implicit_parallelism,
+            ImplicitParallelism),
+        (
+            ImplicitParallelism = yes,
+            globals.lookup_string_option(!.Globals, feedback_file,
+                FeedbackFile),
+            (
+                FeedbackFile = ""
+            -> 
+                add_error("'--implicit-parallelism' requires '--feedback'", 
+                    !Errors)
+            ;
+                true 
+            ),
+            globals.lookup_bool_option(!.Globals, parallel, Parallel),
+            (
+                Parallel = yes
+            ;
+                Parallel = no,
+                add_error("'--implicit_parallelism' requires '--parallel'",
+                    !Errors)
+            ),
+            globals.lookup_bool_option(!.Globals, highlevel_code, HighLevelCode),
+            (
+                HighLevelCode = yes,
+                add_error("'--implicit-parallelism' is not compatible with "
+                    ++ "'--highlevel-code'", !Errors)
+            ;
+                HighLevelCode = no
+            ),
+            (
+                Target = target_c
+            ;
+                ( Target = target_il
+                ; Target = target_java
+                ; Target = target_asm
+                ; Target = target_x86_64
+                ; Target = target_erlang ),
+                add_error("'--implicit-parallelism' is not compatible with "
+                    ++ "target " ++ string(Target), !Errors)
+            )
+        ;
+            ImplicitParallelism = no
+        ),
+
         % Generating IL implies:
         %   - gc_method `automatic' and no heap reclamation on failure
         %     Because GC is handled automatically by the .NET CLR
Index: compiler/implicit_parallelism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implicit_parallelism.m,v
retrieving revision 1.7
diff -u -p -r1.7 implicit_parallelism.m
--- compiler/implicit_parallelism.m	27 Feb 2008 07:23:07 -0000	1.7
+++ compiler/implicit_parallelism.m	23 Jul 2008 01:33:38 -0000
@@ -7,7 +7,7 @@
 %-----------------------------------------------------------------------------%
 %
 % File : implicit_parallelism.m.
-% Author: tannier.
+% Author: tannier, pbone.
 %
 % This module uses deep profiling feedback information generated by
 % mdprof_feedback to introduce parallel conjunctions where it could be
@@ -30,7 +30,7 @@
 
 :- import_module hlds.hlds_module.
 
-:- import_module io.
+:- import_module maybe.
 
 %-----------------------------------------------------------------------------%
 
@@ -40,7 +40,7 @@
     % feedback file.
     %
 :- pred apply_implicit_parallelism_transformation(
-    module_info::in, module_info::out, string::in, io::di, io::uo) is det.
+    module_info::in, maybe(module_info)::out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -48,14 +48,17 @@
 :- implementation.
 
 :- import_module check_hlds.inst_match.
-:- import_module hlds.hlds_goal.
 :- import_module check_hlds.mode_util.
 :- import_module hlds.goal_util.
+:- import_module hlds.hlds_goal.
 :- import_module hlds.hlds_pred.
 :- import_module hlds.instmap.
 :- import_module hlds.quantification.
 :- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module mdbcomp.feedback.
 :- import_module mdbcomp.prim_data.
+:- import_module mdbcomp.program_representation.
 :- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 :- import_module transform_hlds.dep_par_conj.
@@ -65,7 +68,6 @@
 :- import_module counter.
 :- import_module int.
 :- import_module list.
-:- import_module maybe.
 :- import_module pair.
 :- import_module require.
 :- import_module set.
@@ -105,18 +107,71 @@ construct_call_site_kind("callback",    
 
 %-----------------------------------------------------------------------------%
 
-apply_implicit_parallelism_transformation(!ModuleInfo, FeedbackFile, !IO) :-
-    parse_feedback_file(FeedbackFile, MaybeCandidateCallSites, !IO),
+apply_implicit_parallelism_transformation(ModuleInfo0, MaybeModuleInfo) :-
+    module_info_get_globals(ModuleInfo0, Globals),
+    globals.get_feedback_info(Globals, FeedbackInfo),
+    get_feedback_data(feedback_type_calls_above_threshold_sorted,
+        MaybeFeedbackData, FeedbackInfo),
     (
-        MaybeCandidateCallSites = error(Error),
-        io.stderr_stream(Stderr, !IO),
-        io.write_string(Stderr, Error ++ "\n", !IO)
-    ;
-        MaybeCandidateCallSites = ok(CandidateCallSites),
-        module_info_predids(PredIds, !ModuleInfo),
-        process_preds_for_implicit_parallelism(PredIds, CandidateCallSites,
-            !ModuleInfo)
-    ).
+        MaybeFeedbackData = yes(FeedbackData),
+        some [!ModuleInfo]
+        (
+            !:ModuleInfo = ModuleInfo0,
+            module_info_predids(PredIds, !ModuleInfo),
+            FeedbackData = 
+                feedback_data_calls_above_threshold_sorted(_, _, Calls),
+            list.map(call_site_convert, Calls, CandidateCallSites),
+            process_preds_for_implicit_parallelism(PredIds, CandidateCallSites,
+                !ModuleInfo),
+            MaybeModuleInfo = yes(!.ModuleInfo)
+        )
+    ;
+        MaybeFeedbackData = no,
+        MaybeModuleInfo = no
+    ).
+
+    % This predicate isn't really necessary as this entire module should use
+    % the call_site structure defined in mdbcomp.program_representation.
+    % However it's expected that the rest of this module will be replaced in
+    % the near future.
+    %
+:- pred call_site_convert(call_site::in, candidate_call_site::out) is det.
+
+call_site_convert(Call, CallSite) :-
+    Call = call_site(Caller0, Slot, CallTypeAndCallee),
+    string_proc_label_to_string(Caller0, Caller),
+    (
+        CallTypeAndCallee = plain_call(Callee0),
+        string_proc_label_to_string(Callee0, Callee),
+        CallSiteKind = csk_normal 
+    ;
+        ( 
+            CallTypeAndCallee = callback_call,
+            CallSiteKind = csk_callback
+        ;
+            CallTypeAndCallee = higher_order_call,
+            CallSiteKind = csk_higher_order
+        ; 
+            CallTypeAndCallee = method_call,
+            CallSiteKind = csk_method
+        ; 
+            CallTypeAndCallee = special_call,
+            CallSiteKind = csk_special
+        ),
+        Callee = ""
+    ),
+    CallSite = candidate_call_site(Caller, Slot, CallSiteKind, Callee).
+
+:- pred string_proc_label_to_string(string_proc_label::in, string::out) is det.
+
+string_proc_label_to_string(ProcLabel, String) :-
+    (
+        ProcLabel = str_ordinary_proc_label(_, Module, _, Name, Arity, Mode)
+    ;
+        ProcLabel = str_special_proc_label(_, _, Module, Name, Arity, Mode)
+    ),
+    string.format("%s.%s/%d-%d", [s(Module), s(Name), i(Arity), i(Mode)],
+        String).
 
     % Process predicates for implicit parallelism.
     %
@@ -846,107 +901,6 @@ process_switch_cases_for_implicit_parall
 
 %-----------------------------------------------------------------------------%
 
-    % Parse the feedback file (header and body).
-    %
-:- pred parse_feedback_file(string::in,
-    maybe_error(list(candidate_call_site))::out, io::di, io::uo) is det.
-
-parse_feedback_file(InputFile, MaybeCandidateCallSites, !IO) :-
-    io.open_input(InputFile, Result, !IO),
-    (
-        Result = io.error(ErrInput),
-        MaybeCandidateCallSites = error(io.error_message(ErrInput))
-    ;
-        Result = ok(Stream),
-        io.read_file_as_string(Stream, MaybeFileAsString, !IO),
-        (
-            MaybeFileAsString = ok(FileAsString),
-            Lines = string.words_separator(is_carriage_return, FileAsString),
-            process_feedback_file_header(Lines, MaybeBodyLines, !IO),
-            (
-                MaybeBodyLines = error(HeaderError),
-                MaybeCandidateCallSites = error(HeaderError)
-            ;
-                MaybeBodyLines = ok(BodyLines),
-                process_feedback_file_body(BodyLines, MaybeCandidateCallSites)
-            )
-        ;
-            MaybeFileAsString = error(_, ReadError),
-            MaybeCandidateCallSites = error(io.error_message(ReadError))
-        ),
-        io.close_input(Stream, !IO)
-    ).
-
-:- pred is_carriage_return(char::in) is semidet.
-
-is_carriage_return(Char) :-
-    Char = '\n'.
-
-    % Process the header of the feedback file.
-    %
-:- pred process_feedback_file_header(list(string)::in,
-    maybe_error(list(string))::out, io::di, io::uo) is det.
-
-process_feedback_file_header(Lines, MaybeBodyLines, !IO) :-
-    (
-        Lines = [IdLine, VersionLine, _MeasureLine, _ThresholdLine
-            | BodyLines],
-        IdLine = "Profiling feedback file"
-    ->
-        ( VersionLine = "Version = 1.0" ->
-            MaybeBodyLines = ok(BodyLines)
-        ;
-            MaybeBodyLines = error("Profiling feedback file version incorrect")
-        )
-    ;
-        MaybeBodyLines = error("Not a profiling feedback file")
-    ).
-
-    % Process the body of the feedback file.
-    %
-:- pred process_feedback_file_body(list(string)::in,
-    maybe_error(list(candidate_call_site))::out) is det.
-
-process_feedback_file_body(BodyLines, MaybeCandidateCallSites) :-
-    ( process_feedback_file_body_2(BodyLines, [], CandidateCallSites) ->
-        MaybeCandidateCallSites = ok(CandidateCallSites)
-    ;
-        MaybeCandidateCallSites =
-            error("Profiling feedback file is not well-formed")
-    ).
-
-:- pred process_feedback_file_body_2(list(string)::in,
-    list(candidate_call_site)::in, list(candidate_call_site)::out) is semidet.
-
-process_feedback_file_body_2([], !CandidateCallSites).
-process_feedback_file_body_2([Line | Lines], !CandidateCallSites) :-
-    Words = string.words_separator(is_whitespace, Line),
-    Words = [Caller, SlotNumber, KindAsString | WordsTail],
-    ( Caller = "Mercury" ->
-        true
-    ;
-        string.to_int(SlotNumber, IntSlotNumber),
-        construct_call_site_kind(KindAsString, Kind),
-        (
-            Kind = csk_normal,
-            WordsTail = [Callee]
-        ;
-            ( Kind = csk_higher_order
-            ; Kind = csk_method
-            ; Kind = csk_special
-            ; Kind = csk_callback
-            ),
-            WordsTail = [],
-            Callee = ""
-        ),
-        CandidateCallSite = candidate_call_site(Caller, IntSlotNumber,
-            Kind, Callee),
-        !:CandidateCallSites = [CandidateCallSite | !.CandidateCallSites]
-    ),
-    process_feedback_file_body_2(Lines, !CandidateCallSites).
-
-%-----------------------------------------------------------------------------%
-
 :- func this_file = string.
 
 this_file = "implicit_parallelism.m".
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.476
diff -u -p -r1.476 mercury_compile.m
--- compiler/mercury_compile.m	21 Jul 2008 03:10:09 -0000	1.476
+++ compiler/mercury_compile.m	23 Jul 2008 01:33:38 -0000
@@ -4125,50 +4125,28 @@ maybe_structure_sharing_analysis(Verbose
 
 maybe_implicit_parallelism(Verbose, Stats, !HLDS, !IO) :-
     module_info_get_globals(!.HLDS, Globals),
-    globals.lookup_bool_option(Globals, parallel, Parallel),
-    globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
     globals.lookup_bool_option(Globals, implicit_parallelism,
         ImplicitParallelism),
-    globals.lookup_string_option(Globals, feedback_file,
-        FeedbackFile),
-    ( FeedbackFile = "" ->
-        % No feedback file has been specified.
-        true
-    ;
+    (
+        ImplicitParallelism = yes,
+        maybe_write_string(Verbose, "% Applying implicit " ++
+            "parallelism...\n", !IO),
+        maybe_flush_output(Verbose, !IO),
+        apply_implicit_parallelism_transformation(!.HLDS, MaybeHLDS),
         (
-            % If this is false, no implicit parallelism is to be introduced.
-            Parallel = yes,
-
-            % If this is false, then the user hasn't asked for implicit
-            % parallelism.
-            ImplicitParallelism = yes,
-
-            % Our mechanism for implicit parallelism only works for the low
-            % level backend.
-            HighLevelCode = no
-        ->
-            globals.get_target(Globals, Target),
-            (
-                Target = target_c,
-                maybe_write_string(Verbose, "% Applying implicit " ++
-                    "parallelism...\n", !IO),
-                maybe_flush_output(Verbose, !IO),
-                apply_implicit_parallelism_transformation(!HLDS,
-                    FeedbackFile, !IO),
-                maybe_write_string(Verbose, "% done.\n", !IO),
-                maybe_report_stats(Stats, !IO)
-            ;
-                ( Target = target_il
-                ; Target = target_java
-                ; Target = target_asm
-                ; Target = target_x86_64
-                ; Target = target_erlang
-                )
-                % Leave the HLDS alone. We cannot implement parallelism.
-            )
+            MaybeHLDS = yes(!:HLDS)
         ;
-            true
-        )
+            MaybeHLDS = no,
+            io.write_string(
+                "Insufficiant feedback information for implicit parallelism.",
+                !IO),
+            io.set_exit_status(1, !IO)
+        ),
+        maybe_write_string(Verbose, "% done.\n", !IO),
+        maybe_report_stats(Stats, !IO)
+    ;
+        % The user hasn't asked for implicit parallelism.
+        ImplicitParallelism = no
     ).
 
 :- pred maybe_control_granularity(bool::in, bool::in,
Index: deep_profiler/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/Mmakefile,v
retrieving revision 1.28
diff -u -p -r1.28 Mmakefile
--- deep_profiler/Mmakefile	6 Jun 2008 09:03:28 -0000	1.28
+++ deep_profiler/Mmakefile	23 Jul 2008 01:33:38 -0000
@@ -58,6 +58,7 @@ VPATH = $(LIBRARY_DIR) $(SSDB_DIR)
 #-----------------------------------------------------------------------------#
 
 MDBCOMP_MODULES = \
+	feedback.m \
 	mdbcomp.m \
 	prim_data.m \
 	program_representation.m \
Index: deep_profiler/mdprof_feedback.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/mdprof_feedback.m,v
retrieving revision 1.4
diff -u -p -r1.4 mdprof_feedback.m
--- deep_profiler/mdprof_feedback.m	17 Feb 2008 06:48:38 -0000	1.4
+++ deep_profiler/mdprof_feedback.m	23 Jul 2008 01:33:38 -0000
@@ -1,16 +1,16 @@
 %-----------------------------------------------------------------------------%
 % vim: ft=mercury ts=4 sw=4 et
 %-----------------------------------------------------------------------------%
-% Copyright (C) 2006-2007 The University of Melbourne.
+% Copyright (C) 2006-2008 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
 %
 % File: mdprof_feedback.m.
-% Author: tannier.
+% Author: tannier, pbone.
 %
 % This module contains the code for writing to a file the CSSs whose CSDs' 
-% average/median call sequence counts (own and desc) exceed the given threshold.
+% mean/median call sequence counts (own and desc) exceed the given threshold.
 % 
 % The generated file will then be used by the compiler for implicit parallelism.
 %
@@ -32,6 +32,9 @@
 
 :- import_module conf.
 :- import_module dump.
+:- import_module mdbcomp.
+:- import_module mdbcomp.feedback.
+:- import_module mdbcomp.program_representation.
 :- import_module measurements.
 :- import_module profile.
 :- import_module startup.
@@ -59,9 +62,14 @@ main(!IO) :-
         MaybeOptions = ok(Options),
         lookup_bool_option(Options, help, Help),
         lookup_bool_option(Options, version, Version),
+        lookup_string_option(Options, program_name, ProfileProgName0),
+        ProfileProgName = string.strip(ProfileProgName0),
         ( Version = yes ->
             write_version_message(ProgName, !IO)
-        ; Help = yes ->
+        ; 
+            ( Help = yes
+            ; ProfileProgName = "" )
+        ->
             write_help_message(ProgName, !IO)
         ; 
             ( Args = [Input, Output] ->
@@ -81,8 +89,9 @@ main(!IO) :-
                         MaybeProfile = ok(Deep),
                         compute_css_list_above_threshold(0, Deep, Threshold, 
                             MeasureType, [], CSSListAboveThreshold),
-                        generate_feedback_file(CSSListAboveThreshold, Deep, 
-                            MeasureType, Threshold, Output, !IO)
+                        generate_feedback_file(CSSListAboveThreshold, Deep,
+                            ProfileProgName, MeasureType, Threshold, Output,
+                            !IO)
                     ;
                         MaybeProfile = error(Error),
                         io.stderr_stream(Stderr, !IO),
@@ -109,25 +118,32 @@ main(!IO) :-
 
 :- pred write_help_message(string::in, io::di, io::uo) is det.
 
-write_help_message(ProgName) -->
-    io.format("Usage: %s [<options>] <input> <output>\n", [s(ProgName)]),
-    io.format("<input> must name a deep profiling data file.\n", []),
-    io.format("<output> is the file generated by this program.\n", []),
-    io.format("You may specify one of the following options:\n", []),
-    io.format("--help      Generate this help message.\n", []),
-    io.format("--version   Report the program's version number.\n", []),
-    io.format("--verbose   Generate progress messages.\n", []),
-    io.format("--threshold <value>\n", []),
-    io.format("            Set the threshold to <value>.\n",[]),
-    io.format("--measure average|median\n",[]),
-    io.format("            average : Write to <output> the call sites\n",[]),
-    io.format("            static whose call sites dynamic's average\n",[]),
-    io.format("            call sequence counts exceed the given\n",[]),  
-    io.format("            threshold (default option).\n",[]),
-    io.format("            median : Write to <output> the call sites\n",[]),
-    io.format("            static whose call sites dynamic's median\n",[]),
-    io.format("            call sequence counts exceed the given\n",[]),
-    io.format("            threshold.\n",[]).
+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,
+    io.format(Message, [s(ProgName)], !IO).
 
 :- pred write_version_message(string::in, io::di, io::uo) is det.
 
@@ -165,7 +181,7 @@ read_deep_file(Input, Verbose, DumpStage
     % exceed the given threshold.
     % 
 :- pred compute_css_list_above_threshold(int::in, deep::in, int::in, 
-    measure_type::in, list(call_site_static)::in, 
+    stat_measure::in, list(call_site_static)::in, 
     list(call_site_static)::out) is det.
 
 compute_css_list_above_threshold(Index, Deep, Threshold, Measure,
@@ -183,13 +199,13 @@ compute_css_list_above_threshold(Index, 
             Callseqs = 0
         ;
             ( 
-                Measure = average,
+                Measure = stat_mean,
                 list.foldr(sum_callseqs_csd_ptr(Deep), CSDList,
                     0, SumCallseqs),
                 % NOTE: we have checked that NumCSD is not zero above.
                 Callseqs = SumCallseqs // NumCSD
             ;
-                Measure = median,
+                Measure = stat_median,
                 list.sort(compare_csd_ptr(Deep), CSDList, CSDListSorted),
                 IndexMedian = NumCSD // 2,
                 list.index0_det(CSDListSorted, IndexMedian, MedianPtr),
@@ -229,69 +245,67 @@ compare_csd_ptr(Deep, CSDPtrA, CSDPtrB, 
     compare(Result, SumA, SumB).
 
     % Generate a profiling feedback file that contains the CSSs whose CSDs' 
-    % average/median call sequence counts (own and desc) exceed the given 
+    % mean/median call sequence counts (own and desc) exceed the given 
     % threshold. 
     % 
-:- pred generate_feedback_file(list(call_site_static)::in, deep::in, 
-    measure_type::in, int::in, string::in, io::di, io::uo) is det.
-    
-generate_feedback_file(CSSList, Deep, Measure, Threshold, Output, !IO) :-
-    io.open_output(Output, Result, !IO),
+:- 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]
     (
-        Result = io.error(Err),
-        io.stderr_stream(Stderr, !IO),
-        io.write_string(Stderr, io.error_message(Err) ++ "\n", !IO)
+        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
     ;
-        Result = ok(Stream),
-        io.write_string(Stream, "Profiling feedback file\n", !IO),
-        io.write_string(Stream, "Version = 1.0\n", !IO),
-        (
-            Measure = average,
-            io.write_string(Stream, "Measure = average\n", !IO)
-        ;
-            Measure = median,
-            io.write_string(Stream, "Measure = median\n", !IO)
-        ),
-        io.format(Stream, "Threshold = %i\n", [i(Threshold)], !IO),
-        write_css_list(CSSList, Deep, Stream, !IO),
-        io.close_output(Stream, !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)
     ).
 
     % Write to the output the list of CSSs.     
     % 
-:- pred write_css_list(list(call_site_static)::in, deep::in, output_stream::in, 
-    io::di, io::uo) is det.
+:- pred css_to_call(deep::in, call_site_static::in, call_site::out) is det.
    
-write_css_list([], _, _, !IO).
-write_css_list([ CSS | CSSList0 ], Deep, OutStrm, !IO) :-
-        
-    % Print the caller.
-    lookup_proc_statics(Deep ^ proc_statics, CSS ^ css_container, Caller),
-    io.write_string(OutStrm, Caller ^ ps_raw_id ++ " ", !IO),
-        
-    % Print the slot number of the CSS.
-    io.write_int(OutStrm, CSS ^ css_slot_num, !IO),
-    io.write_string(OutStrm, " ", !IO),
+css_to_call(Deep, CSS, Call) :-
+    % Get the caller.
+    lookup_proc_statics(Deep ^ proc_statics, CSS ^ css_container, CallerPS),
+    Caller = CallerPS ^ ps_id,    
+
+    % Get the slot number.
+    Slot = CSS ^ css_slot_num,
     
-    % Print the callee.
+    % Get the Callee and Call Type.
     (
         CSS ^ css_kind = normal_call_and_callee(PSPtr, _),
-        lookup_proc_statics(Deep ^ proc_statics, PSPtr, Callee),
-        io.format(OutStrm, "normal_call %s\n", [s(Callee ^ ps_raw_id)], !IO)
+        lookup_proc_statics(Deep ^ proc_statics, PSPtr, CalleePS),
+        CallTypeAndCallee = plain_call(CalleePS ^ ps_id)
     ;
         CSS ^ css_kind = special_call_and_no_callee,
-        io.write_string(OutStrm, "special_call\n", !IO)
+        CallTypeAndCallee = special_call
     ;
         CSS ^ css_kind = higher_order_call_and_no_callee,
-        io.write_string(OutStrm, "higher_order_call\n", !IO)
+        CallTypeAndCallee = higher_order_call
     ;
         CSS ^ css_kind = method_call_and_no_callee,
-        io.write_string(OutStrm, "method_call\n", !IO)
+        CallTypeAndCallee = method_call
     ;
         CSS ^ css_kind = callback_and_no_callee,
-        io.write_string(OutStrm, "callback\n", !IO)
+        CallTypeAndCallee = callback_call
     ),
-    write_css_list(CSSList0, Deep, OutStrm, !IO).
+   
+    % Build the call datastructure.
+    Call = call_site(Caller, Slot, CallTypeAndCallee).
 
 %-----------------------------------------------------------------------------%
 
@@ -301,13 +315,10 @@ write_css_list([ CSS | CSSList0 ], Deep,
     ;       verbose
     ;       version
     ;       measure
+    ;       program_name
     ;       dump_stages
     ;       dump_options.
 
-:- type measure_type
-    --->    average
-    ;       median.
-
 :- type option_table == option_table(option).
 
 :- pred short(char::in, option::out) is semidet.
@@ -317,10 +328,10 @@ 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).
@@ -328,6 +339,7 @@ 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).
 
@@ -337,14 +349,15 @@ defaults(threshold,         int(100000))
 defaults(help,              bool(no)).
 defaults(verbose,           bool(no)).
 defaults(version,           bool(no)).
-defaults(measure,           string("average")).
+defaults(measure,           string("mean")).
+defaults(program_name,      string("")).
 defaults(dump_stages,       accumulating([])).
 defaults(dump_options,      accumulating([])).
 
-:- pred construct_measure(string::in, measure_type::out) is semidet.
+:- pred construct_measure(string::in, stat_measure::out) is semidet.
 
-construct_measure("average",    average).
-construct_measure("median",     median).
+construct_measure("mean",       stat_mean).
+construct_measure("median",     stat_median).
 
 %-----------------------------------------------------------------------------%
 :- end_module mdprof_feedback.
Index: mdbcomp/feedback.m
===================================================================
RCS file: mdbcomp/feedback.m
diff -N mdbcomp/feedback.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ mdbcomp/feedback.m	23 Jul 2008 01:33:38 -0000
@@ -0,0 +1,421 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2008 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% 
+% File: feedback.m.
+% Main author: pbone.
+% 
+% This module defines data structures for representing feedback information
+% as well as procedures for reading and writing feedback files.  It is
+% included in the compiler and in any tools that generate feedback data.
+% 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module mdbcomp.feedback.
+
+:- interface.
+
+:- import_module mdbcomp.program_representation.
+
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module maybe.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+    % Feedback information is stored in this datatype when in memory.
+    %
+:- type feedback_info.
+
+%-----------------------------------------------------------------------------%
+
+    % This type is used as a key for the data that may be fed back into the
+    % complier.  When making changes to this structure be sure to increment the
+    % file format version number towards the bottom of this file.
+    %
+:- type feedback_type
+    --->    feedback_type_calls_above_threshold_sorted.
+                % Feedback data of this type represents a list of
+                % calli sites sorted in decending order of mean/median
+                % call cost where that cost is greater than a given
+                % threshold.  Mean or median costs are used.
+               
+
+%-----------------------------------------------------------------------------%
+
+    % This type stores the data that may be fed back into the compiler.  Each
+    % constructor here corresponds to a value of the above type.  When making
+    % changes to this structure or structures in mdbcomp.program_representation
+    % be sure to increment the file format version number towards the bottom of
+    % this file.
+    %
+    % TODO: Somehow need to constrain the instantiations of this type so that
+    % they are always paired with instantitations of the above type, and
+    % hopefuly the complier can assert this.
+    %
+:- type feedback_data
+    --->    feedback_data_calls_above_threshold_sorted(
+                threshold       :: int,
+                stat_measure    :: stat_measure,
+                calls           :: list(call_site)
+            ).
+
+:- type stat_measure
+    --->    stat_mean
+    ;       stat_median.
+
+%-----------------------------------------------------------------------------%
+
+    % put_feedback_data(InfoType, Info, !State)
+    %
+    % 'Put' feedback data into the feedback files.  Data is stored based on
+    % the type of information being stored.
+    %
+    % Data loaded from file (not added with put) will be removed from the
+    % internal state when data for the same info type is added.
+    %
+:- pred put_feedback_data(feedback_type::in, feedback_data::in,
+    feedback_info::in, feedback_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+    % get_feedback_data(InfoType, MaybeInfo, State).
+    %
+    % To query the feedback files 'get' will give a value for a given info type
+    % if it exists.
+    % 
+:- pred get_feedback_data(feedback_type::in, maybe(feedback_data)::out,
+    feedback_info::in) is det.
+    
+%-----------------------------------------------------------------------------%
+
+    % read_feedback_file(Path, FeedbackState, !IO)
+    %
+    % This predicate reads in feedback data from a specified file.  It should
+    % be called once per compiler invocation.
+    %
+:- pred read_feedback_file(string::in, 
+    feedback_read_result(feedback_info)::out, io::di, io::uo) is det.
+
+:- type feedback_read_result(T)
+    --->    ok(T)
+    ;       error(feedback_read_error).
+
+:- type feedback_read_error
+    --->    open_error(io.error)
+    ;       read_error(io.error)
+    ;       parse_error(
+                message     :: string,
+                line_no     :: int)
+    ;       unexpected_eof
+    ;       incorrect_version
+    ;       incorrect_first_line
+    ;       incorrect_program_name.
+
+%-----------------------------------------------------------------------------%
+
+    % read_error_message_string(File, Error, Message)
+    %
+    % Create a string describing the read error.
+    %
+:- pred read_error_message_string(string::in, feedback_read_error::in,
+    string::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+    % Try to read in a feedback file, if the file doesn't exist create a new
+    % empty feedback state in memory.
+    %
+:- pred read_or_create(string::in, feedback_info::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+    % init_feedback_info = FeedbackState
+    % 
+    % Create a new empty feedback state.
+    %
+:- func init_feedback_info = feedback_info.
+
+%-----------------------------------------------------------------------------%
+
+    % write_feedback_file(Path, ProgName, FeedbackState, FeedbackWriteResult, 
+    %   !IO)
+    %
+    % Write out the feedback data to a given file name.
+    %
+:- pred write_feedback_file(string::in, string::in, feedback_info::in, 
+    feedback_write_result::out, io::di, io::uo) is det.
+
+:- type feedback_write_result
+    --->    ok
+    ;       open_error(io.error)
+    ;       write_error(io.error).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+:- import_module map.
+:- import_module svmap.
+:- import_module unit.
+:- import_module univ.
+
+%-----------------------------------------------------------------------------%
+
+:- type feedback_info
+    ---> feedback_info(map(feedback_type, feedback_data)).
+
+%-----------------------------------------------------------------------------%
+
+get_feedback_data(Type, MaybeData, Info) :-
+    Info = feedback_info(Map),
+    (
+        map.search(Map, Type, Data)
+    ->
+        MaybeData = yes(Data)
+    ;
+        MaybeData = no
+    ).
+
+%-----------------------------------------------------------------------------%
+
+put_feedback_data(Type, Data, !Info) :-
+    some [!Map] (
+        !.Info = feedback_info(!:Map),
+        svmap.set(Type, Data, !Map),
+        !:Info = feedback_info(!.Map)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+read_feedback_file(Path, ReadResultFeedbackInfo, !IO) :-
+    io.open_input(Path, IOResStream, !IO),
+    (
+        %
+        % Set the data file as the current stream and call read2.
+        %
+        IOResStream = ok(Stream),
+        some [!Result] (
+            %
+            % Read each part of the file and continue reading of this is
+            % succesful.  read_cont takes care of this logic.
+            %
+            read_check_line(feedback_first_line, incorrect_first_line, Stream, 
+                unit, !:Result, !IO),
+            maybe_read(
+                read_check_line(feedback_version, incorrect_version, Stream), 
+                !Result, !IO),
+            maybe_read(
+                read_no_check_line(Stream), 
+                !Result, !IO),
+            maybe_read(read_data(Stream), !Result, !IO),
+            ReadResultFeedbackInfo = !.Result
+        ),
+        io.close_input(Stream, !IO)
+    ;
+        IOResStream = error(ErrorCode),
+        ReadResultFeedbackInfo = error(open_error(ErrorCode))
+    ).
+
+    % If the result so far is successful, call the colsure and return it's
+    % result.  Otherwise return the accumulated result without calling the
+    % colsure.
+    %
+:- pred maybe_read(pred(A, feedback_read_result(B), io, io), 
+    feedback_read_result(A), feedback_read_result(B), io, io).
+:- mode maybe_read(pred(in, out, di, uo) is det,
+    in, out, di, uo) is det.
+
+maybe_read(Pred, Result0, Result, !IO) :-
+    (
+        Result0 = ok(Acc),
+        Pred(Acc, Result, !IO)
+    ;
+        Result0 = error(Error),
+        Result = error(Error)
+    ).
+
+    % Read and check a line of the file.
+    %
+:- pred read_check_line(string::in, feedback_read_error::in, 
+    io.input_stream::in, unit::in, feedback_read_result(unit)::out, 
+    io::di, io::uo) is det.
+
+read_check_line(TestLine, NotMatchError, Stream, _, Result, !IO) :-
+    io.read_line_as_string(Stream, IOResultLine, !IO),
+    (
+        IOResultLine = ok(Line),
+        (
+            ( Line = TestLine
+            ; Line = TestLine ++ "\n")
+        ->
+            Result = ok(unit)
+        ;
+            Result = error(NotMatchError)
+        )
+    ;
+        IOResultLine = eof,
+        Result = error(unexpected_eof)
+    ;
+        IOResultLine = error(Error),
+        Result = error(read_error(Error))
+    ).
+
+    % Read and don't check a line of the file.
+    %
+:- pred read_no_check_line(io.input_stream::in, unit::in, 
+    feedback_read_result(unit)::out, io::di, io::uo) is det.
+
+read_no_check_line(Stream, _, Result, !IO) :-
+    io.read_line_as_string(Stream, IOResultLine, !IO),
+    (
+        IOResultLine = ok(_),
+        Result = ok(unit)
+    ;
+        IOResultLine = eof,
+        Result = error(unexpected_eof)
+    ;
+        IOResultLine = error(Error),
+        Result = error(read_error(Error))
+    ).
+
+    % Read the feedback data from the file.
+    %
+:- pred read_data(io.input_stream::in, unit::in, 
+    feedback_read_result(feedback_info)::out, io::di, io::uo) is det.
+
+read_data(Stream, _, Result, !IO) :-
+    io.read(Stream, ReadResultDataAssocList, !IO),
+    (
+        ReadResultDataAssocList = ok(DataAssocList),
+        map.det_insert_from_assoc_list(map.init, DataAssocList, Map),
+        Result = ok(feedback_info(Map))
+    ;
+        ReadResultDataAssocList = eof,
+        Result = error(unexpected_eof)
+    ;
+        ReadResultDataAssocList = error(Error, Line),
+        Result = error(parse_error(Error, Line))
+    ).
+
+%-----------------------------------------------------------------------------%
+
+read_or_create(Path, Feedback, !IO) :-
+    read_feedback_file(Path, ReadResultFeedback, !IO),
+    (
+        ReadResultFeedback = ok(Feedback)
+    ;
+        ReadResultFeedback = error(Error),
+        display_read_error(Path, Error, !IO),
+        Feedback = init_feedback_info
+    ).
+
+%-----------------------------------------------------------------------------%
+
+read_error_message_string(File, Error, Message) :-
+    (
+        ( Error = open_error(Code)
+        ; Error = read_error(Code) ),
+        error_message(Code, MessagePart)
+    ;
+        Error = parse_error(ParseMessage, Line),
+        MessagePart = ParseMessage ++ " on line " ++ string(Line)
+    ;
+        Error = unexpected_eof,
+        MessagePart = "Unexpected end of file"
+    ;
+        Error = incorrect_version,
+        MessagePart = "Incorrect file format version"
+    ;
+        Error = incorrect_first_line,
+        MessagePart = "Incorrect file format"
+    ;
+        Error = incorrect_program_name,
+        MessagePart = "Program name didn't match, is this the right feedback file?"
+    ),
+    string.format("%s: %s\n", [s(File), s(MessagePart)], Message).
+
+%-----------------------------------------------------------------------------%
+
+:- pred display_read_error(string::in, feedback_read_error::in, 
+    io::di, io::uo) is det.
+
+display_read_error(File, Error, !IO) :-
+    read_error_message_string(File, Error, Message),
+    io.write_string(Message, !IO).
+
+%-----------------------------------------------------------------------------%
+
+init_feedback_info = feedback_info(map.init).
+
+%-----------------------------------------------------------------------------%
+
+write_feedback_file(Path, ProgName, Feedback, Res, !IO) :-
+    io.open_output(Path, OpenRes, !IO),
+    (
+        OpenRes = ok(Stream),
+        promise_equivalent_solutions [!:IO, ExcpRes] 
+            try_io(write2(Stream, ProgName, Feedback), ExcpRes, !IO),
+        (
+            ExcpRes = succeeded(_),
+            Res = ok
+        ;
+            ExcpRes = exception(ExcpUniv),
+            
+            %
+            % If the exception is not a type we exected then re-throw it.
+            %
+            (
+                univ_to_type(ExcpUniv, Excp)
+            ->
+                Res = write_error(Excp)
+            ;
+                rethrow(ExcpRes)
+            )
+        )
+    ;
+        OpenRes = error(ErrorCode),
+        Res = open_error(ErrorCode)
+    ). 
+
+    % Write out the data.  This is called by try IO to catch any exceptions
+    % that close_output and other predicates may throw.
+    %
+:- pred write2(output_stream::in, string::in, feedback_info::in, unit::out, 
+    io::di, io::uo) is det.
+
+write2(Stream, ProgName, Feedback, unit, !IO) :-
+    io.write_string(Stream, feedback_first_line, !IO),
+    io.nl(Stream, !IO),
+    io.write_string(Stream, feedback_version, !IO),
+    io.nl(Stream, !IO),
+    io.write_string(Stream, ProgName, !IO),
+    io.nl(Stream, !IO),
+    Feedback = feedback_info(Map),
+    map.to_assoc_list(Map, FeedbackList),
+    io.write(Stream, FeedbackList, !IO),
+    io.write_string(Stream, ".\n", !IO),
+    io.close_output(Stream, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- func feedback_first_line = string.
+
+feedback_first_line = "Mercury Compiler Feedback".
+
+:- func feedback_version = string.
+
+feedback_version = "1".
+
+%-----------------------------------------------------------------------------%
+:- end_module mdbcomp.feedback.
+%-----------------------------------------------------------------------------%
Index: mdbcomp/mdbcomp.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/mdbcomp.m,v
retrieving revision 1.6
diff -u -p -r1.6 mdbcomp.m
--- mdbcomp/mdbcomp.m	22 Sep 2006 03:50:45 -0000	1.6
+++ mdbcomp/mdbcomp.m	23 Jul 2008 01:33:38 -0000
@@ -22,7 +22,9 @@
 
 :- pred mdbcomp.version(string::out) is det.
 
-% If you add any modules here, you should update the list in slice/Mmakefile.
+% If you add any modules here, you should update the lists in 
+% deep_profiler/Mmakefile and slice/Mmakefile.
+:- include_module feedback.
 :- include_module prim_data.
 :- include_module program_representation.
 :- include_module rtti_access.
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.30
diff -u -p -r1.30 program_representation.m
--- mdbcomp/program_representation.m	19 Mar 2008 05:30:00 -0000	1.30
+++ mdbcomp/program_representation.m	23 Jul 2008 01:33:38 -0000
@@ -285,6 +285,27 @@
 
 %-----------------------------------------------------------------------------%
 
+    % Describe a call site.
+    %
+:- type call_site
+    --->    call_site(
+                caller                  :: string_proc_label,
+                slot                    :: int,
+                call_type_and_callee    :: call_type_and_callee
+            ).
+
+    % The type and callee of call.  The callee is only availbie for plain
+    % calls.
+    %
+:- type call_type_and_callee
+    --->    callback_call
+    ;       higher_order_call
+    ;       method_call
+    ;       plain_call(string_proc_label)
+    ;       special_call.
+
+%-----------------------------------------------------------------------------%
+
 % We can think of the goal that defines a procedure to be a tree, whose leaves
 % are primitive goals and whose interior nodes are compound goals. These two
 % types describe the position of a goal in this tree. A goal_path_step type
Index: slice/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/slice/Mmakefile,v
retrieving revision 1.15
diff -u -p -r1.15 Mmakefile
--- slice/Mmakefile	8 Dec 2007 15:29:02 -0000	1.15
+++ slice/Mmakefile	23 Jul 2008 01:33:38 -0000
@@ -48,6 +48,7 @@ VPATH = $(LIBRARY_DIR) $(SSDB_DIR)
 
 MDBCOMP_MODULES = \
 	mdbcomp.m \
+	feedback.m \
 	prim_data.m \
 	program_representation.m \
 	rtti_access.m \

-------------- 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/20080723/e63f2f2e/attachment.sig>


More information about the reviews mailing list