Files
mercury/mdbcomp/feedback.m
Zoltan Somogyi ec2c7fad76 Simplify the code reading/writing feedback files ...
mdbcomp/feedback.m:
    ... by avoiding the overuse of higher order code and exceptions.
    (The old code tried to catch exceptions, even though the code in the
    try block shouldn't be able to throw any.)

    Document a vulnerability in the use io.read/io.write on feedback files,
    which was discussed on m-rev in 2008 July when this file was created.
2023-04-25 01:42:23 +10:00

596 lines
23 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2008-2011 The University of Melbourne.
% Copyright (C) 2014-2015, 2017-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: feedback.m.
% Main author: pbone.
%
% This module defines data structures for representing feedback information
% in Mercury code, as well as procedures for reading and writing the feedback
% files that represent such information on disk.
%
% This module is included both in the compiler and in the tools that
% generate this feedback data.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module mdbcomp.feedback.
:- interface.
% If you add any modules here, you should update the lists in
% deep_profiler/Mmakefile and slice/Mmakefile.
:- include_module automatic_parallelism.
:- import_module mdbcomp.feedback.automatic_parallelism.
:- import_module mdbcomp.program_representation.
:- import_module assoc_list.
:- import_module io.
:- import_module maybe.
%---------------------------------------------------------------------------%
% The feedback_info type stores the data that may be fed back
% into the compiler. For a detailed description, see the comment
% on the non-abstract definition in the implementation section.
%
:- type feedback_info.
% init_feedback_info(ProfiledProgramName) = FeedbackInfo:
%
% Create a new empty feedback info structure, recording that it is
% intended to hold feedback information for the program with the given
% name.
%
% XXX The predicates that add information to feedback_infos now require
% their callers to specify what profiled program their information is for,
% and this is checked against the profiled program name in the
% feedback_info. We could instead initialize feedback_infos *without*
% storing the program name, and record that name on the first update
% of the feedback_info instead. This would remove one source of possible
% name mismatches.
%
:- func init_feedback_info(string) = feedback_info.
%---------------------------------------------------------------------------%
%
% The kinds of information that we can record in a feedback file.
%
% Historically, we also supported a feedback type that was used by
% Jerome Tannier's attempt at discovering a useful set of conjunctions
% to parallelise. However, this early attempt at automatic parallelisation
% yielded results that were much inferior to our current system, so it
% should interest only historians. The code supporting Tanner's feedback
% type was removed from the feedback system on 2014 december 1;
% if you want it, look in the git archives for commits on that date.
%
% Values of this type represent a list of candidate conjunctions
% for implicit parallelism.
%
:- type feedback_info_candidate_parallel_conjunctions
---> feedback_info_candidate_parallel_conjunctions(
cpc_parameters :: candidate_par_conjunctions_params,
% For each procedure that has some candidate parallel
% conjunctions, list those candidates.
cpc_conjunctions :: assoc_list(string_proc_label,
candidate_par_conjunctions_proc)
).
%---------------------------------------------------------------------------%
%
% The getter predicates of feedback_info.
%
% Get the name of the program whose profiled execution the given
% feedback_info was derived from.
%
:- func get_feedback_profiled_program_name(feedback_info) = string.
% get_feedback_*(Info) = Data:
%
% Get any feedback data of the given kind from the given feedback_info.
%
:- func get_feedback_candidate_parallel_conjunctions(feedback_info) =
maybe(feedback_info_candidate_parallel_conjunctions).
% Get all the information held in the given feedback info. Callers should
% call this predicate, instead of the ones above, if they want to guarantee
% that even if the feedback_info type is updated, they will still get
% all the information present in the given feedback_info.
%
:- pred get_all_feedback_info(feedback_info::in,
string::out, maybe(feedback_info_candidate_parallel_conjunctions)::out)
is det.
%---------------------------------------------------------------------------%
%
% The setter predicates of feedback_info.
%
% add_feedback_*(ProfiledProgramName, Data, !Info)
%
% Put Data into the selected field of the feedback_info, which must hold
% information about ProfiledProgramName. Requires the old feedback_info
% to have no previous information in that field.
%
:- pred add_feedback_candidate_parallel_conjunctions(string::in,
feedback_info_candidate_parallel_conjunctions::in,
feedback_info::in, feedback_info::out) is det.
% replace_feedback_*(ProfiledProgramName, Data, !Info)
%
% Put Data into the selected field of the feedback_info, which must hold
% information about ProfiledProgramName. Requires the old feedback_info
% Any previous information in that field of feedback_info
% is replaced by Data.
%
:- pred replace_feedback_candidate_parallel_conjunctions(string::in,
feedback_info_candidate_parallel_conjunctions::in,
feedback_info::in, feedback_info::out) is det.
%---------------------------------------------------------------------------%
%
% Reading in feedback files.
%
:- type feedback_read_result(T) == maybe_error(T, feedback_read_error).
:- type feedback_read_error
---> fre_open_error(io.error)
; fre_read_error(io.error)
; fre_parse_error(
fre_pe_message :: string,
fre_pe_line_no :: int
)
; fre_unexpected_eof
; fre_incorrect_version(string)
; fre_incorrect_first_line
; fre_incorrect_profiled_program_name(
fre_ippn_expected :: string,
fre_ippn_got :: string
)
; fre_repeated_component(
fre_component_name :: string
).
% feedback_read_error_message_string(File, Error, Message):
%
% Create a string describing the read error.
%
:- pred feedback_read_error_message_string(string::in, feedback_read_error::in,
string::out) is det.
% read_or_create_feedback_file(Path, ProfiledProgramName, Result, !IO):
%
% If Path stores a feedback file for ProfiledProgramName, read it in.
% If it does not exist, return an empty feedback state for
% ProfiledProgramName, and return that. Return an error if Path does exist,
% but either does not contain a valid feedback file, or contains a valid
% feedback file for some other profiled program.
%
% ProfiledProgramName is the name of the program whose profiled execution
% the feedback file was (or should be) generated from.
% We record this to avoid mixing the feedback information of unrelated
% executables.
%
:- pred read_or_create_feedback_file(string::in, string::in,
feedback_read_result(feedback_info)::out, io::di, io::uo) is det.
% read_feedback_file(Path, MaybeProfiledProgramName, FeedbackInfo, !IO):
%
% This predicate attempts to read in feedback data from Path. If
% MaybeProfiledProgramName is yes(ProfiledProgramName), generate an
% error if the feedback data is not for ProfiledProgramName.
%
% This predicate should be called once per compiler invocation.
%
:- pred read_feedback_file(string::in, maybe(string)::in,
feedback_read_result(feedback_info)::out, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%
% Writing out feedback files.
%
:- type feedback_write_result
---> fwr_ok
; fwr_open_error(io.error)
; fwr_write_error(io.error).
% write_feedback_file(Path, FeedbackInfo, FeedbackWriteResult, !IO):
%
% Write out the feedback data in FeedbackWriteResult to Path.
%
:- pred write_feedback_file(string::in, feedback_info::in,
feedback_write_result::out, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module list.
:- import_module require.
:- import_module string.
% There are several kinds of information that we may be interested in
% feeding back to the compiler. Our design for representing feedback
% information allows for a tool to generate an arbitrary subset of
% the possible kinds of information. A feedback-generating tool will
% put each kind of information that it generates in its assigned slot
% with a yes(...) wrapped around it, while it will put a "no" in all
% other slots.
%
% If you want add a new kind of feedback information, you will need to
%
% - add a new maybe field to the feedback_info type;
% - add a getter predicate and two setter predicates for that field;
% - update the init_feedback_info predicate;
% - update the get_all_feedback_info predicate;
% - update the print_feedback_report predicate;
% - add a new alternative to the feedback_component_wrapper type;
% - add code to add_feedback_components to read in the new kind of
% information;
% - add code to actually_write_feedback_file to write out the new kind of
% information;
% - increment the file format version number at the bottom of this file.
%
% You will also need to increment the file format version number
% if you change the definition of any of the types referred to, directly
% or indirectly, by the feedback_component_wrapper type, including the types
% in mdbcomp.program_representation.
:- type feedback_info
---> feedback_info(
% The name of the program whose execution generated
% the profiling data file that the feedback is derived from,
% and therefore the program whose compilation the feedback
% is intended for.
fi_profiled_program_name :: string,
% The actual feedback data as read from the feedback file.
% Should be set to yes(...) iff feedback of the given sort
% is present in the file.
fi_maybe_candidate_parallel_conjunctions ::
maybe(feedback_info_candidate_parallel_conjunctions)
).
:- type feedback_component_wrapper
---> fcw_candidate_parallel_conjunctions(
feedback_info_candidate_parallel_conjunctions
).
%---------------------------------------------------------------------------%
%
% Initialization and getter and setter predicates for feedback_infos.
%
init_feedback_info(ProgramName) = feedback_info(ProgramName, no).
get_feedback_profiled_program_name(Info) = Info ^ fi_profiled_program_name.
get_feedback_candidate_parallel_conjunctions(Info) =
Info ^ fi_maybe_candidate_parallel_conjunctions.
get_all_feedback_info(Info, ProfiledProgramName,
MaybeCandidateParallelConjs) :-
Info = feedback_info(ProfiledProgramName, MaybeCandidateParallelConjs).
add_feedback_candidate_parallel_conjunctions(ProfiledProgramName, Data,
!Info) :-
expect(unify(!.Info ^ fi_profiled_program_name, ProfiledProgramName),
$pred, "adding candidate parallel conjunctions for wrong program"),
expect(unify(!.Info ^ fi_maybe_candidate_parallel_conjunctions, no),
$pred, "overwriting old candidate_parallel_conjunctions data"),
!Info ^ fi_maybe_candidate_parallel_conjunctions := yes(Data).
replace_feedback_candidate_parallel_conjunctions(ProfiledProgramName, Data,
!Info) :-
expect(unify(!.Info ^ fi_profiled_program_name, ProfiledProgramName),
$pred, "replacing candidate parallel conjunctions for wrong program"),
!Info ^ fi_maybe_candidate_parallel_conjunctions := yes(Data).
%---------------------------------------------------------------------------%
%
% Interpreting the errors that can happen when reading in feedback files.
%
feedback_read_error_message_string(File, Error, Message) :-
(
( Error = fre_open_error(Code)
; Error = fre_read_error(Code)
),
error_message(Code, MessagePart)
;
Error = fre_parse_error(ParseMessage, Line),
MessagePart = ParseMessage ++ " on line " ++ string(Line)
;
Error = fre_unexpected_eof,
MessagePart = "Unexpected end of file"
;
Error = fre_incorrect_version(Expected),
MessagePart = "Incorrect file format version; expected " ++ Expected
;
Error = fre_incorrect_first_line,
MessagePart = "Incorrect file format"
;
Error = fre_incorrect_profiled_program_name(Expected, Got),
MessagePart =
"The name of the program the feedback is for didn't match,"
++ " is this the right feedback file?\n"
++ string.format("Expected: '%s' Got: '%s'", [s(Expected), s(Got)])
;
Error = fre_repeated_component(ComponentName),
MessagePart = "File contains more than one "
++ ComponentName ++ " component"
),
string.format("%s: %s\n", [s(File), s(MessagePart)], Message).
%---------------------------------------------------------------------------%
%
% Reading feedback files.
%
read_or_create_feedback_file(Path, ExpectedProfiledProgramName,
FeedbackResult, !IO) :-
read_feedback_file(Path, yes(ExpectedProfiledProgramName),
ReadResult, !IO),
(
ReadResult = ok(_Feedback),
FeedbackResult = ReadResult
;
ReadResult = error(Error),
(
% XXX We assume that an open error is probably caused by the file
% not existing, but we can't be sure because io.error is a string,
% and the message string for any error may change.
% XXX Given that ReadResult is given to us by the predicate
% just below, we could get it to tell us *directly* whether
% the error is caused by trying to open a non-existent file.
Error = fre_open_error(_),
FeedbackResult = ok(
init_feedback_info(ExpectedProfiledProgramName))
;
( Error = fre_read_error(_)
; Error = fre_parse_error(_, _)
; Error = fre_unexpected_eof
; Error = fre_incorrect_version(_)
; Error = fre_incorrect_first_line
; Error = fre_incorrect_profiled_program_name(_, _)
; Error = fre_repeated_component(_)
),
FeedbackResult = ReadResult
)
).
read_feedback_file(Path, MaybeExpectedProfiledProgramName,
ResultFeedbackInfo, !IO) :-
io.open_input(Path, PathResult, !IO),
(
PathResult = ok(PathStream),
some [!MaybeError] (
% Each predicate we call below stops reading when given
% !.MaybeError = yes(...).
!:MaybeError = no,
read_check_line(PathStream, feedback_first_line,
fre_incorrect_first_line, !MaybeError, !IO),
read_check_line(PathStream, feedback_version,
fre_incorrect_version(feedback_version), !MaybeError, !IO),
read_profiled_program_name(PathStream,
MaybeExpectedProfiledProgramName,
!.MaybeError, MaybeActualProfiledProgram, !IO),
read_all_feedback_data(PathStream, MaybeActualProfiledProgram,
ResultFeedbackInfo, !IO)
),
io.close_input(PathStream, !IO)
;
PathResult = error(ErrorCode),
ResultFeedbackInfo = error(fre_open_error(ErrorCode))
).
% Read and check a line of the file.
%
:- pred read_check_line(io.text_input_stream::in, string::in,
feedback_read_error::in,
maybe(feedback_read_error)::in, maybe(feedback_read_error)::out,
io::di, io::uo) is det.
read_check_line(Stream, TestLine, NotMatchError, !MaybeError, !IO) :-
(
!.MaybeError = yes(_)
;
!.MaybeError = no,
io.read_line_as_string(Stream, LineResult, !IO),
(
LineResult = ok(Line),
( if
( Line = TestLine
; Line = TestLine ++ "\n"
)
then
!:MaybeError = no
else
!:MaybeError = yes(NotMatchError)
)
;
LineResult = eof,
!:MaybeError = yes(fre_unexpected_eof)
;
LineResult = error(Error),
!:MaybeError = yes(fre_read_error(Error))
)
).
:- pred read_profiled_program_name(io.text_input_stream::in, maybe(string)::in,
maybe(feedback_read_error)::in,
maybe_error(string, feedback_read_error)::out, io::di, io::uo) is det.
read_profiled_program_name(Stream, MaybeExpectedProfiledProgram,
!.MaybeError, MaybeActualProfiledProgram, !IO) :-
(
!.MaybeError = yes(Error),
MaybeActualProfiledProgram = error(Error)
;
!.MaybeError = no,
io.read_line_as_string(Stream, LineResult, !IO),
(
LineResult = ok(String),
ActualProfiledProgram = string.strip(String),
(
MaybeExpectedProfiledProgram = no,
MaybeActualProfiledProgram = ok(ActualProfiledProgram)
;
MaybeExpectedProfiledProgram = yes(ExpectedProfiledProgram),
( if ActualProfiledProgram = ExpectedProfiledProgram then
MaybeActualProfiledProgram = ok(ActualProfiledProgram)
else
MaybeActualProfiledProgram =
error(fre_incorrect_profiled_program_name(
ExpectedProfiledProgram, ActualProfiledProgram))
)
)
;
LineResult = eof,
MaybeActualProfiledProgram = error(fre_unexpected_eof)
;
LineResult = error(Error),
MaybeActualProfiledProgram = error(fre_read_error(Error))
)
).
% Read the feedback data from the file.
%
% The feedback data in the file should be a single large term.
% This term should be a list, each element of which is an identifying
% wrapper around a feedback component.
%
% The overall term is handled by read_all_feedback_data, while
% the list elements are handled by add_feedback_components.
%
:- pred read_all_feedback_data(io.text_input_stream::in,
maybe_error(string, feedback_read_error)::in,
feedback_read_result(feedback_info)::out, io::di, io::uo) is det.
read_all_feedback_data(Stream, MaybeActualProfiledProgram, Result, !IO) :-
(
MaybeActualProfiledProgram = error(Error),
Result = error(Error)
;
MaybeActualProfiledProgram = ok(ActualProfiledProgram),
% XXX Note that the use of io.read here, and io.write in
% actually_write_feedback_file below, are accident-prone, because
% any change to any of the function symbols in the type tree of
% feedback_info will result in a de-facto change in the format
% of feedback files, *without this fact necessarily being apparent
% to the person making the change*, which can thus easily result
% in the file format version number NOT being incremented.
io.read(Stream, ReadResult, !IO),
(
ReadResult = ok(Components),
Info0 = init_feedback_info(ActualProfiledProgram),
add_feedback_components(Components, Info0, Result)
% XXX We should check there nothing in the input after this term.
% XXX This would be easier to do if we read in the whole file
% using io.read_named_file_as_lines, and parsed this last line
% using read_term_from_string.
;
ReadResult = eof,
Result = error(fre_unexpected_eof)
;
ReadResult = error(Error, Line),
Result = error(fre_parse_error(Error, Line))
)
).
:- pred add_feedback_components(list(feedback_component_wrapper)::in,
feedback_info::in, feedback_read_result(feedback_info)::out) is det.
add_feedback_components([], !.Info, Result) :-
Result = ok(!.Info).
add_feedback_components([Wrapper | Wrappers], !.Info, Result) :-
(
Wrapper = fcw_candidate_parallel_conjunctions(Candidates),
MaybeCandidates0 = !.Info ^ fi_maybe_candidate_parallel_conjunctions,
(
MaybeCandidates0 = no,
!Info ^ fi_maybe_candidate_parallel_conjunctions
:= yes(Candidates),
add_feedback_components(Wrappers, !.Info, Result)
;
MaybeCandidates0 = yes(_),
Result = error(fre_repeated_component(
"candidate_parallel_conjunctions"))
)
).
%---------------------------------------------------------------------------%
%
% Writing feedback files.
%
write_feedback_file(Path, Feedback, Result, !IO) :-
io.open_output(Path, PathResult, !IO),
(
PathResult = ok(PathStream),
actually_write_feedback_file(PathStream, Feedback, !IO),
io.close_output(PathStream, !IO),
Result = fwr_ok
;
PathResult = error(ErrorCode),
Result = fwr_open_error(ErrorCode)
).
% Write out the data. This is called by try_io to catch any exceptions
% that close_output and the other predicates we call here (e.g. io.write)
% may throw.
% XXX This should NOT be necessary.
%
:- pred actually_write_feedback_file(io.text_output_stream::in,
feedback_info::in, io::di, io::uo) is det.
actually_write_feedback_file(Stream, FeedbackInfo, !IO) :-
FeedbackInfo = feedback_info(ProfiledProgramName,
MaybeCandidateParallelConjs),
io.format(Stream, "%s\n%s\n%s\n",
[s(feedback_first_line), s(feedback_version), s(ProfiledProgramName)],
!IO),
% In the future, we expect to support more than one kind of feedback.
some [!RevComponents] (
!:RevComponents = [],
(
MaybeCandidateParallelConjs = no
;
MaybeCandidateParallelConjs = yes(Candidates),
CandComponent = fcw_candidate_parallel_conjunctions(Candidates),
!:RevComponents = [CandComponent | !.RevComponents]
),
list.reverse(!.RevComponents, Components)
),
% XXX See the comment on the corresponding io.read above.
io.write(Stream, Components, !IO),
io.write_string(Stream, ".\n", !IO).
%---------------------------------------------------------------------------%
%
% The identifying marks of feedback files.
%
:- func feedback_first_line = string.
feedback_first_line = "Mercury Compiler Feedback".
:- func feedback_version = string.
feedback_version = "19".
%---------------------------------------------------------------------------%
:- end_module mdbcomp.feedback.
%---------------------------------------------------------------------------%