%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2001, 2004-2011 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: read_profile.m. % Authors: conway, zs. % % This module contains code for reading in a deep profiling data file. % Such files, named Deep.data, are created by deep profiled executables. % %---------------------------------------------------------------------------% :- module read_profile. :- interface. :- import_module profile. :- import_module io. :- import_module maybe. :- pred read_call_graph(string::in, maybe_error(initial_deep)::out, io::di, io::uo) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module array_util. :- import_module io_combinator. :- import_module measurements. :- import_module mdbcomp. :- import_module mdbcomp.goal_path. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.program_representation. :- import_module assoc_list. :- import_module array. :- import_module bool. :- import_module char. :- import_module int. :- import_module list. :- import_module pair. :- import_module require. :- import_module string. %---------------------------------------------------------------------------% :- type maybe_error2(T1, T2) ---> ok2(T1, T2) ; error2(string). :- type ptr_kind ---> ps ; pd ; css ; csd. read_call_graph(FileName, MaybeInitDeep, !IO) :- io.open_binary_input(FileName, OpenResult, !IO), ( OpenResult = ok(FileStream), read_deep_id_string(FileStream, MaybeVersionNumber, !IO), ( MaybeVersionNumber = ok(_VersionNumber), % In the future, we could use different code to read in % profiling data files with different version numbers. io_combinator.maybe_error_sequence_11( read_string(FileStream), read_fixed_size_int(FileStream), read_fixed_size_int(FileStream), read_fixed_size_int(FileStream), read_fixed_size_int(FileStream), read_fixed_size_int(FileStream), read_num(FileStream), read_num(FileStream), read_num(FileStream), read_num(FileStream), read_ptr(FileStream, pd), maybe_init_deep, MaybeInitDeepHeader, !IO), ( MaybeInitDeepHeader = ok(InitDeep), % When we implement compression of data files, we would % want to pipe the rest of the input stream through the % decompression mechanism. read_nodes(FileStream, InitDeep, MaybeInitDeep, !IO) ; MaybeInitDeepHeader = error(Error), MaybeInitDeep = error(Error) ) ; MaybeVersionNumber = error(Msg), MaybeInitDeep = error(Msg) ), io.close_binary_input(FileStream, !IO) ; OpenResult = error(Error), io.error_message(Error, Msg), MaybeInitDeep = error(Msg) ). :- pred read_deep_id_string(io.binary_input_stream::in, maybe_error(int)::out, io::di, io::uo) is det. read_deep_id_string(InputStream, MaybeVersionNumber, !IO) :- % The 10 extra chars should be ample for the version number and newline. FirstLineLenLimit = string.length(deep_id_prefix) + 10, read_line(InputStream, FirstLineLenLimit, MaybeLine, !IO), ( MaybeLine = ok(Line0), Line = string.chomp(Line0), ( if string.append(deep_id_prefix, Suffix, Line), string.to_int(Suffix, VersionNumber) then ( if acceptable_version(VersionNumber) then MaybeVersionNumber = ok(VersionNumber) else MaybeVersionNumber = error("version number mismatch") ) else MaybeVersionNumber = error("not a deep profiling data file") ) ; MaybeLine = error(Error), MaybeVersionNumber = error(Error) ). % Return the constant prefix of the string identifying a file % as a deep profiling data file. The first line of a profiling data file % should contain this prefix and the version number of format used by the % file. % % This string must match the string written by the function % MR_write_out_deep_id_string in runtime/mercury_deep_profiling.c. % :- func deep_id_prefix = string. deep_id_prefix = "Mercury deep profiler data version ". :- pred acceptable_version(int::in) is semidet. acceptable_version(8). % Strip the directory paths off the given string. % % basename("/bin/ls") = "ls" % :- func basename(string) = string. basename(Path) = Base :- string.to_char_list(Path, PathChars), basename_chars(PathChars, MaybeBaseChars), ( MaybeBaseChars = no, BaseChars = PathChars ; MaybeBaseChars = yes(BaseChars) ), string.from_char_list(BaseChars, Base). :- pred basename_chars(list(char)::in, maybe(list(char))::out) is det. basename_chars([], no). basename_chars([Char | Chars], MaybeChars) :- basename_chars(Chars, MaybeTailChars), ( MaybeTailChars = yes(_), MaybeChars = MaybeTailChars ; MaybeTailChars = no, ( if path_separator(Char) then MaybeChars = yes(Chars) else MaybeChars = no ) ). :- pred path_separator(char::in) is semidet. path_separator('/'). path_separator('\\'). :- pred maybe_init_deep(string::in, int::in, int::in, int::in, int::in, int::in, int::in, int::in, int::in, int::in, int::in, maybe_error(initial_deep)::out) is det. maybe_init_deep(ProgName, FlagsInt, MaxCSD, MaxCSS, MaxPD, MaxPS, TicksPerSec, InstrumentQuanta, UserQuanta, NumCallSeqs, RootPDI, MaybeInitDeep) :- maybe_deep_flags(FlagsInt, MaybeFlags), ( MaybeFlags = ok(Flags), InitStats = profile_stats(ProgName, MaxCSD, MaxCSS, MaxPD, MaxPS, TicksPerSec, InstrumentQuanta, UserQuanta, NumCallSeqs, Flags), InitDeep = initial_deep( InitStats, make_pdptr(RootPDI), array.init(MaxCSD + 1, call_site_dynamic( make_dummy_pdptr, make_dummy_pdptr, zero_own_prof_info )), array.init(MaxPD + 1, proc_dynamic(make_dummy_psptr, array([]), no)), array.init(MaxCSS + 1, call_site_static( make_dummy_psptr, -1, normal_call_and_callee(make_dummy_psptr, ""), -1, rgp_nil )), array.init(MaxPS + 1, proc_static(dummy_proc_id, "", "", "", "", "", -1, no, array([]), array([]), no, not_zeroed)) ), MaybeInitDeep = ok(InitDeep) ; MaybeFlags = error(Error), MaybeInitDeep = error(Error) ). :- pred maybe_deep_flags(int::in, maybe_error(deep_flags)::out) is det. maybe_deep_flags(FlagsInt, MaybeFlags) :- BytesPerInt = (FlagsInt /\ deep_flag_bytes_per_int_mask) >> deep_flag_bytes_per_int_shift, Canonical = (FlagsInt /\ deep_flag_canonical_mask) >> deep_flag_canonical_shift, Compression = (FlagsInt /\ deep_flag_compression_mask) >> deep_flag_compression_shift, Coverage = (FlagsInt /\ deep_flag_coverage_mask) >> deep_flag_coverage_shift, ( if ( Canonical = 0, CanonicalFlag = maybe_not_canonical ; Canonical = 1, CanonicalFlag = is_canonical ), ( Compression = 0, CompressionFlag = no_compression % There is no compression alternative yet ), ( Coverage = 0, CoverageFlag = no_coverage_data ; Coverage = 1, CoverageFlag = static_coverage_data ; Coverage = 2, CoverageFlag = dynamic_coverage_data ), 0 = ((\ deep_flag_all_fields_mask) /\ FlagsInt) then MaybeFlags = ok(deep_flags(BytesPerInt, CanonicalFlag, CompressionFlag, CoverageFlag)) else MaybeFlags = error( string.format("Error parsing flags in file header, flags are 0x%x", [i(FlagsInt)])) ). % Flags masks and shifts. % The following line provides a ruler to line up the hexadecimal values % with. % % 48 32 16 0 % % Bytes_per_int occupies the bottom 8 bits, bit 0 to 7. % The canonical flag occupies the next 2 bits, bit 8 to 9. % The compression flag occupies the next 2 bits, bit 10 to 11. % The coverage indication occupies the next 2 bits, bit 12 to 13. % % Some of these have more bits than they currently need, in order to % accommodate possible future growth. :- func deep_flag_bytes_per_int_mask = int. deep_flag_bytes_per_int_mask = 0x00000000000000FF. :- func deep_flag_bytes_per_int_shift = int. deep_flag_bytes_per_int_shift = 0. :- func deep_flag_canonical_mask = int. deep_flag_canonical_mask = 0x0000000000000300. :- func deep_flag_canonical_shift = int. deep_flag_canonical_shift = 8. :- func deep_flag_compression_mask = int. deep_flag_compression_mask = 0x0000000000000C00. :- func deep_flag_compression_shift = int. deep_flag_compression_shift = 10. :- func deep_flag_coverage_mask = int. deep_flag_coverage_mask = 0x0000000000003000. :- func deep_flag_coverage_shift = int. deep_flag_coverage_shift = 12. :- func deep_flag_all_fields_mask = int. deep_flag_all_fields_mask = deep_flag_bytes_per_int_mask \/ deep_flag_canonical_mask \/ deep_flag_compression_mask \/ deep_flag_coverage_mask. :- pred read_nodes(io.binary_input_stream::in, initial_deep::in, maybe_error(initial_deep)::out, io::di, io::uo) is det. read_nodes(InputStream, InitDeep0, MaybeInitDeep, !IO) :- % Wrap the real function inside another loop. This strategy ensures that % this code works in grades that lack tail recursion, such as debugging % grades. read_nodes_2 will return after it has exceeded a depth limit, % unwinding its stack. The outer loop will continue as long as read_nodes_2 % thinks that more work remains. % % The depth of 50,000 has been chosen as it is roughly less than half the % stack depth that causes crashes during debugging. read_nodes_2(InputStream, 50000, InitDeep0, MaybeInitDeep0, !IO), ( MaybeInitDeep0 = init_deep_complete(InitDeep), MaybeInitDeep = ok(InitDeep) ; MaybeInitDeep0 = error(Error), MaybeInitDeep = error(Error) ; MaybeInitDeep0 = init_deep_incomplete(InitDeep1), read_nodes(InputStream, InitDeep1, MaybeInitDeep, !IO) ). :- type maybe_init_deep_complete ---> init_deep_complete(initial_deep) ; init_deep_incomplete(initial_deep) ; error(string). :- pred read_nodes_2(io.binary_input_stream::in, int::in, initial_deep::in, maybe_init_deep_complete::out, io::di, io::uo) is det. read_nodes_2(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) :- ( if Depth < 1 then MaybeInitDeep = init_deep_incomplete(!.InitDeep) else read_nodes_3(InputStream, Depth - 1, !.InitDeep, MaybeInitDeep, !IO) ). :- pred read_nodes_3(io.binary_input_stream::in, int::in, initial_deep::in, maybe_init_deep_complete::out, io::di, io::uo) is det. read_nodes_3(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) :- ProfileStats = !.InitDeep ^ init_profile_stats, read_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if is_next_item_token(Byte, NextItem) then ( NextItem = deep_item_call_site_dynamic, read_call_site_dynamic(InputStream, MaybeCSD, !IO), ( MaybeCSD = ok2(CallSiteDynamic, CSDI), CSDs0 = !.InitDeep ^ init_call_site_dynamics, deep_insert(CSDs0, CSDI, CallSiteDynamic, CSDs), !InitDeep ^ init_call_site_dynamics := CSDs, read_nodes_2(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) ; MaybeCSD = error2(Error), MaybeInitDeep = error(Error) ) ; NextItem = deep_item_proc_dynamic, read_proc_dynamic(InputStream, ProfileStats, MaybePD, !IO), ( MaybePD = ok2(ProcDynamic, PDI), PDs0 = !.InitDeep ^ init_proc_dynamics, deep_insert(PDs0, PDI, ProcDynamic, PDs), !InitDeep ^ init_proc_dynamics := PDs, read_nodes_2(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) ; MaybePD = error2(Error), MaybeInitDeep = error(Error) ) ; NextItem = deep_item_call_site_static, read_call_site_static(InputStream, MaybeCSS, !IO), ( MaybeCSS = ok({CallSiteStatic, CSSI}), CSSs0 = !.InitDeep ^ init_call_site_statics, deep_insert(CSSs0, CSSI, CallSiteStatic, CSSs), !InitDeep ^ init_call_site_statics := CSSs, read_nodes_2(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) ; MaybeCSS = error(Error), MaybeInitDeep = error(Error) ) ; NextItem = deep_item_proc_static, read_proc_static(InputStream, ProfileStats, MaybePS, !IO), ( MaybePS = ok2(ProcStatic, PSI), PSs0 = !.InitDeep ^ init_proc_statics, deep_insert(PSs0, PSI, ProcStatic, PSs), !InitDeep ^ init_proc_statics := PSs, read_nodes_2(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) ; MaybePS = error2(Error), MaybeInitDeep = error(Error) ) ; NextItem = deep_item_end, MaybeInitDeep = init_deep_complete(!.InitDeep) ) else string.format("unexpected token %d", [i(Byte)], Msg), MaybeInitDeep = error(Msg) ) ; MaybeByte = eof, % XXX: Shouldn't this be an error since there's a deep_item_end token? MaybeInitDeep = init_deep_complete(!.InitDeep) ; MaybeByte = error(Error), io.error_message(Error, Msg), MaybeInitDeep = error(Msg) ). :- pred read_call_site_static(io.binary_input_stream::in, maybe_error({call_site_static, int})::out, io::di, io::uo) is det. read_call_site_static(InputStream, MaybeCSS, !IO) :- trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "reading call_site_static.\n", !TIO) ), io_combinator.maybe_error_sequence_4( read_ptr(InputStream, css), read_call_site_kind_and_callee(InputStream), read_num(InputStream), read_string(InputStream), ( pred(CSSI0::in, Kind::in, LineNumber::in, GoalPathStr::in, CSS::out) is det :- DummyPSPtr = make_dummy_psptr, DummySlotNum = -1, rev_goal_path_from_string_det(GoalPathStr, RevGoalPath0), rev_goal_path_remove_type_info(RevGoalPath0, RevGoalPath), CallSiteStatic0 = call_site_static(DummyPSPtr, DummySlotNum, Kind, LineNumber, RevGoalPath), CSS = ok({CallSiteStatic0, CSSI0}) ), MaybeCSS, !IO), ( MaybeCSS = ok({CallSiteStatic, CSSI}), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.format(OutputStream, "read call_site_static %d:", [i(CSSI)], !TIO), io.write(OutputStream, CallSiteStatic, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeCSS = error(_) ). :- pred read_proc_static(io.binary_input_stream::in, profile_stats::in, maybe_error2(proc_static, int)::out, io::di, io::uo) is det. read_proc_static(InputStream, ProfileStats, MaybePS, !IO) :- trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "reading proc_static.\n", !TIO) ), io_combinator.maybe_error_sequence_6( read_ptr(InputStream, ps), read_proc_id(InputStream), read_string(InputStream), read_num(InputStream), read_deep_byte(InputStream), read_num(InputStream), ( pred(PSI0::in, Id0::in, F0::in, L0::in, I0::in, NCS0::in, ProcId::out) is det :- ProcId = ok({PSI0, Id0, F0, L0, I0, NCS0}) ), MaybeProcId, !IO), ( MaybeProcId = ok({PSI, Id, FileName, LineNumber, Interface, NCS}), read_n_things(NCS, read_ptr(InputStream, css), MaybeCSSIs, !IO), ( MaybeCSSIs = ok(CSSIs), maybe_read_ps_coverage_points(InputStream, ProfileStats, MaybeCoveragePoints, !IO), ( MaybeCoveragePoints = ok(CPInfos - MaybeCPs), CSSPtrs = list.map(make_cssptr, CSSIs), DeclModule = decl_module(Id), create_refined_proc_ids(Id, UnQualRefinedStr, QualRefinedStr), RawStr = raw_proc_id_to_string(Id), ( if Interface = 0 then IsInInterface = no else IsInInterface = yes ), % The `not_zeroed' for whether the procedure's proc_static % is ever zeroed is the default. The startup phase will set it % to `zeroed' in the proc_statics which are ever zeroed. ProcStatic = proc_static(Id, DeclModule, UnQualRefinedStr, QualRefinedStr, RawStr, FileName, LineNumber, IsInInterface, array(CSSPtrs), CPInfos, MaybeCPs, not_zeroed), MaybePS = ok2(ProcStatic, PSI), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.format(OutputStream, "read proc_static %d:", [i(PSI)], !TIO), io.write(OutputStream, ProcStatic, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeCoveragePoints = error(Error), MaybePS = error2(Error) ) ; MaybeCSSIs = error(Error), MaybePS = error2(Error) ) ; MaybeProcId = error(Error), MaybePS = error2(Error) ). :- pred maybe_read_ps_coverage_points(io.binary_input_stream::in, profile_stats::in, maybe_error(pair(array(coverage_point_info), maybe(array(int))))::out, io::di, io::uo) is det. maybe_read_ps_coverage_points(InputStream, ProfileStats, MaybeCoveragePoints, !IO) :- CoverageDataType = ProfileStats ^ prs_deep_flags ^ df_coverage_data_type, ( CoverageDataType = no_coverage_data, MaybeCoveragePoints0 = ok([] - no) ; ( CoverageDataType = static_coverage_data ; CoverageDataType = dynamic_coverage_data ), read_num(InputStream, MaybeNCP, !IO), ( MaybeNCP = ok(NCP), ( CoverageDataType = static_coverage_data, read_n_things(NCP, read_coverage_point_static_and_num(InputStream), MaybeCPPairs, !IO), ( MaybeCPPairs = ok(CPPairs), keys_and_values(CPPairs, CPInfos, CPs), MaybeCoveragePoints0 = ok(CPInfos - yes(CPs)) ; MaybeCPPairs = error(Error0), MaybeCoveragePoints0 = error(Error0) ) ; CoverageDataType = dynamic_coverage_data, read_n_things(NCP, read_coverage_point_static(InputStream), MaybeCPInfos, !IO), ( MaybeCPInfos = ok(CPInfos), MaybeCoveragePoints0 = ok(CPInfos - no) ; MaybeCPInfos = error(Error0), MaybeCoveragePoints0 = error(Error0) ) ) ; MaybeNCP = error(Error0), MaybeCoveragePoints0 = error(Error0) ) ), ( MaybeCoveragePoints0 = ok(CPInfosList - MaybeCPsList), CPInfosArray = array(CPInfosList), MaybeCPsArray = map_maybe(array, MaybeCPsList), MaybeCoveragePoints = ok(CPInfosArray - MaybeCPsArray) ; MaybeCoveragePoints0 = error(Error), MaybeCoveragePoints = error(Error) ). :- pred maybe_read_pd_coverage_points(io.binary_input_stream::in, profile_stats::in, maybe_error(maybe(array(int)))::out, io::di, io::uo) is det. maybe_read_pd_coverage_points(InputStream, ProfileStats, MaybeCoveragePoints, !IO) :- CoverageDataType = ProfileStats ^ prs_deep_flags ^ df_coverage_data_type, ( ( CoverageDataType = no_coverage_data ; CoverageDataType = static_coverage_data ), MaybeCoveragePoints = ok(no) ; CoverageDataType = dynamic_coverage_data, read_num(InputStream, ResN, !IO), ( ResN = ok(N), read_n_things(N, read_num(InputStream), MaybeCPs, !IO), ( MaybeCPs = ok(CPsList), MaybeCoveragePoints = ok(yes(array(CPsList))) ; MaybeCPs = error(Error), MaybeCoveragePoints = error(Error) ) ; ResN = error(Error), MaybeCoveragePoints = error(Error) ) ). :- pred read_proc_id(io.binary_input_stream::in, maybe_error(string_proc_label)::out, io::di, io::uo) is det. read_proc_id(InputStream, MaybeProcId, !IO) :- read_deep_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if is_proclabel_kind(Byte, ProcLabelKind) then ( ProcLabelKind = proclabel_special, read_proc_id_uci_pred(InputStream, MaybeProcId, !IO) ; ProcLabelKind = proclabel_user_predicate, read_proc_id_user_defined(InputStream, pf_predicate, MaybeProcId, !IO) ; ProcLabelKind = proclabel_user_function, read_proc_id_user_defined(InputStream, pf_function, MaybeProcId, !IO) ) else string.format("unexpected proclabel_kind %d", [i(Byte)], Msg), MaybeProcId = error(Msg) ) ; MaybeByte = error(Error), MaybeProcId = error(Error) ). :- pred read_proc_id_uci_pred(io.binary_input_stream::in, maybe_error(string_proc_label)::out, io::di, io::uo) is det. read_proc_id_uci_pred(InputStream, MaybeProcLabel, !IO) :- io_combinator.maybe_error_sequence_6( read_string(InputStream), read_string(InputStream), read_string(InputStream), read_string(InputStream), read_num(InputStream), read_num(InputStream), ( pred(TypeName::in, TypeModule::in, DefModule::in, PredName::in, Arity::in, Mode::in, ProcId::out) is det :- ProcId = ok(str_special_proc_label(TypeName, TypeModule, DefModule, PredName, Arity, Mode)) ), MaybeProcLabel, !IO). :- pred read_proc_id_user_defined(io.binary_input_stream::in, pred_or_func::in, maybe_error(string_proc_label)::out, io::di, io::uo) is det. read_proc_id_user_defined(InputStream, PredOrFunc, MaybeProcLabel, !IO) :- io_combinator.maybe_error_sequence_5( read_string(InputStream), read_string(InputStream), read_string(InputStream), read_num(InputStream), read_num(InputStream), ( pred(DeclModule::in, DefModule::in, Name::in, Arity::in, Mode::in, ProcId::out) is det :- ProcId = ok(str_ordinary_proc_label(PredOrFunc, DeclModule, DefModule, Name, Arity, Mode)) ), MaybeProcLabel, !IO). % Read the description of a coverage point, and its execution count. % % The description of a coverage point is stored in the proc static % regardless of whether we are using static or dynamic coverage profiling. % If we are using static coverage profiling, then this description will be % immediately followed in the profiling data file by the number of times % that the coverage point was executed. % :- pred read_coverage_point_static_and_num(io.binary_input_stream::in, maybe_error(pair(coverage_point_info, int))::out, io::di, io::uo) is det. read_coverage_point_static_and_num(InputStream, MaybeCP, !IO) :- io_combinator.maybe_error_sequence_2( read_coverage_point_static(InputStream), read_num(InputStream), ( pred(CPInfo::in, Count::in, ok(CPI)::out) is det :- CPI = CPInfo - Count ), MaybeCP, !IO). % Read the description of a coverage point. % % The description of a coverage point is stored in the proc static % regardless of whether we are using static or dynamic coverage profiling. % :- pred read_coverage_point_static(io.binary_input_stream::in, maybe_error(coverage_point_info)::out, io::di, io::uo) is det. read_coverage_point_static(InputStream, MaybeCP, !IO) :- io_combinator.maybe_error_sequence_2( read_string(InputStream), read_cp_type(InputStream), ( pred(GoalPathString::in, CPType::in, MaybeCPI::out) is det :- rev_goal_path_from_string_det(GoalPathString, RevGoalPath0), rev_goal_path_remove_type_info(RevGoalPath0, RevGoalPath), MaybeCPI = ok(coverage_point_info(RevGoalPath, CPType)) ), MaybeCP, !IO). :- func raw_proc_id_to_string(string_proc_label) = string. raw_proc_id_to_string(str_special_proc_label(TypeName, TypeModule, _DefModule, PredName, Arity, Mode)) = string.append_list( [PredName, " for ", TypeModule, ".", TypeName, "/", string.int_to_string(Arity), " mode ", string.int_to_string(Mode)]). raw_proc_id_to_string(str_ordinary_proc_label(PredOrFunc, DeclModule, _DefModule, Name, Arity, Mode)) = string.append_list([DeclModule, ".", Name, "/", string.int_to_string(Arity), add_plus_one_for_function(PredOrFunc), "-", string.int_to_string(Mode)]). :- pred create_refined_proc_ids(string_proc_label::in, string::out, string::out) is det. create_refined_proc_ids(ProcLabel, UnQualName, QualName) :- ( ProcLabel = str_special_proc_label(TypeName, TypeModule, _DefModule, RawPredName, Arity, Mode), ( if RawPredName = "__Unify__" then PredName = "Unify" else if RawPredName = "__Compare__" then PredName = "Compare" else if RawPredName = "__CompareRep__" then PredName = "CompareRep" else if RawPredName = "__Index__" then PredName = "Index" else Msg = "unknown special predicate name " ++ RawPredName, error(Msg) ), Prefix = PredName ++ " for ", AritySuffix = "/" ++ string.int_to_string(Arity), UnQualName0 = Prefix ++ TypeName ++ AritySuffix, QualName0 = Prefix ++ TypeModule ++ "." ++ TypeName ++ AritySuffix, ( if Mode = 0 then UnQualName = UnQualName0, QualName = QualName0 else ModeSuffix = " mode " ++ int_to_string(Mode), UnQualName = UnQualName0 ++ ModeSuffix, QualName = QualName0 ++ ModeSuffix ) ; ProcLabel = str_ordinary_proc_label(PredOrFunc, DeclModule, _DefModule, ProcName, Arity, Mode), ( if string.append("TypeSpecOf__", ProcName1, ProcName), ( if string.append("pred__", ProcName2A, ProcName1) then ProcName2 = ProcName2A else if string.append("func__", ProcName2B, ProcName1) then ProcName2 = ProcName2B else if string.append("pred_or_func__", ProcName2C, ProcName1) then ProcName2 = ProcName2C else error("typespec: neither pred nor func") ), string.to_char_list(ProcName2, ProcName2Chars), fix_type_spec_suffix(ProcName2Chars, ProcNameChars, SpecInfo) then RefinedProcName = string.from_char_list(ProcNameChars), Suffix = "/" ++ string.int_to_string(Arity) ++ add_plus_one_for_function(PredOrFunc) ++ "-" ++ string.int_to_string(Mode) ++ " [" ++ SpecInfo ++ "]", UnQualName = RefinedProcName ++ Suffix, QualName = DeclModule ++ "." ++ RefinedProcName ++ Suffix else if string.append("IntroducedFrom__", ProcName1, ProcName), ( if string.append("pred__", ProcName2A, ProcName1) then ProcName2 = ProcName2A else if string.append("func__", ProcName2B, ProcName1) then ProcName2 = ProcName2B else error("lambda: neither pred nor func") ), string.to_char_list(ProcName2, ProcName2Chars), split_lambda_name(ProcName2Chars, Segments), glue_lambda_name(Segments, ContainingNameChars, LineNumberChars) then string.from_char_list(ContainingNameChars, ContainingName), string.from_char_list(LineNumberChars, LineNumber), Suffix = " lambda line " ++ LineNumber ++ "/" ++ string.int_to_string(Arity) ++ add_plus_one_for_function(PredOrFunc), UnQualName = ContainingName ++ Suffix, QualName = DeclModule ++ "." ++ ContainingName ++ Suffix else Suffix = "/" ++ string.int_to_string(Arity) ++ add_plus_one_for_function(PredOrFunc) ++ "-" ++ string.int_to_string(Mode), UnQualName = ProcName ++ Suffix, QualName = DeclModule ++ "." ++ ProcName ++ Suffix ) ). :- func add_plus_one_for_function(pred_or_func) = string. add_plus_one_for_function(pf_function) = "+1". add_plus_one_for_function(pf_predicate) = "". :- pred fix_type_spec_suffix(list(char)::in, list(char)::out, string::out) is semidet. fix_type_spec_suffix(Chars0, Chars, SpecInfoStr) :- ( if Chars0 = ['_', '_', '[' | SpecInfo0 ] then Chars = [], list.take_while(non_right_bracket, SpecInfo0, SpecInfo), string.from_char_list(SpecInfo, SpecInfoStr) else if Chars0 = [Char | TailChars0] then fix_type_spec_suffix(TailChars0, TailChars, SpecInfoStr), Chars = [Char | TailChars] else fail ). :- pred non_right_bracket(char::in) is semidet. non_right_bracket(C) :- C \= ']'. :- pred split_lambda_name(list(char)::in, list(list(char))::out) is det. split_lambda_name([], []). split_lambda_name([Char0 | Chars0], StringList) :- ( if Chars0 = ['_', '_' | Chars1 ] then split_lambda_name(Chars1, StringList0), StringList = [[Char0] | StringList0] else split_lambda_name(Chars0, StringList0), ( StringList0 = [], StringList = [[Char0]] ; StringList0 = [String0 | StringList1], StringList = [[Char0 | String0] | StringList1] ) ). :- pred glue_lambda_name(list(list(char))::in, list(char)::out, list(char)::out) is semidet. glue_lambda_name(Segments, PredName, LineNumber) :- ( if Segments = [LineNumberPrime, _] then PredName = [], LineNumber = LineNumberPrime else if Segments = [Segment | TailSegments] then glue_lambda_name(TailSegments, PredName1, LineNumber), ( PredName1 = [], PredName = Segment ; PredName1 = [_ | _], list.append(Segment, ['_', '_' | PredName1], PredName) ) else fail ). :- pred read_proc_dynamic(io.binary_input_stream::in, profile_stats::in, maybe_error2(proc_dynamic, int)::out, io::di, io::uo) is det. read_proc_dynamic(InputStream, ProfileStats, MaybePD, !IO) :- trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "reading proc_dynamic.\n", !TIO) ), io_combinator.maybe_error_sequence_3( read_ptr(InputStream, pd), read_ptr(InputStream, ps), read_num(InputStream), ( pred(PDI0::in, PSI0::in, N0::in, Stuff0::out) is det :- Stuff0 = ok({PDI0, PSI0, N0}) ), MaybePDHeader, !IO), ( MaybePDHeader = ok({PDI, PSI, N}), io_combinator.maybe_error_sequence_2( maybe_read_pd_coverage_points(InputStream, ProfileStats), read_n_things(N, read_call_site_slot(InputStream)), ( pred(MaybeCPs0::in, Slots0::in, CPsAndSlots0::out) is det :- CPsAndSlots0 = ok({MaybeCPs0, Slots0}) ), MaybeCPsAndSlots, !IO), ( MaybeCPsAndSlots = ok({MaybeCPs, Refs}), PSPtr = make_psptr(PSI), ProcDynamic = proc_dynamic(PSPtr, array(Refs), MaybeCPs), MaybePD = ok2(ProcDynamic, PDI), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.format(OutputStream, "read proc_dynamic %d:", [i(PDI)], !TIO), io.write(OutputStream, ProcDynamic, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeCPsAndSlots = error(Error), MaybePD = error2(Error) ) ; MaybePDHeader = error(Error), MaybePD = error2(Error) ). :- pred read_call_site_dynamic(io.binary_input_stream::in, maybe_error2(call_site_dynamic, int)::out, io::di, io::uo) is det. read_call_site_dynamic(InputStream, MaybeCSD, !IO) :- trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "reading call_site_dynamic.\n", !TIO) ), read_ptr(InputStream, csd, MaybeCSDI, !IO), ( MaybeCSDI = ok(CSDI), read_ptr(InputStream, pd, MaybePDI, !IO), ( MaybePDI = ok(PDI), read_profile(InputStream, MaybeProfile, !IO), ( MaybeProfile = ok(Profile), PDPtr = make_pdptr(PDI), CallerPDPtr = make_dummy_pdptr, CallSiteDynamic = call_site_dynamic(CallerPDPtr, PDPtr, Profile), MaybeCSD = ok2(CallSiteDynamic, CSDI), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.format(OutputStream, "read call_site_dynamic %d: ", [i(CSDI)], !TIO), io.write(OutputStream, CallSiteDynamic, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeProfile = error(Error), MaybeCSD = error2(Error) ) ; MaybePDI = error(Error), MaybeCSD = error2(Error) ) ; MaybeCSDI = error(Error), MaybeCSD = error2(Error) ). :- pred read_profile(io.binary_input_stream::in, maybe_error(own_prof_info)::out, io::di, io::uo) is det. read_profile(InputStream, MaybeProfile, !IO) :- read_num(InputStream, MaybeMask, !IO), ( MaybeMask = ok(Mask), % The masks here must correspond exactly with the masks in % MR_write_out_call_site_dynamic in mercury_deep_profiling.c % in the runtime. some [!MaybeError] ( !:MaybeError = no, % We normally assume that the configuration macro % MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS is not % defined, and thus mercury_deep_profiling.m never % writes out call counts (instead, call counts are % computed from other port counts in measurements.m). % maybe_read_num_handle_error(Mask, 0x0001, Calls, % !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0002, Exits, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0004, Fails, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0040, Redos, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0080, Excps, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0100, Quanta, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0008, CallSeqs, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0010, Allocs, !MaybeError, !IO), maybe_read_num_handle_error(InputStream, Mask, 0x0020, Words, !MaybeError, !IO), LastMaybeError = !.MaybeError ), ( LastMaybeError = yes(Error), MaybeProfile = error(Error) ; LastMaybeError = no, MaybeProfile = ok(compress_profile(Exits, Fails, Redos, Excps, Quanta, CallSeqs, Allocs, Words)) ) ; MaybeMask = error(Error), MaybeProfile = error(Error) ). :- pred maybe_read_num_handle_error(io.binary_input_stream::in, int::in, int::in, int::out, maybe(string)::in, maybe(string)::out, io::di, io::uo) is det. maybe_read_num_handle_error(InputStream, MaskWord, MaskValue, Num, !MaybeError, !IO) :- ( if MaskWord /\ MaskValue \= 0 then read_num(InputStream, MaybeNum, !IO), ( MaybeNum = ok(Num) ; MaybeNum = error(Error), Num = 0, !:MaybeError = yes(Error) ) else Num = 0 ). :- pred read_call_site_slot(io.binary_input_stream::in, maybe_error(call_site_array_slot)::out, io::di, io::uo) is det. read_call_site_slot(InputStream, MaybeSlot, !IO) :- trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "reading call_site_slot.\n", !TIO) ), read_call_site_kind(InputStream, MaybeKind, !IO), ( MaybeKind = ok(Kind), ( Kind = normal_call, read_ptr(InputStream, csd, MaybeCSDI, !IO), ( MaybeCSDI = ok(CSDI), CSDPtr = make_csdptr(CSDI), MaybeSlot = ok(slot_normal(CSDPtr)), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "normal call_site slot ", !TIO), io.write_int(OutputStream, CSDI, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeCSDI = error(Error), MaybeSlot = error(Error) ) ; ( Kind = higher_order_call, Zeroed = zeroed ; Kind = method_call, Zeroed = zeroed ; Kind = special_call, Zeroed = not_zeroed ; Kind = callback, Zeroed = not_zeroed ), read_multi_call_site_csdis(InputStream, MaybeCSDIs, !IO), ( MaybeCSDIs = ok(CSDIs), CSDPtrs = list.map(make_csdptr, CSDIs), MaybeSlot = ok(slot_multi(Zeroed, array(CSDPtrs))), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "multi call_site slots ", !TIO), io.write(OutputStream, CSDIs, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeCSDIs = error(Error), MaybeSlot = error(Error) ) ) ; MaybeKind = error(Error), MaybeSlot = error(Error) ). :- pred read_multi_call_site_csdis(io.binary_input_stream::in, maybe_error(list(int))::out, io::di, io::uo) is det. read_multi_call_site_csdis(InputStream, MaybeCSDIs, !IO) :- read_multi_call_site_csdis_2(InputStream, [], MaybeCSDIs, !IO). % We keep reading CSD node numbers until we find a zero byte. % The reason why a zero byte works as a sentinel is that a CSD node % number in the list of CSD node numbers at a multi call site cannot be % zero, and our encoding scheme ensures that non-zero node numbers % cannot start with a zero byte. % % We return the list of CSD node numbers in the reversed order, but % this is OK because our caller does not pay attention to the order % anyway. :- pred read_multi_call_site_csdis_2(io.binary_input_stream::in, list(int)::in, maybe_error(list(int))::out, io::di, io::uo) is det. read_multi_call_site_csdis_2(InputStream, CSDIs0, MaybeCSDIs, !IO) :- trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.format(OutputStream, "reading multi_call_site_csdi.\n", [], !TIO) ), read_deep_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if Byte = 0 then MaybeCSDIs = ok(CSDIs0) else putback_byte(InputStream, Byte, !IO), read_ptr(InputStream, csd, MaybeCSDI, !IO), ( MaybeCSDI = ok(CSDI), read_multi_call_site_csdis_2(InputStream, [CSDI | CSDIs0], MaybeCSDIs, !IO) ; MaybeCSDI = error(Error), MaybeCSDIs = error(Error) ) ) ; MaybeByte = error(Error), MaybeCSDIs = error(Error) ). :- pred read_call_site_kind(io.binary_input_stream::in, maybe_error(call_site_kind)::out, io::di, io::uo) is det. read_call_site_kind(InputStream, MaybeKind, !IO) :- read_deep_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if is_call_site_kind(Byte, CallSiteKind) then MaybeKind = ok(CallSiteKind) else string.format("unexpected call_site_kind %d", [i(Byte)], Msg), MaybeKind = error(Msg) ), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "call_site_kind ", !TIO), io.write(OutputStream, MaybeKind, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeByte = error(Error), MaybeKind = error(Error) ). :- pred read_call_site_kind_and_callee(io.binary_input_stream::in, maybe_error(call_site_kind_and_callee)::out, io::di, io::uo) is det. read_call_site_kind_and_callee(InputStream, MaybeKindAndCallee, !IO) :- read_deep_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if is_call_site_kind(Byte, CallSiteKind) then ( CallSiteKind = normal_call, read_num(InputStream, MaybeCSS, !IO), ( MaybeCSS = ok(CalleeProcStatic), read_string(InputStream, MaybeTypeSubst, !IO), ( MaybeTypeSubst = ok(TypeSubst), MaybeKindAndCallee = ok(normal_call_and_callee( proc_static_ptr(CalleeProcStatic), TypeSubst)) ; MaybeTypeSubst = error(Error), MaybeKindAndCallee = error(Error) ) ; MaybeCSS = error(Error), MaybeKindAndCallee = error(Error) ) ; CallSiteKind = special_call, MaybeKindAndCallee = ok(special_call_and_no_callee) ; CallSiteKind = higher_order_call, MaybeKindAndCallee = ok(higher_order_call_and_no_callee) ; CallSiteKind = method_call, MaybeKindAndCallee = ok(method_call_and_no_callee) ; CallSiteKind = callback, MaybeKindAndCallee = ok(callback_and_no_callee) ) else string.format("unexpected call_site_kind %d", [i(Byte)], Msg), MaybeKindAndCallee = error(Msg) ), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "call_site_kind_and_callee ", !TIO), io.write(OutputStream, MaybeKindAndCallee, !TIO), io.write_string(OutputStream, "\n", !TIO) ) ; MaybeByte = error(Error), MaybeKindAndCallee = error(Error) ). %---------------------------------------------------------------------------% :- pred read_n_things(int::in, pred(maybe_error(T), io, io)::in(pred(out, di, uo) is det), maybe_error(list(T))::out, io::di, io::uo) is det. read_n_things(N, ItemReader, MaybeItems, !IO) :- read_n_things_loop(N, ItemReader, [], MaybeRevItems, !IO), ( MaybeRevItems = ok(RevItems), list.reverse(RevItems, Items), MaybeItems = ok(Items) ; MaybeRevItems = error(Error), MaybeItems = error(Error) ). :- pred read_n_things_loop(int::in, pred(maybe_error(T), io, io)::in(pred(out, di, uo) is det), list(T)::in, maybe_error(list(T))::out, io::di, io::uo) is det. read_n_things_loop(N, ItemReader, RevItems0, MaybeItems, !IO) :- ( if N =< 0 then MaybeItems = ok(RevItems0) else call(ItemReader, MaybeItem, !IO), ( MaybeItem = ok(Item), read_n_things_loop(N - 1, ItemReader, [Item | RevItems0], MaybeItems, !IO) ; MaybeItem = error(Error), MaybeItems = error(Error) ) ). %---------------------------------------------------------------------------% :- pred read_line(io.binary_input_stream::in, int::in, maybe_error(string)::out, io::di, io::uo) is det. read_line(InputStream, Limit, MaybeLine, !IO) :- read_line_acc(InputStream, Limit, [], MaybeLine, !IO). :- pred read_line_acc(io.binary_input_stream::in, int::in, list(char)::in, maybe_error(string)::out, io::di, io::uo) is det. read_line_acc(InputStream, Limit, !.RevChars, MaybeLine, !IO) :- ( if Limit > 0 then read_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), ( if char.to_int(Char, Byte) then % Include the newline in the string. !:RevChars = [Char | !.RevChars], ( if Char = '\n' then list.reverse(!.RevChars, Chars), string.from_char_list(Chars, Str), MaybeLine = ok(Str) else read_line_acc(InputStream, Limit - 1, !.RevChars, MaybeLine, !IO) ) else MaybeLine = error("unexpected end of file") ) ; MaybeByte = eof, MaybeLine = error("unexpected end of file") ; MaybeByte = error(Error), io.error_message(Error, Msg), MaybeLine = error(Msg) ) else list.reverse(!.RevChars, Chars), string.from_char_list(Chars, Str), MaybeLine = ok(Str) ). :- pred read_string(io.binary_input_stream::in, maybe_error(string)::out, io::di, io::uo) is det. read_string(InputStream, MaybeStr, !IO) :- read_num(InputStream, MaybeNum, !IO), ( MaybeNum = ok(Length), ( if Length = 0 then MaybeStr = ok("") else read_n_byte_string(InputStream, Length, MaybeStr, !IO) ) ; MaybeNum = error(Error), MaybeStr = error(Error) ). :- pred read_n_byte_string(io.binary_input_stream::in, int::in, maybe_error(string)::out, io::di, io::uo) is det. read_n_byte_string(InputStream, Length, MaybeStr, !IO) :- read_n_bytes(InputStream, Length, MaybeNBytes, !IO), ( MaybeNBytes = ok(Bytes), ( if list.map((pred(I::in, C::out) is semidet :- char.to_int(C, I)), Bytes, Chars) then string.from_char_list(Chars, Str), MaybeStr = ok(Str) else MaybeStr = error("string contained bad char") ) ; MaybeNBytes = error(Error), MaybeStr = error(Error) ), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "string ", !TIO), io.write(OutputStream, MaybeStr, !TIO), io.write_string(OutputStream, "\n", !TIO) ). :- pred read_ptr(io.binary_input_stream::in, ptr_kind::in, maybe_error(int)::out, io::di, io::uo) is det. read_ptr(InputStream, _Kind, MaybePtr, !IO) :- read_num(InputStream, MaybePtr, !IO), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "ptr ", !TIO), io.write(OutputStream, MaybePtr, !TIO), io.write_string(OutputStream, "\n", !TIO) ). :- pred read_cp_type(io.binary_input_stream::in, maybe_error(cp_type)::out, io::di, io::uo) is det. read_cp_type(InputStream, MaybeCPType, !IO) :- read_num(InputStream, MaybeNum, !IO), ( MaybeNum = ok(Num), num_to_cp_type(Num, CPType), MaybeCPType = ok(CPType) ; MaybeNum = error(Msg), MaybeCPType = error(Msg) ). :- pred num_to_cp_type(int::in, cp_type::out) is det. :- pragma foreign_proc("C", num_to_cp_type(Int::in, CPType::out), [will_not_call_mercury, thread_safe, promise_pure], " CPType = Int; "). :- pred read_num(io.binary_input_stream::in, maybe_error(int)::out, io::di, io::uo) is det. read_num(InputStream, MaybeNum, !IO) :- read_num_acc(InputStream, 0, MaybeNum, !IO), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "num ", !TIO), io.write(OutputStream, MaybeNum, !TIO), io.write_string(OutputStream, "\n", !TIO) ). :- pred read_num_acc(io.binary_input_stream::in, int::in, maybe_error(int)::out, io::di, io::uo) is det. read_num_acc(InputStream, Num0, MaybeNum, !IO) :- read_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), Num1 = (Num0 << 7) \/ (Byte /\ 0x7F), ( if Byte /\ 0x80 \= 0 then read_num_acc(InputStream, Num1, MaybeNum, !IO) else MaybeNum = ok(Num1) ) ; MaybeByte = eof, MaybeNum = error("unexpected end of file") ; MaybeByte = error(Error), io.error_message(Error, Msg), MaybeNum = error(Msg) ). :- func fixed_size_int_bytes = int. % Must correspond to MR_FIXED_SIZE_INT_BYTES % in runtime/mercury_deep_profiling.c. fixed_size_int_bytes = 8. :- pred read_fixed_size_int(io.binary_input_stream::in, maybe_error(int)::out, io::di, io::uo) is det. read_fixed_size_int(InputStream, MaybeInt, !IO) :- read_fixed_size_int_acc(InputStream, fixed_size_int_bytes, 0, 0, MaybeInt, !IO), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.format(OutputStream, "fixed size int %s\n", [s(string(MaybeInt))], !TIO) ). :- pred read_fixed_size_int_acc(io.binary_input_stream::in, int::in, int::in, int::in, maybe_error(int)::out, io::di, io::uo) is det. read_fixed_size_int_acc(InputStream, BytesLeft, Num0, ShiftBy, MaybeInt, !IO) :- ( if BytesLeft =< 0 then MaybeInt = ok(Num0) else read_deep_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), Num1 = Num0 \/ ( Byte << ShiftBy), read_fixed_size_int_acc(InputStream, BytesLeft - 1, Num1, ShiftBy + 8, MaybeInt, !IO) ; MaybeByte = error(Error), MaybeInt = error(Error) ) ). :- pred read_n_bytes(io.binary_input_stream::in, int::in, maybe_error(list(int))::out, io::di, io::uo) is det. read_n_bytes(InputStream, N, MaybeNBytes, !IO) :- read_n_bytes_acc(InputStream, N, [], MaybeRevNBytes, !IO), ( MaybeRevNBytes = ok(RevBytes), list.reverse(RevBytes, Bytes), MaybeNBytes = ok(Bytes) ; MaybeRevNBytes = error(Error), MaybeNBytes = error(Error) ). :- pred read_n_bytes_acc(io.binary_input_stream::in, int::in, list(int)::in, maybe_error(list(int))::out, io::di, io::uo) is det. read_n_bytes_acc(InputStream, N, RevBytes0, MaybeNBytes, !IO) :- ( if N =< 0 then MaybeNBytes = ok(RevBytes0) else read_deep_byte(InputStream, MaybeByte, !IO), ( MaybeByte = ok(Byte), read_n_bytes_acc(InputStream, N - 1, [Byte | RevBytes0], MaybeNBytes, !IO) ; MaybeByte = error(Error), MaybeNBytes = error(Error) ) ). :- pred read_deep_byte(io.binary_input_stream::in, maybe_error(int)::out, io::di, io::uo) is det. read_deep_byte(InputStream, MaybeByte, !IO) :- read_byte(InputStream, MaybeRawByte, !IO), ( MaybeRawByte = ok(Byte), MaybeByte = ok(Byte) ; MaybeRawByte = eof, MaybeByte = error("unexpected end of file") ; MaybeRawByte = error(Error), io.error_message(Error, Msg), MaybeByte = error(Msg) ), trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] ( io.output_stream(OutputStream, !TIO), io.write_string(OutputStream, "byte ", !TIO), io.write(OutputStream, MaybeByte, !TIO), io.write_string(OutputStream, "\n", !TIO) ). %---------------------------------------------------------------------------% :- pred deep_insert(array(T)::in, int::in, T::in, array(T)::out) is det. deep_insert(A0, Ind, Item, A) :- array.max(A0, Max), ( if Ind > Max then error("deep_insert: array bounds violation") % array.lookup(A0, 0, X), % array.resize(u(A0), 2 * (Max + 1), X, A1), % deep_insert(A1, Ind, Item, A) else set(Ind, Item, u(A0), A) ). %---------------------------------------------------------------------------% :- func make_csdptr(int) = call_site_dynamic_ptr. :- func make_cssptr(int) = call_site_static_ptr. :- func make_pdptr(int) = proc_dynamic_ptr. :- func make_psptr(int) = proc_static_ptr. make_csdptr(CSDI) = call_site_dynamic_ptr(CSDI). make_cssptr(CSSI) = call_site_static_ptr(CSSI). make_pdptr(PDI) = proc_dynamic_ptr(PDI). make_psptr(PSI) = proc_static_ptr(PSI). :- func make_dummy_csdptr = call_site_dynamic_ptr. :- func make_dummy_cssptr = call_site_static_ptr. :- func make_dummy_pdptr = proc_dynamic_ptr. :- func make_dummy_psptr = proc_static_ptr. make_dummy_csdptr = call_site_dynamic_ptr(-1). make_dummy_cssptr = call_site_static_ptr(-1). make_dummy_pdptr = proc_dynamic_ptr(-1). make_dummy_psptr = proc_static_ptr(-1). %---------------------------------------------------------------------------% :- pragma foreign_decl("C", "#include ""mercury_deep_profiling.h"""). :- type next_deep_item ---> deep_item_end ; deep_item_call_site_static ; deep_item_call_site_dynamic ; deep_item_proc_static ; deep_item_proc_dynamic. :- pragma foreign_enum("C", next_deep_item/0, [ deep_item_end - "MR_deep_item_end", deep_item_call_site_static - "MR_deep_item_call_site_static", deep_item_call_site_dynamic - "MR_deep_item_call_site_dynamic", deep_item_proc_static - "MR_deep_item_proc_static", deep_item_proc_dynamic - "MR_deep_item_proc_dynamic" ]). :- pred is_next_item_token(int::in, next_deep_item::out) is semidet. :- pragma foreign_proc("C", is_next_item_token(Int::in, NextItem::out), [promise_pure, will_not_call_mercury, thread_safe], " NextItem = (MR_DeepProfNextItem) Int; switch (NextItem) { case MR_deep_item_end: case MR_deep_item_call_site_static: case MR_deep_item_call_site_dynamic: case MR_deep_item_proc_static: case MR_deep_item_proc_dynamic: SUCCESS_INDICATOR = MR_TRUE; break; default: SUCCESS_INDICATOR = MR_FALSE; break; } "). %---------------------------------------------------------------------------% :- end_module read_profile. %---------------------------------------------------------------------------%