[m-rev.] diff: state vars in deep_profiler
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Jan 12 15:36:04 AEDT 2004
deep_profiler/*.m:
Switch to using state variable notation where this is beneficial.
There are no changes in algorithms.
Zoltan.
Diffing .
--- /home/zs/mer/ws00/deep_profiler/callgraph.m 2002-12-02 22:24:33.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/callgraph.m 2004-01-12 15:29:04.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 The University of Melbourne.
+% Copyright (C) 2001-2002, 2004 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.
%-----------------------------------------------------------------------------%
@@ -144,16 +144,16 @@
% :- pred write_arc(int::in, int::in, int::in, io__state::di, io__state::uo)
% is det.
%
-% write_arc(FromPDI, ToPDI, CSDI) -->
+% write_arc(FromPDI, ToPDI, CSDI, !IO) :-
% io__format("arc from pd %d to pd %d through csd %d\n",
-% [i(FromPDI), i(ToPDI), i(CSDI)]).
+% [i(FromPDI), i(ToPDI), i(CSDI)], !IO).
%
% :- pred write_pdi_cn(int::in, int::in, io__state::di, io__state::uo) is det.
%
-% write_pdi_cn(PDI, CN) -->
-% io__write_string("pdi "),
-% io__write_int(PDI),
-% io__write_string(" -> clique "),
-% io__write_int(CN),
-% io__nl,
-% io__flush_output.
+% write_pdi_cn(PDI, CN, !IO) :-
+% io__write_string("pdi ", !IO),
+% io__write_int(PDI, !IO),
+% io__write_string(" -> clique ", !IO),
+% io__write_int(CN, !IO),
+% io__nl(!IO),
+% io__flush_output(!IO).
--- /home/zs/mer/ws00/deep_profiler/cliques.m 2002-12-02 22:24:33.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/cliques.m 2004-01-12 15:29:08.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 The University of Melbourne.
+% Copyright (C) 2001-2002, 2004 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.
%-----------------------------------------------------------------------------%
@@ -235,40 +235,40 @@
% :- pred write_graph(graph::in, io__state::di, io__state::uo)
% is det.
%
-% write_graph(Graph) -->
-% { Graph = graph(Size, Array) },
-% io__format("graph size: %d\n", [i(Size)]),
-% write_graph_nodes(0, Size, Array).
+% write_graph(Graph, !IO) :-
+% Graph = graph(Size, Array),
+% io__format("graph size: %d\n", [i(Size)], !IO),
+% write_graph_nodes(0, Size, Array, !IO).
%
% :- pred write_graph_nodes(int::in, int::in, array(set(int))::in,
% io__state::di, io__state::uo) is det.
%
-% write_graph_nodes(Cur, Max, Array) -->
-% ( { Cur =< Max } ->
-% io__format("%d -> ", [i(Cur)]),
-% { array__lookup(Array, Cur, SuccSet) },
-% { set__to_sorted_list(SuccSet, Succs) },
-% io__write_list(Succs, ", ", io__write_int),
-% io__nl,
-% write_graph_nodes(Cur + 1, Max, Array)
+% write_graph_nodes(Cur, Max, Array, !IO) :-
+% ( Cur =< Max ->
+% io__format("%d -> ", [i(Cur)], !IO),
+% array__lookup(Array, Cur, SuccSet),
+% set__to_sorted_list(SuccSet, Succs),
+% io__write_list(Succs, ", ", io__write_int, !IO),
+% io__nl(!IO),
+% write_graph_nodes(Cur + 1, Max, Array, !IO)
% ;
-% []
+% true
% ).
%
% :- pred write_dfs(list(int)::in, io__state::di, io__state::uo)
% is det.
%
-% write_dfs(Dfs) -->
-% io__write_list(Dfs, "\n", io__write_int).
+% write_dfs(Dfs, !IO) :-
+% io__write_list(Dfs, "\n", io__write_int, !IO).
%
% :- pred write_cliques(list(set(int))::in, io__state::di, io__state::uo)
% is det.
%
-% write_cliques(Cliques) -->
-% io__write_list(Cliques, "\n", io__write).
+% write_cliques(Cliques, !IO) :-
+% io__write_list(Cliques, "\n", io__write, !IO).
%
% :- pred write_clique(list(int)::in, io__state::di, io__state::uo)
% is det.
%
-% write_clique(Nodes) -->
-% io__write_list(Nodes, "\n", io__write_int).
+% write_clique(Nodes, !IO) :-
+% io__write_list(Nodes, "\n", io__write_int, !IO).
--- /home/zs/mer/ws00/deep_profiler/conf.m 2002-12-02 22:24:33.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/conf.m 2004-01-12 15:29:09.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 The University of Melbourne.
+% Copyright (C) 2001-2002, 2004 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.
%-----------------------------------------------------------------------------%
@@ -37,17 +37,17 @@
string__format("%s %s", [s(CmdName), s(PipeName)], Cmd)
).
-server_name(ServerName) -->
- io__make_temp(TmpFile),
- { hostname_cmd(HostnameCmd) },
- { ServerRedirectCmd =
- string__format("%s > %s", [s(HostnameCmd), s(TmpFile)]) },
- io__call_system(ServerRedirectCmd, Res1),
- ( { Res1 = ok(0) } ->
- io__open_input(TmpFile, TmpRes),
- ( { TmpRes = ok(TmpStream) } ->
- io__read_file_as_string(TmpStream, TmpReadRes),
- {
+server_name(ServerName, !IO) :-
+ io__make_temp(TmpFile, !IO),
+ hostname_cmd(HostnameCmd),
+ ServerRedirectCmd =
+ string__format("%s > %s", [s(HostnameCmd), s(TmpFile)]),
+ io__call_system(ServerRedirectCmd, Res1, !IO),
+ ( Res1 = ok(0) ->
+ io__open_input(TmpFile, TmpRes, !IO),
+ ( TmpRes = ok(TmpStream) ->
+ io__read_file_as_string(TmpStream, TmpReadRes, !IO),
+ (
TmpReadRes = ok(ServerNameNl),
(
string__remove_suffix(ServerNameNl,
@@ -60,14 +60,14 @@
;
TmpReadRes = error(_, _),
error("cannot read server's name")
- },
- io__close_input(TmpStream)
+ ),
+ io__close_input(TmpStream, !IO)
;
- { error("cannot open file to find the server's name") }
+ error("cannot open file to find the server's name")
),
- io__remove_file(TmpFile, _)
+ io__remove_file(TmpFile, _, !IO)
;
- { error("cannot execute cmd to find the server's name") }
+ error("cannot execute cmd to find the server's name")
).
:- pred mkfifo_cmd(string::out) is det.
--- /home/zs/mer/ws00/deep_profiler/exclude.m 2001-07-13 14:40:04.000000000 +1000
+++ /home/zs/mer/ws0/deep_profiler/exclude.m 2004-01-12 15:29:10.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001 The University of Melbourne.
+% Copyright (C) 2001, 2004 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.
%-----------------------------------------------------------------------------%
@@ -74,66 +74,66 @@
% module.
-read_exclude_file(FileName, Deep, Res) -->
- io__open_input(FileName, Res0),
+read_exclude_file(FileName, Deep, Res, !IO) :-
+ io__open_input(FileName, Res0, !IO),
(
- { Res0 = ok(InputStream) },
- read_exclude_lines(FileName, InputStream, [], Res1),
- io__close_input(InputStream),
+ Res0 = ok(InputStream),
+ read_exclude_lines(FileName, InputStream, [], Res1, !IO),
+ io__close_input(InputStream, !IO),
(
- { Res1 = ok(Specs) },
- { validate_exclude_lines(FileName, Specs, Deep, Res) }
+ Res1 = ok(Specs),
+ validate_exclude_lines(FileName, Specs, Deep, Res)
;
- { Res1 = error(Msg) },
- { Res = error(Msg) }
+ Res1 = error(Msg),
+ Res = error(Msg)
)
;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- { Res = error(Msg) }
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ Res = error(Msg)
).
:- pred read_exclude_lines(string::in, io__input_stream::in,
list(exclude_spec)::in, maybe_error(list(exclude_spec))::out,
io__state::di, io__state::uo) is det.
-read_exclude_lines(FileName, InputStream, RevSpecs0, Res) -->
- io__read_line_as_string(InputStream, Res0),
+read_exclude_lines(FileName, InputStream, RevSpecs0, Res, !IO) :-
+ io__read_line_as_string(InputStream, Res0, !IO),
(
- { Res0 = ok(Line0) },
- { string__remove_suffix(Line0, "\n", LinePrime) ->
+ Res0 = ok(Line0),
+ ( string__remove_suffix(Line0, "\n", LinePrime) ->
Line = LinePrime
;
Line = Line0
- },
+ ),
+ (
+ Words = string__words(char__is_whitespace, Line),
+ Words = [Scope, ModuleName],
(
- { Words = string__words(char__is_whitespace, Line) },
- { Words = [Scope, ModuleName] },
- {
Scope = "all",
ExclType = all_procedures
;
Scope = "internal",
ExclType = internal_procedures
- }
+ )
->
- { Spec = exclude_spec(ModuleName, ExclType) },
- { RevSpecs1 = [Spec | RevSpecs0] },
+ Spec = exclude_spec(ModuleName, ExclType),
+ RevSpecs1 = [Spec | RevSpecs0],
read_exclude_lines(FileName, InputStream, RevSpecs1,
- Res)
+ Res, !IO)
;
- { Msg = string__format(
+ Msg = string__format(
"file %s contains badly formatted line: %s",
- [s(FileName), s(Line)]) },
- { Res = error(Msg) }
+ [s(FileName), s(Line)]),
+ Res = error(Msg)
)
;
- { Res0 = eof },
- { Res = ok(RevSpecs0) }
+ Res0 = eof,
+ Res = ok(RevSpecs0)
;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- { Res = error(Msg) }
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ Res = error(Msg)
).
:- pred validate_exclude_lines(string::in, list(exclude_spec)::in, deep::in,
--- /home/zs/mer/ws00/deep_profiler/interface.m 2002-12-02 22:24:33.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/interface.m 2004-01-12 15:29:10.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 The University of Melbourne.
+% Copyright (C) 2001-2002, 2004 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.
%-----------------------------------------------------------------------------%
@@ -358,102 +358,102 @@
MangledChars = [First | MangledRest]
).
-send_term(ToPipeName, Debug, Data) -->
- io__open_output(ToPipeName, Res),
- ( { Res = ok(ToStream) } ->
- io__write(ToStream, Data),
- io__write_string(ToStream, ".\n"),
- io__close_output(ToStream)
+send_term(ToPipeName, Debug, Data, !IO) :-
+ io__open_output(ToPipeName, Res, !IO),
+ ( Res = ok(ToStream) ->
+ io__write(ToStream, Data, !IO),
+ io__write_string(ToStream, ".\n", !IO),
+ io__close_output(ToStream, !IO)
;
- { error("send_term: couldn't open pipe") }
+ error("send_term: couldn't open pipe")
),
(
- { Debug = yes },
- io__open_output("/tmp/.send_term", Res2),
- ( { Res2 = ok(DebugStream) } ->
- io__write(DebugStream, Data),
- io__write_string(DebugStream, ".\n"),
- io__close_output(DebugStream)
+ Debug = yes,
+ io__open_output("/tmp/.send_term", Res2, !IO),
+ ( Res2 = ok(DebugStream) ->
+ io__write(DebugStream, Data, !IO),
+ io__write_string(DebugStream, ".\n", !IO),
+ io__close_output(DebugStream, !IO)
;
- { error("send_term: couldn't debug") }
+ error("send_term: couldn't debug")
)
;
- { Debug = no }
+ Debug = no
).
-send_string(ToPipeName, Debug, Data) -->
- io__open_output(ToPipeName, Res),
- ( { Res = ok(ToStream) } ->
- io__write_string(ToStream, Data),
- io__close_output(ToStream)
+send_string(ToPipeName, Debug, Data, !IO) :-
+ io__open_output(ToPipeName, Res, !IO),
+ ( Res = ok(ToStream) ->
+ io__write_string(ToStream, Data, !IO),
+ io__close_output(ToStream, !IO)
;
- { error("send_string: couldn't open pipe") }
+ error("send_string: couldn't open pipe")
),
(
- { Debug = yes },
- io__open_output("/tmp/.send_string", Res2),
- ( { Res2 = ok(DebugStream) } ->
- io__write_string(DebugStream, Data),
- io__close_output(DebugStream)
+ Debug = yes,
+ io__open_output("/tmp/.send_string", Res2, !IO),
+ ( Res2 = ok(DebugStream) ->
+ io__write_string(DebugStream, Data, !IO),
+ io__close_output(DebugStream, !IO)
;
- { error("send_string: couldn't debug") }
+ error("send_string: couldn't debug")
)
;
- { Debug = no }
+ Debug = no
).
-recv_term(FromPipeName, Debug, Resp) -->
- io__open_input(FromPipeName, Res0),
- ( { Res0 = ok(FromStream) } ->
- io__read(FromStream, Res1),
- ( { Res1 = ok(Resp0) } ->
- { Resp = Resp0 }
+recv_term(FromPipeName, Debug, Resp, !IO) :-
+ io__open_input(FromPipeName, Res0, !IO),
+ ( Res0 = ok(FromStream) ->
+ io__read(FromStream, Res1, !IO),
+ ( Res1 = ok(Resp0) ->
+ Resp = Resp0
;
- { error("recv_term: read failed") }
+ error("recv_term: read failed")
),
- io__close_input(FromStream),
+ io__close_input(FromStream, !IO),
(
- { Debug = yes },
- io__open_output("/tmp/.recv_term", Res2),
- ( { Res2 = ok(DebugStream) } ->
- io__write(DebugStream, Res1),
- io__write_string(DebugStream, ".\n"),
- io__close_output(DebugStream)
+ Debug = yes,
+ io__open_output("/tmp/.recv_term", Res2, !IO),
+ ( Res2 = ok(DebugStream) ->
+ io__write(DebugStream, Res1, !IO),
+ io__write_string(DebugStream, ".\n", !IO),
+ io__close_output(DebugStream, !IO)
;
- { error("recv_term: couldn't debug") }
+ error("recv_term: couldn't debug")
)
;
- { Debug = no }
+ Debug = no
)
;
- { error("recv_term: couldn't open pipe") }
+ error("recv_term: couldn't open pipe")
).
-recv_string(FromPipeName, Debug, Resp) -->
- io__open_input(FromPipeName, Res0),
- ( { Res0 = ok(FromStream) } ->
- io__read_file_as_string(FromStream, Res1),
- ( { Res1 = ok(Resp0) } ->
- { Resp = Resp0 }
+recv_string(FromPipeName, Debug, Resp, !IO) :-
+ io__open_input(FromPipeName, Res0, !IO),
+ ( Res0 = ok(FromStream) ->
+ io__read_file_as_string(FromStream, Res1, !IO),
+ ( Res1 = ok(Resp0) ->
+ Resp = Resp0
;
- { error("recv_string: read failed") }
+ error("recv_string: read failed")
),
- io__close_input(FromStream),
+ io__close_input(FromStream, !IO),
(
- { Debug = yes },
- io__open_output("/tmp/.recv_string", Res2),
- ( { Res2 = ok(DebugStream) } ->
- io__write(DebugStream, Res1),
- io__write_string(DebugStream, ".\n"),
- io__close_output(DebugStream)
+ Debug = yes,
+ io__open_output("/tmp/.recv_string", Res2, !IO),
+ ( Res2 = ok(DebugStream) ->
+ io__write(DebugStream, Res1, !IO),
+ io__write_string(DebugStream, ".\n", !IO),
+ io__close_output(DebugStream, !IO)
;
- { error("recv_string: couldn't debug") }
+ error("recv_string: couldn't debug")
)
;
- { Debug = no }
+ Debug = no
)
;
- { error("recv_term: couldn't open pipe") }
+ error("recv_term: couldn't open pipe")
).
%-----------------------------------------------------------------------------%
--- /home/zs/mer/ws00/deep_profiler/mdprof_cgi.m 2003-02-24 16:49:31.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/mdprof_cgi.m 2004-01-12 15:29:10.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2003 The University of Melbourne.
+% Copyright (C) 2001-2004 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.
%-----------------------------------------------------------------------------%
@@ -32,76 +32,76 @@
% only if QUERY_STRING isn't set, which means that the program was invoked
% from the command line for debugging.
-main -->
- write_html_header,
- io__get_environment_var("QUERY_STRING", MaybeQueryString),
- (
- { MaybeQueryString = yes(QueryString0) },
- { getopt__process_options(option_ops(short, long, defaults),
- [], _, MaybeOptions) },
- {
+main(!IO) :-
+ write_html_header(!IO),
+ io__get_environment_var("QUERY_STRING", MaybeQueryString, !IO),
+ (
+ MaybeQueryString = yes(QueryString0),
+ getopt__process_options(option_ops(short, long, defaults),
+ [], _, MaybeOptions),
+ (
MaybeOptions = ok(Options)
;
MaybeOptions = error(_Msg),
error("mdprof_cgi: error parsing empty command line")
- },
- { split(QueryString0, query_separator_char, Pieces) },
- ( { Pieces = [CmdStr, PrefStr, FileName] } ->
- { Cmd = url_component_to_cmd(CmdStr, menu) },
+ ),
+ split(QueryString0, query_separator_char, Pieces),
+ ( Pieces = [CmdStr, PrefStr, FileName] ->
+ Cmd = url_component_to_cmd(CmdStr, menu),
process_query(Cmd, yes(PrefStr), FileName,
- Options)
- ; { Pieces = [CmdStr, FileName] } ->
- { Cmd = url_component_to_cmd(CmdStr, menu) },
- process_query(Cmd, no, FileName, Options)
- ; { Pieces = [FileName] } ->
- process_query(menu, no, FileName, Options)
+ Options, !IO)
+ ; Pieces = [CmdStr, FileName] ->
+ Cmd = url_component_to_cmd(CmdStr, menu),
+ process_query(Cmd, no, FileName, Options, !IO)
+ ; Pieces = [FileName] ->
+ process_query(menu, no, FileName, Options, !IO)
;
- io__set_exit_status(1),
+ io__set_exit_status(1, !IO),
% Give the simplest URL in the error message.
- io__write_string("Bad URL; expected filename\n")
+ io__write_string("Bad URL; expected filename\n", !IO)
)
;
- { MaybeQueryString = no },
- process_command_line
+ MaybeQueryString = no,
+ process_command_line(!IO)
).
:- pred process_command_line(io__state::di, io__state::uo) is cc_multi.
-process_command_line -->
- io__progname_base(mdprof_cgi_progname, ProgName),
- io__command_line_arguments(Args0),
- % io__write_string("Args0: "),
- % io__write_list(Args0, " ", write_bracketed_string),
- % io__nl,
- { getopt__process_options(option_ops(short, long, defaults),
- Args0, Args, MaybeOptions) },
+process_command_line(!IO) :-
+ io__progname_base(mdprof_cgi_progname, ProgName, !IO),
+ io__command_line_arguments(Args0, !IO),
+ % io__write_string("Args0: ", !IO),
+ % io__write_list(Args0, " ", write_bracketed_string, !IO),
+ % io__nl(!IO),
+ getopt__process_options(option_ops(short, long, defaults),
+ Args0, Args, MaybeOptions),
(
- { MaybeOptions = ok(Options) },
- { lookup_bool_option(Options, help, Help) },
- { lookup_bool_option(Options, version, Version) },
+ MaybeOptions = ok(Options),
+ lookup_bool_option(Options, help, Help),
+ lookup_bool_option(Options, version, Version),
(
- { Help = yes },
- write_help_message(ProgName)
+ Help = yes,
+ write_help_message(ProgName, !IO)
;
- { Help = no }
+ Help = no
),
(
- { Version = yes },
- write_version_message(ProgName)
+ Version = yes,
+ write_version_message(ProgName, !IO)
;
- { Version = no }
+ Version = no
),
- ( { Help = no, Version = no } ->
- process_args(ProgName, Args, Options)
+ ( Help = no, Version = no ->
+ process_args(ProgName, Args, Options, !IO)
;
- []
+ true
)
;
- { MaybeOptions = error(Msg) },
- io__set_exit_status(1),
+ MaybeOptions = error(Msg),
+ io__set_exit_status(1, !IO),
io__format("%s: error parsing options: %s\n",
- [s(ProgName), s(Msg)])
+ [s(ProgName), s(Msg)], !IO)
).
:- func mdprof_cgi_progname = string.
@@ -110,40 +110,40 @@
:- pred write_version_message(string::in, io__state::di, io__state::uo) is det.
-write_version_message(ProgName) -->
- { library__version(Version) },
- io__write_string(ProgName),
- io__write_string(": Mercury deep profiler"),
- io__nl,
- io__write_string(Version),
- io__nl.
+write_version_message(ProgName, !IO) :-
+ library__version(Version) ,
+ io__write_string(ProgName, !IO),
+ io__write_string(": Mercury deep profiler", !IO),
+ io__nl(!IO),
+ io__write_string(Version, !IO),
+ io__nl(!IO).
:- pred write_help_message(string::in, io__state::di, io__state::uo) is det.
-write_help_message(ProgName) -->
+write_help_message(ProgName, !IO) :-
% The options are deliberately not documented; they change
% quite rapidly, based on the debugging needs of the moment.
% The optional filename argument is also for implementors only.
- io__format("Usage: %s\n", [s(ProgName)]),
- io__format("This program doesn't expect any arguments;\n", []),
- io__format("instead it decides what to do based on the\n", []),
- io__format("QUERY_STRING environment variable.\n", []).
+ io__format("Usage: %s\n", [s(ProgName)], !IO),
+ io__format("This program doesn't expect any arguments;\n", [], !IO),
+ io__format("instead it decides what to do based on the\n", [], !IO),
+ io__format("QUERY_STRING environment variable.\n", [], !IO).
%-----------------------------------------------------------------------------%
:- pred process_args(string::in, list(string)::in, option_table::in,
io__state::di, io__state::uo) is cc_multi.
-process_args(ProgName, Args, Options) -->
- ( { Args = [FileName] } ->
+process_args(ProgName, Args, Options, !IO) :-
+ ( Args = [FileName] ->
% Although this mode of usage is not intended for production
% use, allowing the filename and a limited range of commands
% to be supplied on the command line makes debugging very much
% easier.
- process_query(default_cmd(Options), no, FileName, Options)
+ process_query(default_cmd(Options), no, FileName, Options, !IO)
;
- io__set_exit_status(1),
- write_help_message(ProgName)
+ io__set_exit_status(1, !IO),
+ write_help_message(ProgName, !IO)
% io__write_list(Args, " ", write_bracketed_string)
).
@@ -153,16 +153,16 @@
% :- pred write_bracketed_string(string::in, io__state::di, io__state::uo)
% is det.
%
-% write_bracketed_string(S) -->
-% io__write_string("<"),
-% io__write_string(S),
-% io__write_string(">").
+% write_bracketed_string(S, !IO) :-
+% io__write_string("<", !IO),
+% io__write_string(S, !IO),
+% io__write_string(">", !IO).
:- pred write_html_header(io__state::di, io__state::uo) is det.
-write_html_header -->
- io__write_string(html_header_text),
- io__flush_output.
+write_html_header(!IO) :-
+ io__write_string(html_header_text, !IO),
+ io__flush_output(!IO).
:- func html_header_text = string.
@@ -173,50 +173,50 @@
:- pred process_query(cmd::in, maybe(string)::in, string::in,
option_table::in, io__state::di, io__state::uo) is cc_multi.
-process_query(Cmd, MaybePrefStr, DataFileName, Options) -->
- {
+process_query(Cmd, MaybePrefStr, DataFileName, Options, !IO) :-
+ (
MaybePrefStr = yes(PrefStr),
MaybePref = url_component_to_maybe_pref(PrefStr)
;
MaybePrefStr = no,
MaybePref = no
- },
- {
+ ),
+ (
MaybePref = yes(Pref)
;
MaybePref = no,
Pref = default_preferences
- },
- { ToServerPipe = to_server_pipe_name(DataFileName) },
- { FromServerPipe = from_server_pipe_name(DataFileName) },
- { StartupFile = server_startup_name(DataFileName) },
- { MutexFile = mutex_file_name(DataFileName) },
- { lookup_bool_option(Options, debug, Debug) },
- { WantFile = want_file_name },
- make_want_file(WantFile),
- get_lock(Debug, MutexFile),
+ ),
+ ToServerPipe = to_server_pipe_name(DataFileName),
+ FromServerPipe = from_server_pipe_name(DataFileName),
+ StartupFile = server_startup_name(DataFileName),
+ MutexFile = mutex_file_name(DataFileName),
+ lookup_bool_option(Options, debug, Debug),
+ WantFile = want_file_name,
+ make_want_file(WantFile, !IO),
+ get_lock(Debug, MutexFile, !IO),
(
- { Debug = yes }
+ Debug = yes
% Do not set up any cleanups; leave all files around,
% since they may be needed for postmortem examination.
;
- { Debug = no },
- setup_signals(MutexFile, want_dir, want_prefix)
+ Debug = no,
+ setup_signals(MutexFile, want_dir, want_prefix, !IO)
),
- check_for_existing_fifos(ToServerPipe, FromServerPipe, FifoCount),
- ( { FifoCount = 0 } ->
+ check_for_existing_fifos(ToServerPipe, FromServerPipe, FifoCount, !IO),
+ ( FifoCount = 0 ->
handle_query_from_new_server(Cmd, Pref, DataFileName,
ToServerPipe, FromServerPipe, StartupFile,
- MutexFile, WantFile, Options)
- ; { FifoCount = 2 } ->
+ MutexFile, WantFile, Options, !IO)
+ ; FifoCount = 2 ->
handle_query_from_existing_server(Cmd, Pref,
ToServerPipe, FromServerPipe,
- MutexFile, WantFile, Options)
+ MutexFile, WantFile, Options, !IO)
;
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile),
- io__set_exit_status(1),
- io__write_string("mdprof internal error: bad fifo count")
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO),
+ io__set_exit_status(1, !IO),
+ io__write_string("mdprof internal error: bad fifo count", !IO)
).
% Handle the given query using the existing server. Delete the mutex and want
@@ -227,20 +227,20 @@
io__state::di, io__state::uo) is det.
handle_query_from_existing_server(Cmd, Pref, ToServerPipe, FromServerPipe,
- MutexFile, WantFile, Options) -->
- { lookup_bool_option(Options, debug, Debug) },
- send_term(ToServerPipe, Debug, cmd_pref(Cmd, Pref)),
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile),
- recv_string(FromServerPipe, Debug, ResponseFileName),
- { CatCmd = string__format("cat %s", [s(ResponseFileName)]) },
- io__call_system(CatCmd, _),
+ MutexFile, WantFile, Options, !IO) :-
+ lookup_bool_option(Options, debug, Debug),
+ send_term(ToServerPipe, Debug, cmd_pref(Cmd, Pref), !IO),
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO),
+ recv_string(FromServerPipe, Debug, ResponseFileName, !IO),
+ CatCmd = string__format("cat %s", [s(ResponseFileName)]),
+ io__call_system(CatCmd, _, !IO),
(
- { Debug = yes }
+ Debug = yes
% Leave the response file to be examined.
;
- { Debug = no },
- io__remove_file(ResponseFileName, _)
+ Debug = no,
+ io__remove_file(ResponseFileName, _, !IO)
).
% Handle the given query and then become the new server. Delete the mutex
@@ -251,75 +251,75 @@
option_table::in, io__state::di, io__state::uo) is cc_multi.
handle_query_from_new_server(Cmd, Pref, FileName, ToServerPipe, FromServerPipe,
- StartupFile, MutexFile, WantFile, Options) -->
- server_name(Machine),
- { lookup_bool_option(Options, canonical_clique, Canonical) },
- { lookup_bool_option(Options, server_process, ServerProcess) },
- { lookup_bool_option(Options, debug, Debug) },
- { lookup_bool_option(Options, record_startup, RecordStartup) },
- (
- { RecordStartup = yes },
- io__open_output(StartupFile, StartupStreamRes),
- (
- { StartupStreamRes = ok(StartupStream0) },
- { MaybeStartupStream = yes(StartupStream0) },
- register_file_for_cleanup(StartupFile)
+ StartupFile, MutexFile, WantFile, Options, !IO) :-
+ server_name(Machine, !IO),
+ lookup_bool_option(Options, canonical_clique, Canonical),
+ lookup_bool_option(Options, server_process, ServerProcess),
+ lookup_bool_option(Options, debug, Debug),
+ lookup_bool_option(Options, record_startup, RecordStartup),
+ (
+ RecordStartup = yes,
+ io__open_output(StartupFile, StartupStreamRes, !IO),
+ (
+ StartupStreamRes = ok(StartupStream0),
+ MaybeStartupStream = yes(StartupStream0),
+ register_file_for_cleanup(StartupFile, !IO)
;
- { StartupStreamRes = error(_) },
- { error("cannot create startup file") }
+ StartupStreamRes = error(_),
+ error("cannot create startup file")
)
;
- { RecordStartup = no },
- { MaybeStartupStream = no }
+ RecordStartup = no,
+ MaybeStartupStream = no
),
read_and_startup(Machine, [FileName], Canonical, MaybeStartupStream,
- Res),
+ Res, !IO),
(
- { Res = ok(Deep) },
- try_exec(Cmd, Pref, Deep, HTML),
+ Res = ok(Deep),
+ try_exec(Cmd, Pref, Deep, HTML, !IO),
(
- { MaybeStartupStream = yes(StartupStream1) },
+ MaybeStartupStream = yes(StartupStream1),
io__format(StartupStream1, "query 0 output:\n%s\n",
- [s(HTML)]),
+ [s(HTML)], !IO),
% If we don't flush the output before the fork, it will
% be flushed twice, once by the parent process and
% once by the child process.
- io__flush_output(StartupStream1)
+ io__flush_output(StartupStream1, !IO)
;
- { MaybeStartupStream = no }
+ MaybeStartupStream = no
),
(
- { ServerProcess = no },
+ ServerProcess = no,
% --no-server process should be specified only during
% debugging.
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile),
- io__write_string(HTML)
- ;
- { ServerProcess = yes },
- make_pipes(FileName, Success),
- (
- { Success = yes },
- io__write_string(HTML),
- io__flush_output,
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO),
+ io__write_string(HTML, !IO)
+ ;
+ ServerProcess = yes,
+ make_pipes(FileName, Success, !IO),
+ (
+ Success = yes,
+ io__write_string(HTML, !IO),
+ io__flush_output(!IO),
start_server(Options,
ToServerPipe, FromServerPipe,
MaybeStartupStream,
- MutexFile, WantFile, Deep)
+ MutexFile, WantFile, Deep, !IO)
;
- { Success = no },
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile),
- io__set_exit_status(1),
- io__write_string("could not make pipes\n")
+ Success = no,
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO),
+ io__set_exit_status(1, !IO),
+ io__write_string("could not make pipes\n", !IO)
)
)
;
- { Res = error(Error) },
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile),
- io__set_exit_status(1),
- io__format("error reading data file: %s\n", [s(Error)])
+ Res = error(Error),
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO),
+ io__set_exit_status(1, !IO),
+ io__format("error reading data file: %s\n", [s(Error)], !IO)
).
% Become the new server. Delete the mutex and want files when we get out
@@ -330,30 +330,30 @@
io__state::di, io__state::uo) is cc_multi.
start_server(Options, ToServerPipe, FromServerPipe, MaybeStartupStream,
- MutexFile, WantFile, Deep) -->
- { lookup_bool_option(Options, detach_process, DetachProcess) },
- { lookup_bool_option(Options, record_loop, RecordLoop) },
- { lookup_bool_option(Options, debug, Debug) },
+ MutexFile, WantFile, Deep, !IO) :-
+ lookup_bool_option(Options, detach_process, DetachProcess),
+ lookup_bool_option(Options, record_loop, RecordLoop),
+ lookup_bool_option(Options, debug, Debug),
(
- { DetachProcess = no },
+ DetachProcess = no,
% We behave as if we were in the child, to allow the server
% loop to be debugged.
- { DetachRes = in_child(child_has_no_parent) }
+ DetachRes = in_child(child_has_no_parent)
;
- { DetachProcess = yes },
- detach_process(DetachRes)
+ DetachProcess = yes,
+ detach_process(DetachRes, !IO)
),
(
- { DetachRes = in_child(ChildHasParent) } ->
+ DetachRes = in_child(ChildHasParent) ->
% We are in the child; start serving queries.
(
- { ChildHasParent = child_has_parent },
+ ChildHasParent = child_has_parent,
% Our parent process will perform the file removals
% needed to exit the critical section; we don't
% want to duplicate them. We also don't want to delete
% the pipes we need or the startup file.
- unregister_file_for_cleanup(MutexFile),
- unregister_file_for_cleanup(WantFile),
+ unregister_file_for_cleanup(MutexFile, !IO),
+ unregister_file_for_cleanup(WantFile, !IO),
% We need to close stdout and stderr to let the web
% server know that there will be no further outputs
@@ -363,44 +363,44 @@
% The binary streams are clones of the text streams,
% and we must close them too to let the web server
% finish displaying the page.
- io__stdin_stream(StdIn),
- io__close_input(StdIn),
- io__stdout_stream(StdOut),
- io__close_output(StdOut),
- io__stderr_stream(StdErr),
- io__close_output(StdErr),
- io__binary_input_stream(BinaryStdIn),
- io__close_binary_input(BinaryStdIn),
- io__binary_output_stream(BinaryStdOut),
- io__close_binary_output(BinaryStdOut)
+ io__stdin_stream(StdIn, !IO),
+ io__close_input(StdIn, !IO),
+ io__stdout_stream(StdOut, !IO),
+ io__close_output(StdOut, !IO),
+ io__stderr_stream(StdErr, !IO),
+ io__close_output(StdErr, !IO),
+ io__binary_input_stream(BinaryStdIn, !IO),
+ io__close_binary_input(BinaryStdIn, !IO),
+ io__binary_output_stream(BinaryStdOut, !IO),
+ io__close_binary_output(BinaryStdOut, !IO)
;
- { ChildHasParent = child_has_no_parent },
+ ChildHasParent = child_has_no_parent,
% We don't actually have a parent process, so we need
% to perform the file removals needed to exit the
% critical section ourselves.
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile)
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO)
),
(
- { RecordLoop = yes },
- { MaybeDebugStream = MaybeStartupStream }
+ RecordLoop = yes,
+ MaybeDebugStream = MaybeStartupStream
;
- { RecordLoop = no },
- { MaybeDebugStream = no }
+ RecordLoop = no,
+ MaybeDebugStream = no
),
- { lookup_int_option(Options, timeout, TimeOut) },
- { lookup_bool_option(Options, canonical_clique, Canonical) },
+ lookup_int_option(Options, timeout, TimeOut),
+ lookup_bool_option(Options, canonical_clique, Canonical),
server_loop(ToServerPipe, FromServerPipe, TimeOut,
- MaybeDebugStream, Debug, Canonical, 0, Deep)
+ MaybeDebugStream, Debug, Canonical, 0, Deep, !IO)
;
- { DetachRes = in_parent } ->
+ DetachRes = in_parent ->
% We are in the parent after we spawned the child. We cause
% the process to exit simply by not calling server_loop.
%
% We leave the pipes and the startup file; we clean up only
% the files involved in the critical section.
- release_lock(Debug, MutexFile),
- remove_want_file(WantFile)
+ release_lock(Debug, MutexFile, !IO),
+ remove_want_file(WantFile, !IO)
;
% We are in the parent because the fork failed. Again we cause
% the process to exit simply by not calling server_loop, but we
@@ -410,8 +410,8 @@
%
% This deletes all the files created by the process, including
% WantFile and MutexFile, with MutexFile being deleted last.
- delete_cleanup_files,
- io__set_exit_status(1)
+ delete_cleanup_files(!IO),
+ io__set_exit_status(1, !IO)
).
:- pred server_loop(string::in, string::in, int::in,
@@ -419,101 +419,103 @@
io__state::di, io__state::uo) is cc_multi.
server_loop(ToServerPipe, FromServerPipe, TimeOut0, MaybeStartupStream,
- Debug, Canonical, QueryNum0, Deep0) -->
- setup_timeout(TimeOut0),
- { QueryNum = QueryNum0 + 1 },
- recv_term(ToServerPipe, Debug, CmdPref0),
+ Debug, Canonical, QueryNum0, Deep0, !IO) :-
+ setup_timeout(TimeOut0, !IO),
+ QueryNum = QueryNum0 + 1,
+ recv_term(ToServerPipe, Debug, CmdPref0, !IO),
(
- { MaybeStartupStream = yes(StartupStream0) },
+ MaybeStartupStream = yes(StartupStream0),
io__format(StartupStream0, "server loop query %d\n",
- [i(QueryNum)]),
- io__write(StartupStream0, CmdPref0),
- io__nl(StartupStream0),
- io__flush_output(StartupStream0)
+ [i(QueryNum)], !IO),
+ io__write(StartupStream0, CmdPref0, !IO),
+ io__nl(StartupStream0, !IO),
+ io__flush_output(StartupStream0, !IO)
;
- { MaybeStartupStream = no }
+ MaybeStartupStream = no
),
- { CmdPref0 = cmd_pref(Cmd0, Pref0) },
- ( { Cmd0 = restart } ->
+ CmdPref0 = cmd_pref(Cmd0, Pref0),
+ ( Cmd0 = restart ->
read_and_startup(Deep0 ^ server_name, [Deep0 ^ data_file_name],
- Canonical, MaybeStartupStream, MaybeDeep),
+ Canonical, MaybeStartupStream, MaybeDeep, !IO),
(
- { MaybeDeep = ok(Deep) },
- { MaybeMsg = no },
- { Cmd = menu }
- ;
- { MaybeDeep = error(ErrorMsg) },
- { MaybeMsg = yes(ErrorMsg) },
- { Deep = Deep0 },
- { Cmd = quit }
+ MaybeDeep = ok(Deep),
+ MaybeMsg = no,
+ Cmd = menu
+ ;
+ MaybeDeep = error(ErrorMsg),
+ MaybeMsg = yes(ErrorMsg),
+ Deep = Deep0,
+ Cmd = quit
)
;
- { Deep = Deep0 },
- { MaybeMsg = no },
- { Cmd = Cmd0 }
+ Deep = Deep0,
+ MaybeMsg = no,
+ Cmd = Cmd0
),
(
- { MaybeMsg = yes(HTML) }
+ MaybeMsg = yes(HTML)
;
- { MaybeMsg = no },
- try_exec(Cmd, Pref0, Deep, HTML)
+ MaybeMsg = no,
+ try_exec(Cmd, Pref0, Deep, HTML, !IO)
),
- { ResponseFileName =
- response_file_name(Deep0 ^ data_file_name, QueryNum) },
- io__open_output(ResponseFileName, ResponseRes),
+ ResponseFileName =
+ response_file_name(Deep0 ^ data_file_name, QueryNum),
+ io__open_output(ResponseFileName, ResponseRes, !IO),
(
- { ResponseRes = ok(ResponseStream) }
+ ResponseRes = ok(ResponseStream)
;
- { ResponseRes = error(_) },
- { error("cannot open response file") }
+ ResponseRes = error(_),
+ error("cannot open response file")
),
- io__write_string(ResponseStream, HTML),
- io__close_output(ResponseStream),
+ io__write_string(ResponseStream, HTML, !IO),
+ io__close_output(ResponseStream, !IO),
- send_string(FromServerPipe, Debug, ResponseFileName),
+ send_string(FromServerPipe, Debug, ResponseFileName, !IO),
(
- { MaybeStartupStream = yes(StartupStream1) },
+ MaybeStartupStream = yes(StartupStream1),
io__format(StartupStream1, "query %d output:\n%s\n",
- [i(QueryNum), s(HTML)]),
- io__flush_output(StartupStream1)
+ [i(QueryNum), s(HTML)], !IO),
+ io__flush_output(StartupStream1, !IO)
;
- { MaybeStartupStream = no }
+ MaybeStartupStream = no
),
- ( { Cmd = quit } ->
+ ( Cmd = quit ->
% The lack of a recursive call here shuts down the server.
%
% This deletes all the files created by the process, including
% WantFile and MutexFile, with MutexFile being deleted last.
- delete_cleanup_files
- ; { Cmd = timeout(TimeOut) } ->
+ delete_cleanup_files(!IO)
+ ; Cmd = timeout(TimeOut) ->
server_loop(ToServerPipe, FromServerPipe, TimeOut,
- MaybeStartupStream, Debug, Canonical, QueryNum, Deep)
+ MaybeStartupStream, Debug, Canonical, QueryNum, Deep,
+ !IO)
;
server_loop(ToServerPipe, FromServerPipe, TimeOut0,
- MaybeStartupStream, Debug, Canonical, QueryNum, Deep)
+ MaybeStartupStream, Debug, Canonical, QueryNum, Deep,
+ !IO)
).
%-----------------------------------------------------------------------------%
:- pred make_pipes(string::in, bool::out, io__state::di, io__state::uo) is det.
-make_pipes(FileName, Success) -->
- { ToServerPipe = to_server_pipe_name(FileName) },
- { FromServerPipe = from_server_pipe_name(FileName) },
- { MakeToServerPipeCmd = make_pipe_cmd(ToServerPipe) },
- { MakeFromServerPipeCmd = make_pipe_cmd(FromServerPipe) },
- io__call_system(MakeToServerPipeCmd, ToServerRes),
- io__call_system(MakeFromServerPipeCmd, FromServerRes),
+make_pipes(FileName, Success, !IO) :-
+ ToServerPipe = to_server_pipe_name(FileName),
+ FromServerPipe = from_server_pipe_name(FileName),
+ MakeToServerPipeCmd = make_pipe_cmd(ToServerPipe),
+ MakeFromServerPipeCmd = make_pipe_cmd(FromServerPipe),
+ io__call_system(MakeToServerPipeCmd, ToServerRes, !IO),
+ io__call_system(MakeFromServerPipeCmd, FromServerRes, !IO),
(
- { ToServerRes = ok(0) },
- { FromServerRes = ok(0) }
+ ToServerRes = ok(0),
+ FromServerRes = ok(0)
->
- register_file_for_cleanup(ToServerPipe),
- register_file_for_cleanup(FromServerPipe),
- { Success = yes }
+ register_file_for_cleanup(ToServerPipe, !IO),
+ register_file_for_cleanup(FromServerPipe, !IO),
+ Success = yes
;
% In case one of the pipes *was* created. We ignore the
% return values because at least one of these calls *will*
@@ -521,9 +523,9 @@
% remove a named pipe we did succeed in creating, then
% something is so screwed up that probably there is nothing
% we can do to fix the situation.
- io__remove_file(ToServerPipe, _),
- io__remove_file(FromServerPipe, _),
- { Success = no }
+ io__remove_file(ToServerPipe, _, !IO),
+ io__remove_file(FromServerPipe, _, !IO),
+ Success = no
).
%-----------------------------------------------------------------------------%
@@ -578,15 +580,15 @@
:- pred detach_process(detach_process_result::out,
io__state::di, io__state::uo) is cc_multi.
-detach_process(Result) -->
- raw_detach_process(ResCode),
- { ResCode < 0 ->
+detach_process(Result, !IO) :-
+ raw_detach_process(ResCode, !IO),
+ ( ResCode < 0 ->
Result = fork_failed
; ResCode > 0 ->
Result = in_parent
;
Result = in_child(child_has_parent)
- }.
+ ).
% Raw_detach_process performs a fork.
%
--- /home/zs/mer/ws00/deep_profiler/mdprof_test.m 2003-07-15 14:35:24.000000000 +1000
+++ /home/zs/mer/ws0/deep_profiler/mdprof_test.m 2004-01-12 15:29:11.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2002-2003 The University of Melbourne.
+% Copyright (C) 2002-2004 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.
%-----------------------------------------------------------------------------%
@@ -24,78 +24,79 @@
:- import_module int, string, list, array, exception, require, library.
-main -->
- io__progname_base("mdprof_test", ProgName),
- io__command_line_arguments(Args0),
- { getopt__process_options(option_ops(short, long, defaults),
- Args0, Args, MaybeOptions) },
- (
- { MaybeOptions = ok(Options) },
- { lookup_bool_option(Options, help, Help) },
- { lookup_bool_option(Options, version, Version) },
+main(!IO) :-
+ io__progname_base("mdprof_test", ProgName, !IO),
+ io__command_line_arguments(Args0, !IO),
+ getopt__process_options(option_ops(short, long, defaults),
+ Args0, Args, MaybeOptions),
+ (
+ MaybeOptions = ok(Options),
+ lookup_bool_option(Options, help, Help),
+ lookup_bool_option(Options, version, Version),
(
- { Help = yes },
- write_help_message(ProgName)
+ Help = yes,
+ write_help_message(ProgName, !IO)
;
- { Help = no }
+ Help = no
),
(
- { Version = yes },
- write_version_message(ProgName)
+ Version = yes,
+ write_version_message(ProgName, !IO)
;
- { Version = no }
+ Version = no
),
- ( { Help = no, Version = no } ->
- main2(ProgName, Args, Options)
+ ( Help = no, Version = no ->
+ main2(ProgName, Args, Options, !IO)
;
- []
+ true
)
;
- { MaybeOptions = error(Msg) },
- io__set_exit_status(1),
+ MaybeOptions = error(Msg),
+ io__set_exit_status(1, !IO),
io__format("%s: error parsing options: %s\n",
- [s(ProgName), s(Msg)])
+ [s(ProgName), s(Msg)], !IO)
).
:- pred main2(string::in, list(string)::in, option_table::in,
io__state::di, io__state::uo) is cc_multi.
-main2(ProgName, Args, Options) -->
- ( { Args = [FileName] } ->
- { lookup_bool_option(Options, canonical_clique, Canonical) },
- server_name(Machine),
- read_and_startup(Machine, [FileName], Canonical, no, Res),
- (
- { Res = ok(Deep) },
- { lookup_bool_option(Options, test, Test) },
- (
- { Test = no }
- ;
- { Test = yes },
- { lookup_string_option(Options, test_dir,
- TestDir) },
- test_server(TestDir, default_preferences, Deep)
+main2(ProgName, Args, Options, !IO) :-
+ ( Args = [FileName] ->
+ lookup_bool_option(Options, canonical_clique, Canonical),
+ server_name(Machine, !IO),
+ read_and_startup(Machine, [FileName], Canonical, no, Res, !IO),
+ (
+ Res = ok(Deep),
+ lookup_bool_option(Options, test, Test),
+ (
+ Test = no
+ ;
+ Test = yes,
+ lookup_string_option(Options, test_dir,
+ TestDir),
+ test_server(TestDir, default_preferences, Deep,
+ !IO)
)
;
- { Res = error(Error) },
- io__set_exit_status(1),
+ Res = error(Error),
+ io__set_exit_status(1, !IO),
io__format("%s: error reading data file: %s\n",
- [s(ProgName), s(Error)])
+ [s(ProgName), s(Error)], !IO)
)
;
- io__set_exit_status(1),
- write_help_message(ProgName)
+ io__set_exit_status(1, !IO),
+ write_help_message(ProgName, !IO)
).
:- pred write_version_message(string::in, io__state::di, io__state::uo) is det.
-write_version_message(ProgName) -->
- { library__version(Version) },
- io__write_string(ProgName),
- io__write_string(": Mercury deep profiler"),
- io__nl,
- io__write_string(Version),
- io__nl.
+write_version_message(ProgName, !IO) :-
+ library__version(Version),
+ io__write_string(ProgName, !IO),
+ io__write_string(": Mercury deep profiler", !IO),
+ io__nl(!IO),
+ io__write_string(Version, !IO),
+ io__nl(!IO).
:- pred write_help_message(string::in, io__state::di, io__state::uo) is det.
@@ -118,72 +119,72 @@
:- pred test_server(string::in, preferences::in, deep::in,
io__state::di, io__state::uo) is cc_multi.
-test_server(DirName, Pref, Deep) -->
- { string__format("test -d %s || mkdir -p %s",
- [s(DirName), s(DirName)], Cmd) },
- io__call_system(Cmd, _),
- { array__max(Deep ^ clique_members, NumCliques) },
- test_cliques(1, NumCliques, DirName, Pref, Deep),
- { array__max(Deep ^ proc_statics, NumProcStatics) },
- test_procs(1, NumProcStatics, DirName, Pref, Deep).
+test_server(DirName, Pref, Deep, !IO) :-
+ string__format("test -d %s || mkdir -p %s",
+ [s(DirName), s(DirName)], Cmd),
+ io__call_system(Cmd, _, !IO),
+ array__max(Deep ^ clique_members, NumCliques),
+ test_cliques(1, NumCliques, DirName, Pref, Deep, !IO),
+ array__max(Deep ^ proc_statics, NumProcStatics),
+ test_procs(1, NumProcStatics, DirName, Pref, Deep, !IO).
:- pred test_cliques(int::in, int::in, string::in, preferences::in, deep::in,
io__state::di, io__state::uo) is cc_multi.
-test_cliques(Cur, Max, DirName, Pref, Deep) -->
- ( { Cur =< Max } ->
- try_exec(clique(Cur), Pref, Deep, HTML),
- write_test_html(DirName, "clique", Cur, HTML),
- test_cliques(Cur + 1, Max, DirName, Pref, Deep)
+test_cliques(Cur, Max, DirName, Pref, Deep, !IO) :-
+ ( Cur =< Max ->
+ try_exec(clique(Cur), Pref, Deep, HTML, !IO),
+ write_test_html(DirName, "clique", Cur, HTML, !IO),
+ test_cliques(Cur + 1, Max, DirName, Pref, Deep, !IO)
;
- []
+ true
).
:- pred test_procs(int::in, int::in, string::in, preferences::in, deep::in,
io__state::di, io__state::uo) is cc_multi.
-test_procs(Cur, Max, DirName, Pref, Deep) -->
- ( { Cur =< Max } ->
- try_exec(proc(Cur), Pref, Deep, HTML),
- write_test_html(DirName, "proc", Cur, HTML),
- test_procs(Cur + 1, Max, DirName, Pref, Deep)
+test_procs(Cur, Max, DirName, Pref, Deep, !IO) :-
+ ( Cur =< Max ->
+ try_exec(proc(Cur), Pref, Deep, HTML, !IO),
+ write_test_html(DirName, "proc", Cur, HTML, !IO),
+ test_procs(Cur + 1, Max, DirName, Pref, Deep, !IO)
;
- []
+ true
).
:- pred write_test_html(string::in, string::in, int::in, string::in,
io__state::di, io__state::uo) is det.
-write_test_html(DirName, BaseName, Num, HTML) -->
+write_test_html(DirName, BaseName, Num, HTML, !IO) :-
% For large programs such as the Mercury compiler, the profiler data
% file may contain hundreds of thousands of cliques. We therefore put
% each batch of pages in a different subdirectory, thus limiting the
% number of files/subdirs in each directory.
%
% XXX consider splitting up this predicate
- { Bunch = (Num - 1) // 1000 },
- { string__format("%s/%s_%04d",
- [s(DirName), s(BaseName), i(Bunch)], BunchName) },
- ( { (Num - 1) rem 1000 = 0 } ->
- { string__format("test -d %s || mkdir -p %s",
- [s(BunchName), s(BunchName)], Cmd) },
- io__call_system(Cmd, _)
+ Bunch = (Num - 1) // 1000,
+ string__format("%s/%s_%04d",
+ [s(DirName), s(BaseName), i(Bunch)], BunchName),
+ ( (Num - 1) rem 1000 = 0 ->
+ string__format("test -d %s || mkdir -p %s",
+ [s(BunchName), s(BunchName)], Cmd),
+ io__call_system(Cmd, _, !IO)
;
- []
+ true
),
- { string__format("%s/%s_%06d.html",
- [s(BunchName), s(BaseName), i(Num)], FileName) },
- io__open_output(FileName, Res),
- (
- { Res = ok(Stream) },
- io__write_string(Stream, HTML),
- io__close_output(Stream),
- { string__format("gzip %s", [s(FileName)], GzipCmd) },
- io__call_system(GzipCmd, _)
- ;
- { Res = error(Err) },
- { io__error_message(Err, ErrMsg) },
- { error(ErrMsg) }
+ string__format("%s/%s_%06d.html",
+ [s(BunchName), s(BaseName), i(Num)], FileName),
+ io__open_output(FileName, Res, !IO),
+ (
+ Res = ok(Stream),
+ io__write_string(Stream, HTML, !IO),
+ io__close_output(Stream, !IO),
+ string__format("gzip %s", [s(FileName)], GzipCmd),
+ io__call_system(GzipCmd, _, !IO)
+ ;
+ Res = error(Err),
+ io__error_message(Err, ErrMsg),
+ error(ErrMsg)
).
%-----------------------------------------------------------------------------%
--- /home/zs/mer/ws00/deep_profiler/read_profile.m 2001-07-18 14:40:30.000000000 +1000
+++ /home/zs/mer/ws0/deep_profiler/read_profile.m 2004-01-12 15:29:11.000000000 +1100
@@ -1,4 +1,4 @@
-%-----------------------------------------------------------------------------% % Copyright (C) 2001 The University of Melbourne.
+%-----------------------------------------------------------------------------% % Copyright (C) 2001, 2004 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.
%-----------------------------------------------------------------------------%
@@ -34,13 +34,13 @@
; css
; csd.
-read_call_graph(FileName, Res) -->
- io__see_binary(FileName, Res0),
+read_call_graph(FileName, Res, !IO) :-
+ io__see_binary(FileName, Res0, !IO),
(
- { Res0 = ok },
- read_id_string(Res1),
+ Res0 = ok,
+ read_id_string(Res1, !IO),
(
- { Res1 = ok(_) },
+ Res1 = ok(_),
io_combinator__maybe_error_sequence_10(
read_fixed_size_int,
read_fixed_size_int,
@@ -69,40 +69,40 @@
RootPDI),
ResInitDeep = ok(InitDeep0)
),
- Res2),
+ Res2, !IO),
(
- { Res2 = ok(InitDeep) },
- read_nodes(InitDeep, Res),
- io__seen_binary
+ Res2 = ok(InitDeep),
+ read_nodes(InitDeep, Res, !IO),
+ io__seen_binary(!IO)
;
- { Res2 = error(Err) },
- { Res = error(Err) }
+ Res2 = error(Err),
+ Res = error(Err)
)
;
- { Res1 = error(Msg) },
- { Res = error(Msg) }
+ Res1 = error(Msg),
+ Res = error(Msg)
)
;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- { Res = error(Msg) }
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ Res = error(Msg)
).
:- pred read_id_string(maybe_error(string)::out,
io__state::di, io__state::uo) is det.
-read_id_string(Res) -->
- read_n_byte_string(string__length(id_string), Res0),
+read_id_string(Res, !IO) :-
+ read_n_byte_string(string__length(id_string), Res0, !IO),
(
- { Res0 = ok(String) },
- ( { String = id_string } ->
- { Res = ok(id_string) }
+ Res0 = ok(String),
+ ( String = id_string ->
+ Res = ok(id_string)
;
- { Res = error("not a deep profiling data file") }
+ Res = error("not a deep profiling data file")
)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
:- func id_string = string.
@@ -145,83 +145,83 @@
:- pred read_nodes(initial_deep::in, maybe_error(initial_deep)::out,
io__state::di, io__state::uo) is det.
-read_nodes(InitDeep0, Res) -->
- read_byte(Res0),
+read_nodes(InitDeep0, Res, !IO) :-
+ read_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- ( { Byte = token_call_site_dynamic } ->
- read_call_site_dynamic(Res1),
+ Res0 = ok(Byte),
+ ( Byte = token_call_site_dynamic ->
+ read_call_site_dynamic(Res1, !IO),
(
- { Res1 = ok2(CallSiteDynamic, CSDI) },
- { deep_insert(
+ Res1 = ok2(CallSiteDynamic, CSDI),
+ deep_insert(
InitDeep0 ^ init_call_site_dynamics,
- CSDI, CallSiteDynamic, CSDs) },
- { InitDeep1 = InitDeep0
- ^ init_call_site_dynamics := CSDs },
- read_nodes(InitDeep1, Res)
+ CSDI, CallSiteDynamic, CSDs),
+ InitDeep1 = InitDeep0
+ ^ init_call_site_dynamics := CSDs,
+ read_nodes(InitDeep1, Res, !IO)
;
- { Res1 = error2(Err) },
- { Res = error(Err) }
+ Res1 = error2(Err),
+ Res = error(Err)
)
- ; { Byte = token_proc_dynamic } ->
- read_proc_dynamic(Res1),
+ ; Byte = token_proc_dynamic ->
+ read_proc_dynamic(Res1, !IO),
(
- { Res1 = ok2(ProcDynamic, PDI) },
- { deep_insert(
+ Res1 = ok2(ProcDynamic, PDI),
+ deep_insert(
InitDeep0 ^ init_proc_dynamics,
- PDI, ProcDynamic, PDs) },
- { InitDeep1 = InitDeep0
- ^ init_proc_dynamics := PDs },
- read_nodes(InitDeep1, Res)
+ PDI, ProcDynamic, PDs),
+ InitDeep1 = InitDeep0
+ ^ init_proc_dynamics := PDs,
+ read_nodes(InitDeep1, Res, !IO)
;
- { Res1 = error2(Err) },
- { Res = error(Err) }
+ Res1 = error2(Err),
+ Res = error(Err)
)
- ; { Byte = token_call_site_static } ->
- read_call_site_static(Res1),
+ ; Byte = token_call_site_static ->
+ read_call_site_static(Res1, !IO),
(
- { Res1 = ok2(CallSiteStatic, CSSI) },
- { deep_insert(
+ Res1 = ok2(CallSiteStatic, CSSI),
+ deep_insert(
InitDeep0 ^ init_call_site_statics,
- CSSI, CallSiteStatic, CSSs) },
- { InitDeep1 = InitDeep0
- ^ init_call_site_statics := CSSs },
- read_nodes(InitDeep1, Res)
+ CSSI, CallSiteStatic, CSSs),
+ InitDeep1 = InitDeep0
+ ^ init_call_site_statics := CSSs,
+ read_nodes(InitDeep1, Res, !IO)
;
- { Res1 = error2(Err) },
- { Res = error(Err) }
+ Res1 = error2(Err),
+ Res = error(Err)
)
- ; { Byte = token_proc_static } ->
- read_proc_static(Res1),
+ ; Byte = token_proc_static ->
+ read_proc_static(Res1, !IO),
(
- { Res1 = ok2(ProcStatic, PSI) },
- { deep_insert(
+ Res1 = ok2(ProcStatic, PSI),
+ deep_insert(
InitDeep0 ^ init_proc_statics,
- PSI, ProcStatic, PSs) },
- { InitDeep1 = InitDeep0
- ^ init_proc_statics := PSs },
- read_nodes(InitDeep1, Res)
+ PSI, ProcStatic, PSs),
+ InitDeep1 = InitDeep0
+ ^ init_proc_statics := PSs,
+ read_nodes(InitDeep1, Res, !IO)
;
- { Res1 = error2(Err) },
- { Res = error(Err) }
+ Res1 = error2(Err),
+ Res = error(Err)
)
;
- { format("unexpected token %d", [i(Byte)], Msg) },
- { Res = error(Msg) }
+ format("unexpected token %d", [i(Byte)], Msg),
+ Res = error(Msg)
)
;
- { Res0 = eof },
- { Res = ok(InitDeep0) }
+ Res0 = eof,
+ Res = ok(InitDeep0)
;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- { Res = error(Msg) }
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ Res = error(Msg)
).
:- pred read_call_site_static(maybe_error2(call_site_static, int)::out,
io__state::di, io__state::uo) is det.
-read_call_site_static(Res) -->
+read_call_site_static(Res, !IO) :-
% DEBUGSITE
% io__write_string("reading call_site_static.\n"),
io_combinator__maybe_error_sequence_4(
@@ -237,28 +237,28 @@
DummySlotNum, Kind, LineNumber, Str),
Res0 = ok({CallSiteStatic0, CSSI0})
),
- Res1),
+ Res1, !IO),
(
- { Res1 = ok({CallSiteStatic, CSSI}) },
- { Res = ok2(CallSiteStatic, CSSI) }
+ Res1 = ok({CallSiteStatic, CSSI}),
+ Res = ok2(CallSiteStatic, CSSI)
% DEBUGSITE
- % io__write_string("read call_site_static "),
- % io__write_int(CSSI),
- % io__write_string(": "),
- % io__write(CallSiteStatic),
- % io__write_string("\n")
+ % io__write_string("read call_site_static ", !IO),
+ % io__write_int(CSSI, !IO),
+ % io__write_string(": ", !IO),
+ % io__write(CallSiteStatic, !IO),
+ % io__write_string("\n", !IO)
;
- { Res1 = error(Err) },
- { Res = error2(Err) }
+ Res1 = error(Err),
+ Res = error2(Err)
).
:- pred read_proc_static(maybe_error2(proc_static, int)::out,
io__state::di, io__state::uo) is det.
-read_proc_static(Res) -->
+read_proc_static(Res, !IO) :-
% DEBUGSITE
- % io__write_string("reading proc_static.\n"),
+ % io__write_string("reading proc_static.\n", !IO),
io_combinator__maybe_error_sequence_6(
read_ptr(ps),
read_proc_id,
@@ -270,71 +270,71 @@
N0::in, Stuff0::out) is det :-
Stuff0 = ok({PSI0, Id0, F0, L0, I0, N0})
),
- Res1),
+ Res1, !IO),
(
- { Res1 = ok({PSI, Id, FileName, LineNumber, Interface, N}) },
- read_n_things(N, read_ptr(css), Res2),
+ Res1 = ok({PSI, Id, FileName, LineNumber, Interface, N}),
+ read_n_things(N, read_ptr(css), Res2, !IO),
(
- { Res2 = ok(CSSIs) },
- { CSSPtrs = list__map(make_cssptr, CSSIs) },
- { DeclModule = decl_module(Id) },
- { RefinedStr = refined_proc_id_to_string(Id) },
- { RawStr = raw_proc_id_to_string(Id) },
+ Res2 = ok(CSSIs),
+ CSSPtrs = list__map(make_cssptr, CSSIs),
+ DeclModule = decl_module(Id),
+ RefinedStr = refined_proc_id_to_string(Id),
+ RawStr = raw_proc_id_to_string(Id),
% 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.
- { Interface = 0 ->
+ ( Interface = 0 ->
IsInInterface = no
;
IsInInterface = yes
- },
- { ProcStatic = proc_static(Id, DeclModule,
+ ),
+ ProcStatic = proc_static(Id, DeclModule,
RefinedStr, RawStr, FileName, LineNumber,
- IsInInterface, array(CSSPtrs), not_zeroed) },
- { Res = ok2(ProcStatic, PSI) }
+ IsInInterface, array(CSSPtrs), not_zeroed),
+ Res = ok2(ProcStatic, PSI)
% DEBUGSITE
- % io__write_string("read proc_static "),
- % io__write_int(PSI),
- % io__write_string(": "),
- % io__write(ProcStatic),
- % io__write_string("\n")
+ % io__write_string("read proc_static ", !IO),
+ % io__write_int(PSI, !IO),
+ % io__write_string(": ", !IO),
+ % io__write(ProcStatic, !IO),
+ % io__write_string("\n", !IO)
;
- { Res2 = error(Err) },
- { Res = error2(Err) }
+ Res2 = error(Err),
+ Res = error2(Err)
)
;
- { Res1 = error(Err) },
- { Res = error2(Err) }
+ Res1 = error(Err),
+ Res = error2(Err)
).
:- pred read_proc_id(maybe_error(proc_id)::out,
io__state::di, io__state::uo) is det.
-read_proc_id(Res) -->
- read_deep_byte(Res0),
+read_proc_id(Res, !IO) :-
+ read_deep_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- ( { Byte = token_isa_compiler_generated } ->
- read_proc_id_compiler_generated(Res)
- ; { Byte = token_isa_predicate } ->
- read_proc_id_user_defined(predicate, Res)
- ; { Byte = token_isa_function } ->
- read_proc_id_user_defined(function, Res)
- ;
- { format("unexpected proc_id_kind %d",
- [i(Byte)], Msg) },
- { Res = error(Msg) }
+ Res0 = ok(Byte),
+ ( Byte = token_isa_compiler_generated ->
+ read_proc_id_compiler_generated(Res, !IO)
+ ; Byte = token_isa_predicate ->
+ read_proc_id_user_defined(predicate, Res, !IO)
+ ; Byte = token_isa_function ->
+ read_proc_id_user_defined(function, Res, !IO)
+ ;
+ format("unexpected proc_id_kind %d",
+ [i(Byte)], Msg),
+ Res = error(Msg)
)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
:- pred read_proc_id_compiler_generated(maybe_error(proc_id)::out,
io__state::di, io__state::uo) is det.
-read_proc_id_compiler_generated(Res) -->
+read_proc_id_compiler_generated(Res, !IO) :-
io_combinator__maybe_error_sequence_6(
read_string,
read_string,
@@ -348,12 +348,12 @@
ProcId = ok(compiler_generated(TypeName, TypeModule,
DefModule, PredName, Arity, Mode))
),
- Res).
+ Res, !IO).
:- pred read_proc_id_user_defined(pred_or_func::in, maybe_error(proc_id)::out,
io__state::di, io__state::uo) is det.
-read_proc_id_user_defined(PredOrFunc, Res) -->
+read_proc_id_user_defined(PredOrFunc, Res, !IO) :-
io_combinator__maybe_error_sequence_5(
read_string,
read_string,
@@ -366,7 +366,7 @@
ProcId = ok(user_defined(PredOrFunc, DeclModule,
DefModule, Name, Arity, Mode))
),
- Res).
+ Res, !IO).
:- func raw_proc_id_to_string(proc_id) = string.
@@ -515,9 +515,9 @@
:- pred read_proc_dynamic(maybe_error2(proc_dynamic, int)::out,
io__state::di, io__state::uo) is det.
-read_proc_dynamic(Res) -->
+read_proc_dynamic(Res, !IO) :-
% DEBUGSITE
- % io__write_string("reading proc_dynamic.\n"),
+ % io__write_string("reading proc_dynamic.\n", !IO),
io_combinator__maybe_error_sequence_3(
read_ptr(pd),
read_ptr(ps),
@@ -525,209 +525,187 @@
(pred(PDI0::in, PSI0::in, N0::in, Stuff0::out) is det :-
Stuff0 = ok({PDI0, PSI0, N0})
),
- Res1),
+ Res1, !IO),
(
- { Res1 = ok({PDI, PSI, N}) },
- read_n_things(N, read_call_site_slot, Res2),
+ Res1 = ok({PDI, PSI, N}),
+ read_n_things(N, read_call_site_slot, Res2, !IO),
(
- { Res2 = ok(Refs) },
- { PSPtr = make_psptr(PSI) },
- { ProcDynamic = proc_dynamic(PSPtr, array(Refs)) },
- { Res = ok2(ProcDynamic, PDI) }
+ Res2 = ok(Refs),
+ PSPtr = make_psptr(PSI),
+ ProcDynamic = proc_dynamic(PSPtr, array(Refs)),
+ Res = ok2(ProcDynamic, PDI)
% DEBUGSITE
- % io__write_string("read proc_dynamic "),
- % io__write_int(PDI),
- % io__write_string(": "),
- % io__write(ProcDynamic),
- % io__write_string("\n")
+ % io__write_string("read proc_dynamic ", !IO),
+ % io__write_int(PDI, !IO),
+ % io__write_string(": ", !IO),
+ % io__write(ProcDynamic, !IO),
+ % io__write_string("\n", !IO)
;
- { Res2 = error(Err) },
- { Res = error2(Err) }
+ Res2 = error(Err),
+ Res = error2(Err)
)
;
- { Res1 = error(Err) },
- { Res = error2(Err) }
+ Res1 = error(Err),
+ Res = error2(Err)
).
:- pred read_call_site_dynamic(maybe_error2(call_site_dynamic, int)::out,
io__state::di, io__state::uo) is det.
-read_call_site_dynamic(Res) -->
+read_call_site_dynamic(Res, !IO) :-
% DEBUGSITE
- % io__write_string("reading call_site_dynamic.\n"),
- read_ptr(csd, Res1),
+ % io__write_string("reading call_site_dynamic.\n", !IO),
+ read_ptr(csd, Res1, !IO),
(
- { Res1 = ok(CSDI) },
- read_ptr(pd, Res2),
+ Res1 = ok(CSDI),
+ read_ptr(pd, Res2, !IO),
(
- { Res2 = ok(PDI) },
- read_profile(Res3),
+ Res2 = ok(PDI),
+ read_profile(Res3, !IO),
(
- { Res3 = ok(Profile) },
- { PDPtr = make_pdptr(PDI) },
- { CallerPDPtr = make_dummy_pdptr },
- { CallSiteDynamic = call_site_dynamic(
- CallerPDPtr, PDPtr, Profile) },
- { Res = ok2(CallSiteDynamic, CSDI) }
+ Res3 = ok(Profile),
+ PDPtr = make_pdptr(PDI),
+ CallerPDPtr = make_dummy_pdptr,
+ CallSiteDynamic = call_site_dynamic(
+ CallerPDPtr, PDPtr, Profile),
+ Res = ok2(CallSiteDynamic, CSDI)
% DEBUGSITE
- % io__write_string("read call_site_dynamic "),
- % io__write_int(CSDI),
- % io__write_string(": "),
- % io__write(CallSiteDynamic),
- % io__write_string("\n")
+ % io__write_string("read call_site_dynamic ",
+ % !IO),
+ % io__write_int(CSDI, !IO),
+ % io__write_string(": ", !IO),
+ % io__write(CallSiteDynamic, !IO),
+ % io__write_string("\n", !IO)
;
- { Res3 = error(Err) },
- { Res = error2(Err) }
+ Res3 = error(Err),
+ Res = error2(Err)
)
;
- { Res2 = error(Err) },
- { Res = error2(Err) }
+ Res2 = error(Err),
+ Res = error2(Err)
)
;
- { Res1 = error(Err) },
- { Res = error2(Err) }
+ Res1 = error(Err),
+ Res = error2(Err)
).
:- pred read_profile(maybe_error(own_prof_info)::out,
io__state::di, io__state::uo) is det.
-read_profile(Res) -->
- read_num(Res0),
+read_profile(Res, !IO) :-
+ read_num(Res0, !IO),
(
- { Res0 = ok(Mask) },
- { MaybeError1 = no },
- % { MaybeError0 = no },
- % Calls are computed from the other counts in measurements.m
- % ( { Mask /\ 0x0001 \= 0 } ->
- % maybe_read_num_handle_error(Calls,
- % MaybeError0, MaybeError1)
- % ;
- % { Calls = 0 },
- % { MaybeError1 = MaybeError0 }
- % ),
- ( { Mask /\ 0x0002 \= 0 } ->
- maybe_read_num_handle_error(Exits,
- MaybeError1, MaybeError2)
- ;
- { Exits = 0 },
- { MaybeError2 = MaybeError1 }
- ),
- ( { Mask /\ 0x0004 \= 0 } ->
- maybe_read_num_handle_error(Fails,
- MaybeError2, MaybeError3)
- ;
- { Fails = 0 },
- { MaybeError3 = MaybeError2 }
- ),
- ( { Mask /\ 0x0008 \= 0 } ->
- maybe_read_num_handle_error(Redos,
- MaybeError3, MaybeError4)
- ;
- { Redos = 0 },
- { MaybeError4 = MaybeError3 }
- ),
- ( { Mask /\ 0x0010 \= 0 } ->
- maybe_read_num_handle_error(Quanta,
- MaybeError4, MaybeError5)
- ;
- { Quanta = 0 },
- { MaybeError5 = MaybeError4 }
- ),
- ( { Mask /\ 0x0020 \= 0 } ->
- maybe_read_num_handle_error(Mallocs,
- MaybeError5, MaybeError6)
- ;
- { Mallocs = 0 },
- { MaybeError6 = MaybeError5 }
- ),
- ( { Mask /\ 0x0040 \= 0 } ->
- maybe_read_num_handle_error(Words,
- MaybeError6, MaybeError7)
- ;
- { Words = 0 },
- { MaybeError7 = MaybeError6 }
+ Res0 = ok(Mask),
+ some [!MaybeError] (
+ !:MaybeError = no,
+ % Calls are computed from the other counts in
+ % measurements.m.
+ % maybe_read_num_handle_error(Mask, 0x0001, Calls,
+ % !MaybeError, !IO),
+ maybe_read_num_handle_error(Mask, 0x0002, Exits,
+ !MaybeError, !IO),
+ maybe_read_num_handle_error(Mask, 0x0004, Fails,
+ !MaybeError, !IO),
+ maybe_read_num_handle_error(Mask, 0x0008, Redos,
+ !MaybeError, !IO),
+ maybe_read_num_handle_error(Mask, 0x0010, Quanta,
+ !MaybeError, !IO),
+ maybe_read_num_handle_error(Mask, 0x0020, Mallocs,
+ !MaybeError, !IO),
+ maybe_read_num_handle_error(Mask, 0x0040, Words,
+ !MaybeError, !IO),
+ LastMaybeError = !.MaybeError
),
(
- { MaybeError7 = yes(Error) },
- { Res = error(Error) }
+ LastMaybeError = yes(Error),
+ Res = error(Error)
;
- { MaybeError7 = no },
- { Res = ok(compress_profile(Exits, Fails, Redos,
- Quanta, Mallocs, Words)) }
+ LastMaybeError = no,
+ Res = ok(compress_profile(Exits, Fails, Redos,
+ Quanta, Mallocs, Words))
)
;
- { Res0 = error(Error) },
- { Res = error(Error) }
+ Res0 = error(Error),
+ Res = error(Error)
).
-:- pred maybe_read_num_handle_error(int::out,
+:- pred maybe_read_num_handle_error(int::in, int::in, int::out,
maybe(string)::in, maybe(string)::out,
io__state::di, io__state::uo) is det.
-maybe_read_num_handle_error(Value, MaybeError0, MaybeError) -->
- read_num(Res),
+maybe_read_num_handle_error(MaskWord, MaskValue, Num, !MaybeError, !IO) :-
+ ( MaskWord /\ MaskValue \= 0 ->
+ read_num(Res, !IO),
(
- { Res = ok(Value) },
- { MaybeError = MaybeError0 }
+ Res = ok(Num)
+ ;
+ Res = error(Error),
+ Num = 0,
+ !:MaybeError = yes(Error)
+ )
;
- { Res = error(Error) },
- { Value = 0 },
- { MaybeError = yes(Error) }
+ Num = 0
).
:- pred read_call_site_slot(maybe_error(call_site_array_slot)::out,
io__state::di, io__state::uo) is det.
-read_call_site_slot(Res) -->
+read_call_site_slot(Res, !IO) :-
% DEBUGSITE
- % io__write_string("reading call_site_slot.\n"),
- read_call_site_kind(Res1),
+ % io__write_string("reading call_site_slot.\n", !IO),
+ read_call_site_kind(Res1, !IO),
(
- { Res1 = ok(Kind) },
- ( { Kind = normal_call } ->
- read_ptr(csd, Res2),
- (
- { Res2 = ok(CSDI) },
- { CSDPtr = make_csdptr(CSDI) },
- { Res = ok(normal(CSDPtr)) }
+ Res1 = ok(Kind),
+ ( Kind = normal_call ->
+ read_ptr(csd, Res2, !IO),
+ (
+ Res2 = ok(CSDI),
+ CSDPtr = make_csdptr(CSDI),
+ Res = ok(normal(CSDPtr))
% DEBUGSITE
- % io__write_string("normal call_site slot "),
- % io__write_int(CSDI),
- % io__write_string("\n")
+ % io__write_string("normal call_site slot ",
+ % !IO),
+ % io__write_int(CSDI, !IO),
+ % io__write_string("\n", !IO)
;
- { Res2 = error(Err) },
- { Res = error(Err) }
+ Res2 = error(Err),
+ Res = error(Err)
)
;
- { ( Kind = higher_order_call ; Kind = method_call ) ->
+ (
+ ( Kind = higher_order_call
+ ; Kind = method_call
+ )
+ ->
Zeroed = zeroed
;
Zeroed = not_zeroed
- },
- read_multi_call_site_csdis(Res2),
+ ),
+ read_multi_call_site_csdis(Res2, !IO),
(
- { Res2 = ok(CSDIs) },
- { CSDPtrs = list__map(make_csdptr, CSDIs) },
- { Res = ok(multi(Zeroed, array(CSDPtrs))) }
+ Res2 = ok(CSDIs),
+ CSDPtrs = list__map(make_csdptr, CSDIs),
+ Res = ok(multi(Zeroed, array(CSDPtrs)))
% DEBUGSITE
- % io__write_string("multi call_site slots "),
- % io__write(CSDIs),
- % io__write_string("\n")
+ % io__write_string("multi call_site slots ",
+ % !IO),
+ % io__write(CSDIs, !IO),
+ % io__write_string("\n", !IO)
;
- { Res2 = error(Err) },
- { Res = error(Err) }
+ Res2 = error(Err),
+ Res = error(Err)
)
)
;
- { Res1 = error(Err) },
- { Res = error(Err) }
+ Res1 = error(Err),
+ Res = error(Err)
).
:- pred read_multi_call_site_csdis(maybe_error(list(int))::out,
io__state::di, io__state::uo) is det.
-read_multi_call_site_csdis(Res) -->
- read_multi_call_site_csdis_2([], Res).
+read_multi_call_site_csdis(Res, !IO) :-
+ read_multi_call_site_csdis_2([], Res, !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
@@ -742,143 +720,144 @@
:- pred read_multi_call_site_csdis_2(list(int)::in,
maybe_error(list(int))::out, io__state::di, io__state::uo) is det.
-read_multi_call_site_csdis_2(CSDIs0, Res) -->
+read_multi_call_site_csdis_2(CSDIs0, Res, !IO) :-
% DEBUGSITE
- % io__format("reading multi_call_site_csdi.\n", []),
- read_deep_byte(Res0),
+ % io__format("reading multi_call_site_csdi.\n", [], !IO),
+ read_deep_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- ( { Byte = 0 } ->
- { Res = ok(CSDIs0) }
+ Res0 = ok(Byte),
+ ( Byte = 0 ->
+ Res = ok(CSDIs0)
;
- putback_byte(Byte),
- read_ptr(csd, Res1),
+ putback_byte(Byte, !IO),
+ read_ptr(csd, Res1, !IO),
(
- { Res1 = ok(CSDI) },
+ Res1 = ok(CSDI),
read_multi_call_site_csdis_2([CSDI | CSDIs0],
- Res)
+ Res, !IO)
;
- { Res1 = error(Err) },
- { Res = error(Err) }
+ Res1 = error(Err),
+ Res = error(Err)
)
)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
:- pred read_call_site_kind(maybe_error(call_site_kind)::out,
io__state::di, io__state::uo) is det.
-read_call_site_kind(Res) -->
- read_deep_byte(Res0),
+read_call_site_kind(Res, !IO) :-
+ read_deep_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- ( { Byte = token_normal_call } ->
- { Res = ok(normal_call) }
- ; { Byte = token_special_call } ->
- { Res = ok(special_call) }
- ; { Byte = token_higher_order_call } ->
- { Res = ok(higher_order_call) }
- ; { Byte = token_method_call } ->
- { Res = ok(method_call) }
- ; { Byte = token_callback } ->
- { Res = ok(callback) }
- ;
- { format("unexpected call_site_kind %d",
- [i(Byte)], Msg) },
- { Res = error(Msg) }
+ Res0 = ok(Byte),
+ ( Byte = token_normal_call ->
+ Res = ok(normal_call)
+ ; Byte = token_special_call ->
+ Res = ok(special_call)
+ ; Byte = token_higher_order_call ->
+ Res = ok(higher_order_call)
+ ; Byte = token_method_call ->
+ Res = ok(method_call)
+ ; Byte = token_callback ->
+ Res = ok(callback)
+ ;
+ format("unexpected call_site_kind %d",
+ [i(Byte)], Msg),
+ Res = error(Msg)
)
% DEBUGSITE
- % io__write_string("call_site_kind "),
- % io__write(Res),
- % io__write_string("\n")
+ % io__write_string("call_site_kind ", !IO),
+ % io__write(Res, !IO),
+ % io__write_string("\n", !IO)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
:- pred read_call_site_kind_and_callee(
maybe_error(call_site_kind_and_callee)::out,
io__state::di, io__state::uo) is det.
-read_call_site_kind_and_callee(Res) -->
- read_deep_byte(Res0),
+read_call_site_kind_and_callee(Res, !IO) :-
+ read_deep_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- ( { Byte = token_normal_call } ->
- read_num(Res1),
+ Res0 = ok(Byte),
+ ( Byte = token_normal_call ->
+ read_num(Res1, !IO),
(
- { Res1 = ok(CalleeProcStatic) },
- read_string(Res2),
+ Res1 = ok(CalleeProcStatic),
+ read_string(Res2, !IO),
(
- { Res2 = ok(TypeSubst) },
- { Res = ok(normal_call(
+ Res2 = ok(TypeSubst),
+ Res = ok(normal_call(
proc_static_ptr(
CalleeProcStatic),
- TypeSubst)) }
+ TypeSubst))
;
- { Res2 = error(Err) },
- { Res = error(Err) }
+ Res2 = error(Err),
+ Res = error(Err)
)
;
- { Res1 = error(Err) },
- { Res = error(Err) }
+ Res1 = error(Err),
+ Res = error(Err)
)
- ; { Byte = token_special_call } ->
- { Res = ok(special_call) }
- ; { Byte = token_higher_order_call } ->
- { Res = ok(higher_order_call) }
- ; { Byte = token_method_call } ->
- { Res = ok(method_call) }
- ; { Byte = token_callback } ->
- { Res = ok(callback) }
- ;
- { format("unexpected call_site_kind %d",
- [i(Byte)], Msg) },
- { Res = error(Msg) }
+ ; Byte = token_special_call ->
+ Res = ok(special_call)
+ ; Byte = token_higher_order_call ->
+ Res = ok(higher_order_call)
+ ; Byte = token_method_call ->
+ Res = ok(method_call)
+ ; Byte = token_callback ->
+ Res = ok(callback)
+ ;
+ format("unexpected call_site_kind %d",
+ [i(Byte)], Msg),
+ Res = error(Msg)
)
% DEBUGSITE
- % io__write_string("call_site_kind_and_callee "),
- % io__write(Res),
- % io__write_string("\n")
+ % io__write_string("call_site_kind_and_callee ", !IO),
+ % io__write(Res, !IO),
+ % io__write_string("\n", !IO)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
%-----------------------------------------------------------------------------%
-:- pred read_n_things(int, pred(maybe_error(T), io__state, io__state),
- maybe_error(list(T)), io__state, io__state).
-:- mode read_n_things(in, pred(out, di, uo) is det, out, di, uo) is det.
+:- pred read_n_things(int::in, pred(maybe_error(T), io__state, io__state)::
+ in(pred(out, di, uo) is det), maybe_error(list(T))::out,
+ io::di, io::uo) is det.
-read_n_things(N, ThingReader, Res) -->
- read_n_things(N, ThingReader, [], Res0),
+read_n_things(N, ThingReader, Res, !IO) :-
+ read_n_things(N, ThingReader, [], Res0, !IO),
(
- { Res0 = ok(Things0) },
- { reverse(Things0, Things) },
- { Res = ok(Things) }
+ Res0 = ok(Things0),
+ reverse(Things0, Things),
+ Res = ok(Things)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
-:- pred read_n_things(int, pred(maybe_error(T), io__state, io__state),
- list(T), maybe_error(list(T)), io__state, io__state).
-:- mode read_n_things(in, pred(out, di, uo) is det, in, out, di, uo) is det.
+:- pred read_n_things(int::in, pred(maybe_error(T), io__state, io__state)::
+ in(pred(out, di, uo) is det), list(T)::in, maybe_error(list(T))::out,
+ io::di, io::uo) is det.
-read_n_things(N, ThingReader, Things0, Res) -->
- ( { N =< 0 } ->
- { Res = ok(Things0) }
+read_n_things(N, ThingReader, Things0, Res, !IO) :-
+ ( N =< 0 ->
+ Res = ok(Things0)
;
- call(ThingReader, Res1),
+ call(ThingReader, Res1, !IO),
(
- { Res1 = ok(Thing) },
- read_n_things(N - 1, ThingReader, [Thing|Things0], Res)
+ Res1 = ok(Thing),
+ read_n_things(N - 1, ThingReader, [Thing | Things0],
+ Res, !IO)
;
- { Res1 = error(Err) },
- { Res = error(Err) }
+ Res1 = error(Err),
+ Res = error(Err)
)
).
@@ -887,85 +866,85 @@
:- pred read_string(maybe_error(string)::out,
io__state::di, io__state::uo) is det.
-read_string(Res) -->
- read_num(Res0),
+read_string(Res, !IO) :-
+ read_num(Res0, !IO),
(
- { Res0 = ok(Length) },
- ( { Length = 0 } ->
- { Res = ok("") }
+ Res0 = ok(Length),
+ ( Length = 0 ->
+ Res = ok("")
;
- read_n_byte_string(Length, Res)
+ read_n_byte_string(Length, Res, !IO)
)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
:- pred read_n_byte_string(int::in, maybe_error(string)::out,
io__state::di, io__state::uo) is det.
-read_n_byte_string(Length, Res) -->
- read_n_bytes(Length, Res1),
+read_n_byte_string(Length, Res, !IO) :-
+ read_n_bytes(Length, Res1, !IO),
(
- { Res1 = ok(Bytes) },
+ Res1 = ok(Bytes),
(
- { map((pred(I::in, C::out) is semidet :-
+ map((pred(I::in, C::out) is semidet :-
char__to_int(C, I)
- ), Bytes, Chars) }
+ ), Bytes, Chars)
->
- { string__from_char_list(Chars, Str) },
- { Res = ok(Str) }
+ string__from_char_list(Chars, Str),
+ Res = ok(Str)
;
- { Res = error("string contained bad char") }
+ Res = error("string contained bad char")
)
;
- { Res1 = error(Err) },
- { Res = error(Err) }
+ Res1 = error(Err),
+ Res = error(Err)
).
% DEBUGSITE
- % io__write_string("string "),
- % io__write(Res),
- % io__write_string("\n").
+ % io__write_string("string ", !IO),
+ % io__write(Res, !IO),
+ % io__write_string("\n", !IO).
:- pred read_ptr(ptr_kind::in, maybe_error(int)::out,
io__state::di, io__state::uo) is det.
-read_ptr(_Kind, Res) -->
- read_num1(0, Res).
+read_ptr(_Kind, Res, !IO) :-
+ read_num1(0, Res, !IO).
% DEBUGSITE
- % io__write_string("ptr "),
- % io__write(Res),
- % io__write_string("\n").
+ % io__write_string("ptr ", !IO),
+ % io__write(Res, !IO),
+ % io__write_string("\n", !IO).
:- pred read_num(maybe_error(int)::out, io__state::di, io__state::uo) is det.
-read_num(Res) -->
- read_num1(0, Res).
+read_num(Res, !IO) :-
+ read_num1(0, Res, !IO).
% DEBUGSITE
- % io__write_string("num "),
- % io__write(Res),
- % io__write_string("\n").
+ % io__write_string("num ", !IO),
+ % io__write(Res, !IO),
+ % io__write_string("\n", !IO).
:- pred read_num1(int::in, maybe_error(int)::out,
io__state::di, io__state::uo) is det.
-read_num1(Num0, Res) -->
- read_byte(Res0),
+read_num1(Num0, Res, !IO) :-
+ read_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- { Num1 = (Num0 << 7) \/ (Byte /\ 0x7F) },
- ( { Byte /\ 0x80 \= 0 } ->
- read_num1(Num1, Res)
+ Res0 = ok(Byte),
+ Num1 = (Num0 << 7) \/ (Byte /\ 0x7F),
+ ( Byte /\ 0x80 \= 0 ->
+ read_num1(Num1, Res, !IO)
;
- { Res = ok(Num1) }
+ Res = ok(Num1)
)
;
- { Res0 = eof },
- { Res = error("unexpected end of file") }
+ Res0 = eof,
+ Res = error("unexpected end of file")
;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- { Res = error(Msg) }
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ Res = error(Msg)
).
:- func fixed_size_int_bytes = int.
@@ -978,78 +957,78 @@
:- pred read_fixed_size_int(maybe_error(int)::out,
io__state::di, io__state::uo) is det.
-read_fixed_size_int(Res) -->
- read_fixed_size_int1(fixed_size_int_bytes, 0, 0, Res).
+read_fixed_size_int(Res, !IO) :-
+ read_fixed_size_int1(fixed_size_int_bytes, 0, 0, Res, !IO).
:- pred read_fixed_size_int1(int::in, int::in, int::in, maybe_error(int)::out,
io__state::di, io__state::uo) is det.
-read_fixed_size_int1(BytesLeft, Num0, ShiftBy, Res) -->
- ( { BytesLeft =< 0 } ->
- { Res = ok(Num0) }
+read_fixed_size_int1(BytesLeft, Num0, ShiftBy, Res, !IO) :-
+ ( BytesLeft =< 0 ->
+ Res = ok(Num0)
;
- read_deep_byte(Res0),
+ read_deep_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- { Num1 = Num0 \/ ( Byte << ShiftBy) },
+ Res0 = ok(Byte),
+ Num1 = Num0 \/ ( Byte << ShiftBy),
read_fixed_size_int1(BytesLeft - 1, Num1, ShiftBy + 8,
- Res)
+ Res, !IO)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
)
).
:- pred read_n_bytes(int::in, maybe_error(list(int))::out,
io__state::di, io__state::uo) is det.
-read_n_bytes(N, Res) -->
- read_n_bytes(N, [], Res0),
+read_n_bytes(N, Res, !IO) :-
+ read_n_bytes(N, [], Res0, !IO),
(
- { Res0 = ok(Bytes0) },
- { reverse(Bytes0, Bytes) },
- { Res = ok(Bytes) }
+ Res0 = ok(Bytes0),
+ reverse(Bytes0, Bytes),
+ Res = ok(Bytes)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
).
:- pred read_n_bytes(int::in, list(int)::in, maybe_error(list(int))::out,
io__state::di, io__state::uo) is det.
-read_n_bytes(N, Bytes0, Res) -->
- ( { N =< 0 } ->
- { Res = ok(Bytes0) }
+read_n_bytes(N, Bytes0, Res, !IO) :-
+ ( N =< 0 ->
+ Res = ok(Bytes0)
;
- read_deep_byte(Res0),
+ read_deep_byte(Res0, !IO),
(
- { Res0 = ok(Byte) },
- read_n_bytes(N - 1, [Byte | Bytes0], Res)
+ Res0 = ok(Byte),
+ read_n_bytes(N - 1, [Byte | Bytes0], Res, !IO)
;
- { Res0 = error(Err) },
- { Res = error(Err) }
+ Res0 = error(Err),
+ Res = error(Err)
)
).
:- pred read_deep_byte(maybe_error(int)::out,
io__state::di, io__state::uo) is det.
-read_deep_byte(Res) -->
- read_byte(Res0),
+read_deep_byte(Res, !IO) :-
+ read_byte(Res0, !IO),
% DEBUGSITE
- % io__write_string("byte "),
- % io__write(Res),
- % io__write_string("\n"),
- (
- { Res0 = ok(Byte) },
- { Res = ok(Byte) }
- ;
- { Res0 = eof },
- { Res = error("unexpected end of file") }
- ;
- { Res0 = error(Err) },
- { io__error_message(Err, Msg) },
- { Res = error(Msg) }
+ % io__write_string("byte ", !IO),
+ % io__write(Res, !IO),
+ % io__write_string("\n", !IO),
+ (
+ Res0 = ok(Byte),
+ Res = ok(Byte)
+ ;
+ Res0 = eof,
+ Res = error("unexpected end of file")
+ ;
+ Res0 = error(Err),
+ io__error_message(Err, Msg),
+ Res = error(Msg)
).
%------------------------------------------------------------------------------%
--- /home/zs/mer/ws00/deep_profiler/startup.m 2002-12-02 22:24:35.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/startup.m 2004-01-12 15:29:12.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 The University of Melbourne.
+% Copyright (C) 2001-2002, 2004 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.
%-----------------------------------------------------------------------------%
@@ -31,103 +31,107 @@
:- import_module std_util, int, string, array, assoc_list, set, map, require.
% :- import_module unsafe.
-read_and_startup(Machine, DataFileNames, Canonical, MaybeOutputStream, Res) -->
+read_and_startup(Machine, DataFileNames, Canonical, MaybeOutputStream, Res,
+ !IO) :-
(
- { DataFileNames = [] },
+ DataFileNames = [],
% This should have been caught and reported by main.
- { error("read_and_startup: no data files") }
+ error("read_and_startup: no data files")
;
- { DataFileNames = [DataFileName] },
- maybe_report_stats(MaybeOutputStream),
+ DataFileNames = [DataFileName],
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Reading graph data...\n"),
- read_call_graph(DataFileName, Res0),
+ " Reading graph data...\n", !IO),
+ read_call_graph(DataFileName, Res0, !IO),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
(
- { Res0 = ok(InitDeep) },
+ Res0 = ok(InitDeep),
startup(Machine, DataFileName, Canonical,
- MaybeOutputStream, InitDeep, Deep),
- { Res = ok(Deep) }
+ MaybeOutputStream, InitDeep, Deep, !IO),
+ Res = ok(Deep)
;
- { Res0 = error(Error) },
- { Res = error(Error) }
+ Res0 = error(Error),
+ Res = error(Error)
)
;
- { DataFileNames = [_, _ | _] },
- { error("mdprof_server: merging of data files is not yet implemented") }
+ DataFileNames = [_, _ | _],
+ error("mdprof_server: merging of data files " ++
+ "is not yet implemented")
).
:- pred startup(string::in, string::in, bool::in, maybe(io__output_stream)::in,
initial_deep::in, deep::out, io__state::di, io__state::uo) is det.
-startup(Machine, DataFileName, Canonical, MaybeOutputStream, InitDeep0, Deep)
- -->
- { InitDeep0 = initial_deep(InitStats, Root,
+startup(Machine, DataFileName, Canonical, MaybeOutputStream, InitDeep0, Deep,
+ !IO) :-
+ InitDeep0 = initial_deep(InitStats, Root,
CallSiteDynamics0, ProcDynamics,
- CallSiteStatics0, ProcStatics0) },
+ CallSiteStatics0, ProcStatics0),
maybe_report_msg(MaybeOutputStream,
- " Mapping static call sites to containing procedures...\n"),
- { array_foldl2_from_1(record_css_containers_module_procs, ProcStatics0,
+ " Mapping static call sites to containing procedures...\n",
+ !IO),
+ array_foldl2_from_1(record_css_containers_module_procs, ProcStatics0,
u(CallSiteStatics0), CallSiteStatics,
- map__init, ModuleProcs) },
+ map__init, ModuleProcs),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Mapping dynamic call sites to containing procedures...\n"),
- { array_foldl2_from_1(record_csd_containers_zeroed_pss, ProcDynamics,
+ " Mapping dynamic call sites to containing procedures...\n",
+ !IO),
+ array_foldl2_from_1(record_csd_containers_zeroed_pss, ProcDynamics,
u(CallSiteDynamics0), CallSiteDynamics,
- u(ProcStatics0), ProcStatics) },
+ u(ProcStatics0), ProcStatics),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
- { InitDeep1 = initial_deep(InitStats, Root,
+ InitDeep1 = initial_deep(InitStats, Root,
CallSiteDynamics, ProcDynamics,
- CallSiteStatics, ProcStatics) },
+ CallSiteStatics, ProcStatics),
(
- { Canonical = no },
- { InitDeep = InitDeep1 }
+ Canonical = no,
+ InitDeep = InitDeep1
;
- { Canonical = yes },
+ Canonical = yes,
maybe_report_msg(MaybeOutputStream,
- " Canonicalizing cliques...\n"),
- { canonicalize_cliques(InitDeep1, InitDeep) },
+ " Canonicalizing cliques...\n", !IO),
+ canonicalize_cliques(InitDeep1, InitDeep),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream)
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO)
),
- { array__max(InitDeep ^ init_proc_dynamics, PDMax) },
- { NPDs = PDMax + 1 },
- { array__max(InitDeep ^ init_call_site_dynamics, CSDMax) },
- { NCSDs = CSDMax + 1 },
- { array__max(InitDeep ^ init_proc_statics, PSMax) },
- { NPSs = PSMax + 1 },
- { array__max(InitDeep ^ init_call_site_statics, CSSMax) },
- { NCSSs = CSSMax + 1 },
+ array__max(InitDeep ^ init_proc_dynamics, PDMax),
+ NPDs = PDMax + 1,
+ array__max(InitDeep ^ init_call_site_dynamics, CSDMax),
+ NCSDs = CSDMax + 1,
+ array__max(InitDeep ^ init_proc_statics, PSMax),
+ NPSs = PSMax + 1,
+ array__max(InitDeep ^ init_call_site_statics, CSSMax),
+ NCSSs = CSSMax + 1,
maybe_report_msg(MaybeOutputStream,
- " Finding cliques...\n"),
- { find_cliques(InitDeep, CliqueList) },
+ " Finding cliques...\n", !IO),
+ find_cliques(InitDeep, CliqueList),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Constructing clique indexes...\n"),
- { make_clique_indexes(NPDs, CliqueList, Cliques, CliqueIndex) },
+ " Constructing clique indexes...\n", !IO),
+ make_clique_indexes(NPDs, CliqueList, Cliques, CliqueIndex),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Constructing clique parent map...\n"),
+ " Constructing clique parent map...\n", !IO),
% For each CallSiteDynamic pointer, if it points to
% a ProcDynamic which is in a different clique to
@@ -136,83 +140,83 @@
% the [lower] clique. We need to compute this information
% so that we can print clique-based timing summaries in
% the browser.
- { array__max(Cliques, CliqueMax) },
- { NCliques = CliqueMax + 1 },
- { array__init(NCliques, call_site_dynamic_ptr(-1), CliqueParents0) },
- { array__init(NCSDs, no, CliqueMaybeChildren0) },
- { array_foldl2_from_1(construct_clique_parents(InitDeep, CliqueIndex),
+ array__max(Cliques, CliqueMax),
+ NCliques = CliqueMax + 1,
+ array__init(NCliques, call_site_dynamic_ptr(-1), CliqueParents0),
+ array__init(NCSDs, no, CliqueMaybeChildren0),
+ array_foldl2_from_1(construct_clique_parents(InitDeep, CliqueIndex),
CliqueIndex,
CliqueParents0, CliqueParents,
- CliqueMaybeChildren0, CliqueMaybeChildren) },
+ CliqueMaybeChildren0, CliqueMaybeChildren),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Finding procedure callers...\n"),
- { array__init(NPSs, [], ProcCallers0) },
- { array_foldl_from_1(construct_proc_callers(InitDeep),
- CallSiteDynamics, ProcCallers0, ProcCallers) },
+ " Finding procedure callers...\n", !IO),
+ array__init(NPSs, [], ProcCallers0),
+ array_foldl_from_1(construct_proc_callers(InitDeep),
+ CallSiteDynamics, ProcCallers0, ProcCallers),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Constructing call site static map...\n"),
- { array__init(NCSDs, call_site_static_ptr(-1), CallSiteStaticMap0) },
- { array_foldl_from_1(construct_call_site_caller(InitDeep),
- ProcDynamics, CallSiteStaticMap0, CallSiteStaticMap) },
+ " Constructing call site static map...\n", !IO),
+ array__init(NCSDs, call_site_static_ptr(-1), CallSiteStaticMap0),
+ array_foldl_from_1(construct_call_site_caller(InitDeep),
+ ProcDynamics, CallSiteStaticMap0, CallSiteStaticMap),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Finding call site calls...\n"),
- { array__init(NCSSs, map__init, CallSiteCalls0) },
- { array_foldl_from_1(construct_call_site_calls(InitDeep),
- ProcDynamics, CallSiteCalls0, CallSiteCalls) },
+ " Finding call site calls...\n", !IO),
+ array__init(NCSSs, map__init, CallSiteCalls0),
+ array_foldl_from_1(construct_call_site_calls(InitDeep),
+ ProcDynamics, CallSiteCalls0, CallSiteCalls),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Propagating time up call graph...\n"),
+ " Propagating time up call graph...\n", !IO),
- { array__init(NCSDs, zero_inherit_prof_info, CSDDesc0) },
- { array__init(NPDs, zero_own_prof_info, PDOwn0) },
- { array_foldl_from_1(sum_call_sites_in_proc_dynamic,
- CallSiteDynamics, PDOwn0, PDOwn) },
- { array__init(NPDs, zero_inherit_prof_info, PDDesc0) },
- { array__init(NPSs, zero_own_prof_info, PSOwn0) },
- { array__init(NPSs, zero_inherit_prof_info, PSDesc0) },
- { array__init(NCSSs, zero_own_prof_info, CSSOwn0) },
- { array__init(NCSSs, zero_inherit_prof_info, CSSDesc0) },
- { array__init(NPDs, map__init, PDCompTable0) },
- { array__init(NCSDs, map__init, CSDCompTable0) },
+ array__init(NCSDs, zero_inherit_prof_info, CSDDesc0),
+ array__init(NPDs, zero_own_prof_info, PDOwn0),
+ array_foldl_from_1(sum_call_sites_in_proc_dynamic,
+ CallSiteDynamics, PDOwn0, PDOwn),
+ array__init(NPDs, zero_inherit_prof_info, PDDesc0),
+ array__init(NPSs, zero_own_prof_info, PSOwn0),
+ array__init(NPSs, zero_inherit_prof_info, PSDesc0),
+ array__init(NCSSs, zero_own_prof_info, CSSOwn0),
+ array__init(NCSSs, zero_inherit_prof_info, CSSDesc0),
+ array__init(NPDs, map__init, PDCompTable0),
+ array__init(NCSDs, map__init, CSDCompTable0),
- { ModuleData = map__map_values(initialize_module_data, ModuleProcs) },
- { Deep0 = deep(InitStats, Machine, DataFileName, Root,
+ ModuleData = map__map_values(initialize_module_data, ModuleProcs),
+ Deep0 = deep(InitStats, Machine, DataFileName, Root,
CallSiteDynamics, ProcDynamics, CallSiteStatics, ProcStatics,
CliqueIndex, Cliques, CliqueParents, CliqueMaybeChildren,
ProcCallers, CallSiteStaticMap, CallSiteCalls,
PDOwn, PDDesc0, CSDDesc0,
PSOwn0, PSDesc0, CSSOwn0, CSSDesc0,
- PDCompTable0, CSDCompTable0, ModuleData) },
+ PDCompTable0, CSDCompTable0, ModuleData),
- { array_foldl_from_1(propagate_to_clique, Cliques, Deep0, Deep1) },
+ array_foldl_from_1(propagate_to_clique, Cliques, Deep0, Deep1),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream),
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO),
maybe_report_msg(MaybeOutputStream,
- " Summarizing information...\n"),
- { summarize_proc_dynamics(Deep1, Deep2) },
- { summarize_call_site_dynamics(Deep2, Deep3) },
- { summarize_modules(Deep3, Deep) },
+ " Summarizing information...\n", !IO),
+ summarize_proc_dynamics(Deep1, Deep2),
+ summarize_call_site_dynamics(Deep2, Deep3),
+ summarize_modules(Deep3, Deep),
maybe_report_msg(MaybeOutputStream,
- " Done.\n"),
- maybe_report_stats(MaybeOutputStream).
+ " Done.\n", !IO),
+ maybe_report_stats(MaybeOutputStream, !IO).
:- pred count_quanta(int::in, call_site_dynamic::in, int::in, int::out) is det.
@@ -728,8 +732,8 @@
PSPtr = PD ^ pd_proc_static,
deep_lookup_proc_statics(Deep2, PSPtr, PS),
( PS ^ ps_is_zeroed = zeroed ->
- OverrideTable = add_to_override(OverrideTable0,
- PSPtr, ProcTotal)
+ OverrideTable = add_to_override(OverrideTable0, PSPtr,
+ ProcTotal)
;
OverrideTable = OverrideTable0
),
@@ -873,17 +877,17 @@
%
% The stats are needed only when writing the deep profiling paper anyway.
-maybe_report_stats(yes(_OutputStream)) --> [].
- % io__report_stats("standard").
-maybe_report_stats(no) --> [].
+maybe_report_stats(yes(_OutputStream), !IO).
+ % io__report_stats("standard", !IO).
+maybe_report_stats(no, !IO).
:- pred maybe_report_msg(maybe(io__output_stream)::in, string::in,
io__state::di, io__state::uo) is det.
-maybe_report_msg(yes(OutputStream), Msg) -->
- io__write_string(OutputStream, Msg),
- flush_output(OutputStream).
-maybe_report_msg(no, _) --> [].
+maybe_report_msg(yes(OutputStream), Msg, !IO) :-
+ io__write_string(OutputStream, Msg, !IO),
+ flush_output(OutputStream, !IO).
+maybe_report_msg(no, _, !IO).
%-----------------------------------------------------------------------------%
@@ -892,73 +896,72 @@
% :- pred print_pdis(initial_deep::in, list(int)::in,
% io__state::di, io__state::uo) is det.
%
-% print_pdis(InitDeep, PDIs) -->
-% io__nl,
-% io__write_list(PDIs, "", print_pdi_nl(InitDeep)).
+% print_pdis(InitDeep, PDIs, !IO) :-
+% io__nl(!IO),
+% io__write_list(PDIs, "", print_pdi_nl(InitDeep), !IO).
%
% :- pred print_pdi_nl(initial_deep::in, int::in, io__state::di, io__state::uo)
% is det.
%
-% print_pdi_nl(InitDeep, PDI) -->
-% print_pdi(InitDeep, PDI),
-% io__nl.
+% print_pdi_nl(InitDeep, PDI, !IO) :-
+% print_pdi(InitDeep, PDI, !IO),
+% io__nl(!IO).
%
% :- pred print_pdi(initial_deep::in, int::in, io__state::di, io__state::uo)
% is det.
%
-% print_pdi(InitDeep, PDI) -->
-% { PDIsTmp = InitDeep ^ init_proc_dynamics },
-% { lookup_proc_dynamics(PDIsTmp, proc_dynamic_ptr(PDI), PD) },
-% io__format("pd %d: ", [i(PDI)]),
-% io__write(PD),
-% io__nl,
-% { proc_static_ptr(PSI) = PD ^ pd_proc_static },
-% { PSIsTmp = InitDeep ^ init_proc_statics },
-% { lookup_proc_statics(PSIsTmp, proc_static_ptr(PSI), PS) },
-% io__format("ps %d: ", [i(PSI)]),
-% io__write(PS),
-% io__nl.
+% print_pdi(InitDeep, PDI, !IO) :-
+% PDIsTmp = InitDeep ^ init_proc_dynamics,
+% lookup_proc_dynamics(PDIsTmp, proc_dynamic_ptr(PDI), PD),
+% io__format("pd %d: ", [i(PDI)], !IO),
+% io__write(PD, !IO),
+% io__nl(!IO),
+% proc_static_ptr(PSI) = PD ^ pd_proc_static,
+% PSIsTmp = InitDeep ^ init_proc_statics,
+% lookup_proc_statics(PSIsTmp, proc_static_ptr(PSI), PS),
+% io__format("ps %d: ", [i(PSI)], !IO),
+% io__write(PS, !IO),
+% io__nl(!IO).
%
% :- pred print_csdis(initial_deep::in, list(int)::in,
% io__state::di, io__state::uo) is det.
%
-% print_csdis(InitDeep, CSDIs) -->
-% io__nl,
-% io__write_list(CSDIs, "", print_csdi_nl(InitDeep)).
+% print_csdis(InitDeep, CSDIs, !IO) :-
+% io__nl(!IO),
+% io__write_list(CSDIs, "", print_csdi_nl(InitDeep), !IO).
%
% :- pred print_csdi_nl(initial_deep::in, int::in, io__state::di, io__state::uo)
% is det.
%
-% print_csdi_nl(InitDeep, CSDI) -->
-% print_csdi(InitDeep, CSDI),
-% io__nl.
+% print_csdi_nl(InitDeep, CSDI, !IO) :-
+% print_csdi(InitDeep, CSDI, !IO),
+% io__nl(!IO).
%
% :- pred print_csdi(initial_deep::in, int::in, io__state::di, io__state::uo)
% is det.
%
-% print_csdi(InitDeep, CSDI) -->
-% { CSDIsTmp = InitDeep ^ init_call_site_dynamics },
-% { lookup_call_site_dynamics(CSDIsTmp, call_site_dynamic_ptr(CSDI),
-% CSD) },
-% io__format("csd %d: ", [i(CSDI)]),
-% io__write(CSD),
-% io__nl,
-% io__write_string("caller pd:\n"),
-% { proc_dynamic_ptr(CallerPDI) = CSD ^ csd_caller },
-% print_pdi(InitDeep, CallerPDI),
-% io__write_string("callee pd:\n"),
-% { proc_dynamic_ptr(CalleePDI) = CSD ^ csd_callee },
-% print_pdi(InitDeep, CalleePDI).
+% print_csdi(InitDeep, CSDI, !IO) :-
+% CSDIsTmp = InitDeep ^ init_call_site_dynamics,
+% lookup_call_site_dynamics(CSDIsTmp, call_site_dynamic_ptr(CSDI), CSD),
+% io__format("csd %d: ", [i(CSDI)], !IO),
+% io__write(CSD, !IO),
+% io__nl(!IO),
+% io__write_string("caller pd:\n", !IO),
+% proc_dynamic_ptr(CallerPDI) = CSD ^ csd_caller,
+% print_pdi(InitDeep, CallerPDI, !IO),
+% io__write_string("callee pd:\n", !IO),
+% proc_dynamic_ptr(CalleePDI) = CSD ^ csd_callee,
+% print_pdi(InitDeep, CalleePDI, !IO).
%
% :- pred write_pdi_cn_csd(int::in, int::in, int::in,
% io__state::di, io__state::uo) is det.
%
-% write_pdi_cn_csd(PDI, CN, CSDI) -->
-% io__write_string("pdi "),
-% io__write_int(PDI),
-% io__write_string(", cn "),
-% io__write_int(CN),
-% io__write_string(", csdi "),
-% io__write_int(CSDI),
-% io__nl,
-% io__flush_output.
+% write_pdi_cn_csd(PDI, CN, CSDI, !IO) :-
+% io__write_string("pdi ", !IO),
+% io__write_int(PDI, !IO),
+% io__write_string(", cn ", !IO),
+% io__write_int(CN, !IO),
+% io__write_string(", csdi ", !IO),
+% io__write_int(CSDI, !IO),
+% io__nl(!IO),
+% io__flush_output(!IO).
--- /home/zs/mer/ws00/deep_profiler/timeout.m 2002-12-03 18:41:40.000000000 +1100
+++ /home/zs/mer/ws0/deep_profiler/timeout.m 2004-01-12 15:29:12.000000000 +1100
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 The University of Melbourne.
+% Copyright (C) 2001-2002, 2004 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.
%-----------------------------------------------------------------------------%
@@ -592,20 +592,20 @@
%-----------------------------------------------------------------------------%
-get_lock(Debug, MutexFile) -->
+get_lock(Debug, MutexFile, !IO) :-
(
- { Debug = yes }
+ Debug = yes
;
- { Debug = no },
- do_get_lock(MutexFile)
+ Debug = no,
+ do_get_lock(MutexFile, !IO)
).
-release_lock(Debug, MutexFile) -->
+release_lock(Debug, MutexFile, !IO) :-
(
- { Debug = yes }
+ Debug = yes
;
- { Debug = no },
- do_release_lock(MutexFile)
+ Debug = no,
+ do_release_lock(MutexFile, !IO)
).
:- pred do_get_lock(string::in, io__state::di, io__state::uo) is det.
Diffing notes
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list