[m-rev.] ssdb code reorganization
Olivier Annet
oan at missioncriticalit.com
Mon Oct 29 17:09:51 AEDT 2007
Hi,
Could someone review my code please.
Olivier.
===================================================================
Estimated hours taken: 2
Branches: main
The code has been reorganized for optimization reasons.
compiler/ssdebug.m:
Four different predicates (one for each different event type) have
been made because, in the futur, they could recieve differents
arguments.
ssdb/ssdb.m:
Four different predicates of handle_event (one for each different
event type) have been made because there are some differences in their
body.
Different predicates (set_stop, print_event_info and set_next_stop)
have been made because a lot of code are share in each handle
event.
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.7
diff -u -r1.7 ssdebug.m
--- compiler/ssdebug.m 29 Oct 2007 03:00:43 -0000 1.7
+++ compiler/ssdebug.m 29 Oct 2007 05:55:22 -0000
@@ -250,8 +250,8 @@
%
% Generate the call to handle_event(call).
%
- make_call_handle_event(ssdb_call, ProcIdVar, CallArgListVar,
- HandleEventCallGoals, !ModuleInfo, !Varset, !Vartypes),
+ make_handle_event_call(ProcIdVar, CallArgListVar, HandleEventCallGoal,
+ !ModuleInfo, !Varset, !Vartypes),
%
% Get the updated InstMap.
@@ -280,16 +280,16 @@
%
% Generate the call to handle_event(exit).
%
- make_call_handle_event(ssdb_exit, ProcIdVar, ExitArgListVar,
- HandleEventExitGoals, !ModuleInfo, !Varset, !Vartypes),
+ make_handle_event_exit(ProcIdVar, ExitArgListVar, HandleEventExitGoal,
+ !ModuleInfo, !Varset, !Vartypes),
%
% Organize the order of the generated code.
%
- ConjGoals = ProcIdGoals ++ CallArgListGoals ++ HandleEventCallGoals ++
- [BodyGoal1 | ExitArgListGoals] ++ HandleEventExitGoals ++
- RenamingGoals,
+ ConjGoals = ProcIdGoals ++ CallArgListGoals ++ [HandleEventCallGoal,
+ BodyGoal1 | ExitArgListGoals] ++ [HandleEventExitGoal |
+ RenamingGoals],
goal_info_init(GoalInfoWP),
GoalWithoutPurity = hlds_goal(conj(plain_conj, ConjGoals), GoalInfoWP),
@@ -351,8 +351,8 @@
%
% Generate the call to handle_event(call).
%
- make_call_handle_event(ssdb_call, ProcIdVar, CallArgListVar,
- HandleEventCallGoals, !ModuleInfo, !Varset, !Vartypes),
+ make_handle_event_call(ProcIdVar, CallArgListVar, HandleEventCallGoal,
+ !ModuleInfo, !Varset, !Vartypes),
%
% Get the updated InstMap.
@@ -381,8 +381,8 @@
%
% Generate the call to handle_event(exit).
%
- make_call_handle_event(ssdb_exit, ProcIdVar, ExitArgListVar,
- HandleEventExitGoals, !ModuleInfo, !Varset, !Vartypes),
+ make_handle_event_exit(ProcIdVar, ExitArgListVar, HandleEventExitGoal,
+ !ModuleInfo, !Varset, !Vartypes),
%
@@ -395,8 +395,8 @@
%
% Generate the call to handle_event(fail).
%
- make_call_handle_event(ssdb_fail, ProcIdVar, FailArgListVar,
- HandleEventFailGoals, !ModuleInfo, !Varset, !Vartypes),
+ make_handle_event_fail(ProcIdVar, FailArgListVar, HandleEventFailGoal,
+ !ModuleInfo, !Varset, !Vartypes),
make_fail_call(FailGoal, !.ModuleInfo),
@@ -405,8 +405,8 @@
% Organize the order of the generated code.
%
GoalsCond = [BodyGoal1],
- GoalsThen = ExitArgListGoals ++ HandleEventExitGoals ++ RenamingGoals,
- GoalsElse = FailArgListGoals ++ HandleEventFailGoals ++ [FailGoal],
+ GoalsThen = ExitArgListGoals ++ [HandleEventExitGoal| RenamingGoals],
+ GoalsElse = FailArgListGoals ++ [HandleEventFailGoal, FailGoal],
goal_info_init(GoalInfo0),
goal_list_determinism(GoalsCond, Detism),
@@ -420,27 +420,27 @@
ThenGoal = hlds_goal(conj(plain_conj, GoalsThen), GoalInfoThen),
ElseGoal = hlds_goal(conj(plain_conj, GoalsElse), GoalInfoElse),
- CallVarGoal = ProcIdGoals ++ CallArgListGoals ++ HandleEventCallGoals,
+ CallVarGoal = ProcIdGoals ++ CallArgListGoals ++ [HandleEventCallGoal],
% XXX not sure about determinism.
GoalITE = hlds_goal(if_then_else(IteExistVars, CondGoal, ThenGoal,
ElseGoal), GoalInfoCond),
@@ -467,30 +467,84 @@
%-----------------------------------------------------------------------------%
+ %
+ % Build the following goal : handle_event_call(ProcId, Arguments).
+ %
+:- pred make_handle_event_call(prog_var::in, prog_var::in, hlds_goal::out,
+ module_info::in, module_info::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out) is det.
+
+make_handle_event_call(ProcIdVar, ArgListVar, HandleEventGoal, !ModuleInfo,
+ !Varset, !Vartypes) :-
+
+ SSDBModule = mercury_ssdb_builtin_module,
+ Features = [],
+ InstMapSrc = [],
+ Context = term.context_init,
+ goal_util.generate_simple_call(SSDBModule, "handle_event_call",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [ProcIdVar, ArgListVar], Features, InstMapSrc, !.ModuleInfo, Context,
+ HandleEventGoal).
+
%
- % Build the following goal : handle_event(ProcId, Event, Arguments).
+ % Build the following goal : handle_event_exit(ProcId, Arguments).
%
-:- pred make_call_handle_event(ssdb_event_type::in, prog_var::in,
- prog_var::in, list(hlds_goal)::out, module_info::in, module_info::out,
- prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
+:- pred make_handle_event_exit(prog_var::in, prog_var::in, hlds_goal::out,
+ module_info::in, module_info::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out) is det.
-make_call_handle_event(Event, ProcIdVar, ArgListVar, Goals, !ModuleInfo,
+make_handle_event_exit(ProcIdVar, ArgListVar, HandleEventGoal, !ModuleInfo,
!Varset, !Vartypes) :-
- make_ssdb_event_type_construction(Event, EventConstructor, EventVar,
- !Varset, !Vartypes),
+ SSDBModule = mercury_ssdb_builtin_module,
+ Features = [],
+ InstMapSrc = [],
+ Context = term.context_init,
+ goal_util.generate_simple_call(SSDBModule, "handle_event_exit",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [ProcIdVar, ArgListVar], Features, InstMapSrc, !.ModuleInfo, Context,
+ HandleEventGoal).
+
+
+ %
+ % Build the following goal : handle_event_fail(ProcId, Arguments).
+ %
+:- pred make_handle_event_fail(prog_var::in, prog_var::in, hlds_goal::out,
+ module_info::in, module_info::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out) is det.
+
+make_handle_event_fail(ProcIdVar, ArgListVar, HandleEventGoal, !ModuleInfo,
+ !Varset, !Vartypes) :-
SSDBModule = mercury_ssdb_builtin_module,
Features = [],
InstMapSrc = [],
Context = term.context_init,
- goal_util.generate_simple_call(SSDBModule, "handle_event",
- pf_predicate, only_mode, detism_det, purity_impure,
- [ProcIdVar, EventVar, ArgListVar], Features, InstMapSrc, !.ModuleInfo,
- Context, HandleEventGoal),
-
- Goals = [EventConstructor, HandleEventGoal].
+ goal_util.generate_simple_call(SSDBModule, "handle_event_fail",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [ProcIdVar, ArgListVar], Features, InstMapSrc, !.ModuleInfo, Context,
+ HandleEventGoal).
+
+
+ %
+ % Build the following goal : handle_event_redo(ProcId, Arguments).
+ %
+:- pred make_handle_event_redo(prog_var::in, prog_var::in, hlds_goal::out,
+ module_info::in, module_info::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out) is det.
+
+make_handle_event_redo(ProcIdVar, ArgListVar, HandleEventGoal, !ModuleInfo,
+ !Varset, !Vartypes) :-
+
+ SSDBModule = mercury_ssdb_builtin_module,
+ Features = [],
+ InstMapSrc = [],
+ Context = term.context_init,
+ goal_util.generate_simple_call(SSDBModule, "handle_event_redo",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [ProcIdVar, ArgListVar], Features, InstMapSrc, !.ModuleInfo, Context,
+ HandleEventGoal).
%
@@ -721,44 +775,4 @@
).
%-----------------------------------------------------------------------------%
-
- %
- % make_ssdb_event_type_construction(EventType,
- % Goal, Var, !Varset, !Vartypes)
- %
- % makes a construction unification, Goal, where Var will have the value
- % EventType, updating the varset and vartypes to reflect this new goal.
- %
-:- pred make_ssdb_event_type_construction(
- ssdb_event_type::in, hlds_goal::out, prog_var::out,
- prog_varset::in, prog_varset::out,
- vartypes::in, vartypes::out) is det.
-
-make_ssdb_event_type_construction(Event, Goal, EventVar, !Varset, !Vartypes) :-
- (
- Event = ssdb_call,
- SSDB_Event = "ssdb_call"
- ;
- Event = ssdb_exit,
- SSDB_Event = "ssdb_exit"
- ;
- Event = ssdb_redo,
- SSDB_Event = "ssdb_redo"
- ;
- Event = ssdb_fail,
- SSDB_Event = "ssdb_fail"
- ),
-
- SSDBModule = mercury_ssdb_builtin_module,
- TypeCtor = type_ctor(qualified(SSDBModule, "ssdb_event_type"), 0),
-
- svvarset.new_named_var(SSDB_Event, EventVar, !Varset),
- ConsId = cons(qualified(SSDBModule, SSDB_Event), 0),
- construct_type(TypeCtor, [], EventVarType),
- svmap.det_insert(EventVar, EventVarType, !Vartypes),
- construct_functor(EventVar, ConsId, [], Goal).
-
-
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: ssdb/ssdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
retrieving revision 1.7
diff -u -r1.7 ssdb.m
--- ssdb/ssdb.m 29 Oct 2007 03:00:44 -0000 1.7
+++ ssdb/ssdb.m 29 Oct 2007 05:55:22 -0000
@@ -61,10 +61,24 @@
:- type pos == int.
%
- % This routine is called at each event that occurs.
+ % This routine is called at each call event that occurs.
%
-:- impure pred handle_event(ssdb_proc_id::in, ssdb_event_type::in,
- list_var_value::in) is det.
+:- impure pred handle_event_call(ssdb_proc_id::in, list_var_value::in) is det.
+
+ %
+ % This routine is called at each exit event that occurs.
+ %
+:- impure pred handle_event_exit(ssdb_proc_id::in, list_var_value::in) is det.
+
+ %
+ % This routine is called at each fail event that occurs.
+ %
+:- impure pred handle_event_fail(ssdb_proc_id::in, list_var_value::in) is det.
+
+ %
+ % This routine is called at each redo event that occurs.
+ %
+:- impure pred handle_event_redo(ssdb_proc_id::in, list_var_value::in) is det.
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
@@ -167,118 +181,133 @@
%----------------------------------------------------------------------------%
-
%
% Write the event out and call the prompt.
- % XXX Not yet implemented : redo, fail.
%
-handle_event(ProcId, Event, ListVarValue) :-
-
+handle_event_call(ProcId, ListVarValue) :-
+ Event = ssdb_call,
impure get_event_num_inc(EventNum),
impure update_depth(Event, PrintDepth),
- (
- Event = ssdb_call,
- % set the new CSN.
- impure get_csn_inc(_),
-
- % set the list_var_value of the debugger state with the list received
- impure set_list_var_value(ListVarValue),
-
- % Push the new stack frame on top of the shadow stack.
- semipure get_debugger_state(InitialState),
- StackFrame = elem(ProcId, InitialState),
- stack.push(InitialState ^ ssdb_stack, StackFrame, FinalStack),
- StateEv = InitialState ^ ssdb_stack := FinalStack,
- impure set_debugger_state(StateEv)
- ;
- % Just get the top stack frame. It will be popped at the end of
- % handle_event. We need to leave the frame in place, e.g. for
- % printing variables.
- Event = ssdb_exit,
- impure set_list_var_value_in_stack(ListVarValue),
- semipure get_debugger_state(InitialState),
- stack.top_det(InitialState ^ ssdb_stack, StackFrame)
-
- ;
- Event = ssdb_redo,
- error("ssdb_redo: not yet implemented")
- ;
- Event = ssdb_fail,
- semipure get_debugger_state(InitialState),
- stack.top_det(InitialState ^ ssdb_stack, StackFrame)
- ),
+ % set the new CSN.
+ impure get_csn_inc(_),
+
+ % set the list_var_value of the debugger state with the list received
+ impure set_list_var_value(ListVarValue),
+
+ % Push the new stack frame on top of the shadow stack.
+ semipure get_debugger_state(InitialState),
+ StackFrame = elem(ProcId, InitialState),
+ stack.push(InitialState ^ ssdb_stack, StackFrame, FinalStack),
+ StateEv = InitialState ^ ssdb_stack := FinalStack,
+ impure set_debugger_state(StateEv),
semipure get_debugger_state(State0),
CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
- NextStop0 = State0 ^ ssdb_next_stop,
+ set_stop(Event, CSN, State0, ProcId, Stop),
(
- NextStop0 = ns_step,
- Stop = yes
- ;
- NextStop0 = ns_next(StopCSN),
- is_same_event(StopCSN, CSN, Stop)
- ;
- NextStop0 = ns_continue,
- ( set.contains(State0 ^ ssdb_breakpoints,
- breakpoint(ProcId ^ module_name, ProcId ^ proc_name))
- ->
- Stop = yes
- ;
- Stop = no
+ Stop = yes,
+ some [!IO]
+ (
+ impure invent_io(!:IO),
+
+ print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+
+ semipure get_shadow_stack(ShadowStack),
+ impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
+
+ impure consume_io(!.IO),
+
+ set_next_stop(CSN, WhatNext, NextStop),
+
+ % Set the last update : breakpoints.
+ semipure get_debugger_state(State1),
+ State = State1 ^ ssdb_next_stop := NextStop,
+ impure set_debugger_state(State)
)
;
- NextStop0 = ns_final_port(StopCSN),
+ Stop = no
+ ).
+
+
+ %
+ % Write the event out and call the prompt.
+ %
+handle_event_exit(ProcId, ListVarValue) :-
+ Event = ssdb_exit,
+ impure get_event_num_inc(EventNum),
+ impure update_depth(Event, PrintDepth),
+
+ % Just get the top stack frame. It will be popped at the end of
+ % handle_event. We need to leave the frame in place, e.g. for
+ % printing variables.
+ impure set_list_var_value_in_stack(ListVarValue),
+ semipure get_debugger_state(State0),
+ stack.top_det(State0 ^ ssdb_stack, StackFrame),
+
+ CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
+
+ set_stop(Event, CSN, State0, ProcId, Stop),
+ (
+ Stop = yes,
+ some [!IO]
(
- ( Event = ssdb_exit
- ; Event = ssdb_fail
- ),
- is_same_event(StopCSN, CSN, Stop)
- ;
- Event = ssdb_call,
- Stop = no
+ impure invent_io(!:IO),
+
+ print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+
+ semipure get_shadow_stack(ShadowStack),
+ impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
+
+ impure consume_io(!.IO),
+
+ set_next_stop(CSN, WhatNext, NextStop),
+
+ % Set the last update : breakpoints.
+ semipure get_debugger_state(State1),
+ State = State1 ^ ssdb_next_stop := NextStop,
+ impure set_debugger_state(State)
)
+ ;
+ Stop = no
),
+ semipure get_debugger_state(PopState),
+ stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
+ StateEv = PopState ^ ssdb_stack := FinalStack1,
+ impure set_debugger_state(StateEv).
+
+
+ %
+ % Write the event out and call the prompt.
+ %
+handle_event_fail(ProcId, _ListVarValue) :-
+ Event = ssdb_fail,
+ impure get_event_num_inc(EventNum),
+ impure update_depth(Event, PrintDepth),
+
+ semipure get_debugger_state(State0),
+ stack.top_det(State0 ^ ssdb_stack, StackFrame),
+
+ CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
+
+ set_stop(Event, CSN, State0, ProcId, Stop),
(
Stop = yes,
some [!IO]
(
impure invent_io(!:IO),
- io.write_string(" ", !IO),
- io.write_int(EventNum, !IO),
- io.write_string("\t", !IO),
- io.write_string(ProcId ^ module_name, !IO),
- io.write_string(".", !IO),
- io.write_string(ProcId ^ proc_name, !IO),
- io.write_string(".", !IO),
- io.write(Event, !IO),
- io.write_string("\t\t| DEPTH = ", !IO),
- io.write_int(PrintDepth, !IO),
- io.write_string("\t| CSN = ", !IO),
- io.write_int(CSN, !IO),
- io.nl(!IO),
-
+
+ print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+
semipure get_shadow_stack(ShadowStack),
impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
impure consume_io(!.IO),
-
- (
- WhatNext = wn_step,
- NextStop = ns_step
- ;
- WhatNext = wn_next,
- NextStop = ns_next(CSN)
- ;
- WhatNext = wn_continue,
- NextStop = ns_continue
- ;
- WhatNext = wn_finish(EndCSN),
- NextStop = ns_final_port(EndCSN)
- ),
+
+ set_next_stop(CSN, WhatNext, NextStop),
% Set the last update : breakpoints.
semipure get_debugger_state(State1),
@@ -289,27 +318,23 @@
Stop = no
),
- ( Event = ssdb_call
+ semipure get_debugger_state(PopState),
+ stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
+ StateEv = PopState ^ ssdb_stack := FinalStack1,
+ impure set_debugger_state(StateEv).
- ; Event = ssdb_exit,
- semipure get_debugger_state(PopState),
- stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
- StateEv1 = PopState ^ ssdb_stack := FinalStack1,
- impure set_debugger_state(StateEv1)
-
- ; Event = ssdb_fail,
- semipure get_debugger_state(PopState),
- stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
- StateEv1 = PopState ^ ssdb_stack := FinalStack1,
- impure set_debugger_state(StateEv1)
-
- /* XXX currently commented out because above these two cases
- ** throw an exception above and hence the compiler warns about
- ** these two cases being redundant
- ; Event = ssdb_redo
- */
- ).
+ %
+ % Write the event out and call the prompt.
+ % XXX Need to be completed
+ %
+handle_event_redo(_ProcId, _ListVarValue) :-
+ Event = ssdb_redo,
+ impure get_event_num_inc(_EventNum),
+ impure update_depth(Event, _PrintDepth),
+
+ semipure get_debugger_state(_State0),
+ true.
%
% IsSame is 'yes' iff the two call sequence numbers are equal,
@@ -419,6 +444,82 @@
impure set_debugger_state(State).
+ %
+ % Set Stop, if Stop equals yes, we call the prompt.
+ %
+:- pred set_stop(ssdb_event_type::in, int::in, debugger_state::in,
+ ssdb_proc_id::in, bool::out) is det.
+
+set_stop(Event, CSN, State, ProcId, Stop) :-
+
+ NextStop = State ^ ssdb_next_stop,
+ (
+ NextStop = ns_step,
+ Stop = yes
+ ;
+ NextStop = ns_next(StopCSN),
+ is_same_event(StopCSN, CSN, Stop)
+ ;
+ NextStop = ns_continue,
+ ( set.contains(State ^ ssdb_breakpoints,
+ breakpoint(ProcId ^ module_name, ProcId ^ proc_name))
+ ->
+ Stop = yes
+ ;
+ Stop = no
+ )
+ ;
+ NextStop = ns_final_port(StopCSN),
+ (
+ ( Event = ssdb_exit
+ ; Event = ssdb_fail
+ ),
+ is_same_event(StopCSN, CSN, Stop)
+ ;
+ ( Event = ssdb_call
+ ; Event = ssdb_redo
+ ),
+ Stop = no
+ )
+ ).
+
+
+:- pred print_event_info(ssdb_event_type::in, int::in, ssdb_proc_id::in,
+ int::in, int::in, io::di, io::uo) is det.
+
+print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO) :-
+ io.write_string(" ", !IO),
+ io.write_int(EventNum, !IO),
+ io.write_string("\t", !IO),
+ io.write_string(ProcId ^ module_name, !IO),
+ io.write_string(".", !IO),
+ io.write_string(ProcId ^ proc_name, !IO),
+ io.write_string(".", !IO),
+ io.write(Event, !IO),
+ io.write_string("\t\t| DEPTH = ", !IO),
+ io.write_int(PrintDepth, !IO),
+ io.write_string("\t| CSN = ", !IO),
+ io.write_int(CSN, !IO),
+ io.nl(!IO).
+
+
+:- pred set_next_stop(int::in, what_next::in, next_stop::out) is det.
+
+set_next_stop(CSN, WhatNext, NextStop) :-
+ (
+ WhatNext = wn_step,
+ NextStop = ns_step
+ ;
+ WhatNext = wn_next,
+ NextStop = ns_next(CSN)
+ ;
+ WhatNext = wn_continue,
+ NextStop = ns_continue
+ ;
+ WhatNext = wn_finish(EndCSN),
+ NextStop = ns_final_port(EndCSN)
+ ).
+
%----------------------------------------------------------------------------%
%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list