[m-rev.] ssdb version 1.0 misstakes fixed
Peter Wang
novalazy at gmail.com
Tue Dec 4 11:49:53 AEDT 2007
On 2007-12-03, Olivier Annet <oan at missioncriticalit.com> wrote:
>
>
> Estimated hours taken: 2
> Branches: main
Wow, pretty quick for a 100 KB+ diff ;-)
>
> Correction of the review ssdb version 1.0
>
> There are some modification for the nondet transformation. When a retry of a
> nondet procedure A is asked during the execution of the program, a choicepoint
> is left behind and the execution start the retry on procedure B. When the retry
> on B is finished, the compiler come back at the choicepoint and finish the call
> of the procedure A. This give a wrong number of event.
>
> The proposed solution is: when a retry is asked in a nondet procedure named A
> at an exit port, the debugger do not execute any operation until it reach the
> fail of the procedure A. It is only at this moment that the execution of B
> begin.
>
> If user use a predicate like solutions.unsorted_solutions, he will obtain more
> than one time the same solution. The use of solutions is right because it
> remove the duplicates
>
>
> Determinism failure tranformed:
>
> % detism_failure:
> %
> % p(...) :-
> % promise_<original_purity> (
> % (
> % CallVarDescs = [ ... ],
> % impure call_port(ProcId, CallVarDescs),
> % <original body>,
> % % preserve_backtrack_into
> % impure fail_port(ProcId, CallVarDescs, DoRetry),
> % (
> % DoRetry = do_retry,
> % p(...)
> % ;
> % DoRetry = do_not_retry,
> % fail
> % )
> % )
> % ).
See below.
> + % This is called by trace_get_command when the trace library is not linked
> + % in.
> + %
> +:- pred trace_get_command_fallback(string::in, string::out, io.input_stream::in,
> + io.output_stream::in, io::di, io::uo) is det.
> +
> +:- pragma foreign_export("C",
> + trace_get_command_fallback(in, out, in, in, di, uo),
> + "BROWSER_trace_get_command_fallback").
> +
> +trace_get_command_fallback(Prompt, String, MdbIn, MdbOut, !IO) :-
> + io.write_string(MdbOut, Prompt, !IO),
> + io.flush_output(MdbOut, !IO),
> + io.read_line_as_string(MdbIn, Result, !IO),
> + (
> + Result = ok(String)
> + ;
> + Result = eof,
> + String = "quit"
> + ;
> + Result = error(_Error),
> + error("Unexpected error in browser/util.m :
> + trace_get_command_fallback failed")
> + ).
You should split up long strings and append them. But it would be
better to print the error:
error("trace_get_command_fallback: " ++ io.error_message(Error))
> Index: compiler/ssdebug.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
> retrieving revision 1.10
> diff -u -r1.10 ssdebug.m
> --- compiler/ssdebug.m 9 Nov 2007 02:07:36 -0000 1.10
> +++ compiler/ssdebug.m 3 Dec 2007 04:38:19 -0000
> @@ -74,20 +74,11 @@
> % (
> % CallVarDescs = [ ... ],
> % impure call_port(ProcId, CallVarDescs),
> -% <original body>, % renaming outputs
> +% <original body>,
> % ExitVarDescs = [ ... | CallVarDescs ],
> % (
> -% impure exit_port(ProcId, ExitVarDescs, DoRetryA),
> -% (
> -% DoRetryA = do_retry,
> -% p(...)
> -% % Will give same result as long as p is pure or
> -% % semipure. Retry of impure procedures should probably
> -% % be disallowed anyway.
> -% ;
> -% DoRetryA = do_not_retry,
> -% % bind outputs
> -% )
> +% impure exit_port(ProcId, ExitVarDescs)
> +% % Go to fail port if retry.
> % ;
> % % preserve_backtrack_into,
> % impure redo_port(ProcId, ExitVarDescs),
> @@ -105,6 +96,40 @@
> % )
> % )
> % ).
> +%
> +% detism_failure:
> +%
> +% p(...) :-
> +% promise_<original_purity> (
> +% (
> +% CallVarDescs = [ ... ],
> +% impure call_port(ProcId, CallVarDescs),
> +% <original body>,
> +% % preserve_backtrack_into
> +% impure fail_port(ProcId, CallVarDescs, DoRetry),
> +% (
> +% DoRetry = do_retry,
> +% p(...)
> +% ;
> +% DoRetry = do_not_retry,
> +% fail
> +% )
> +% )
> +% ).
This is missing a disjunction. The code seems to have it though.
> @@ -136,8 +161,8 @@
> :- import_module io.
>
> %
> -% Place the different events (call/exit/fail/redo) at the beginning/end of each
> -% procedure.
> +% Place the different events (call/exit/fail/redo) around of each procedure to
> +% allow debugging.
around each
> @@ -262,43 +288,46 @@
> make_arg_list(0, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
> ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
> -
> +
> % Create DoRetry output variable.
> make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
>
> % Generate the call to handle_event_exit(ProcId, VarList, DoRetry).
> - make_handle_event("exit", [ProcIdVar, ExitArgListVar, RetryVar],
> - HandleEventExitGoal, !ModuleInfo, !Varset, !Vartypes),
> + make_handle_event("handle_event_exit",
> + [ProcIdVar, ExitArgListVar, RetryVar], HandleEventExitGoal,
> + !ModuleInfo, !Varset, !Vartypes),
>
> % Generate the recursive call in the case of a retry.
> make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
> RecursiveGoal),
>
> % Organize the order of the generated code.
> - % XXX Need optimization in list append.
> goal_to_conj_list(BodyGoal1, BodyGoalList),
> % Set the determinism.
> Determinism = detism_det,
> goal_info_init(GoalInfo0),
> - goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo),
> + goal_info_set_determinism(Determinism, GoalInfo0,
> + GoalInfoDet),
> + goal_info_set_purity(purity_impure, GoalInfoDet, GoalInfoImpureDet),
>
> - conj_list_to_goal(RenamingGoals, GoalInfo, RenamingGoal),
> + conj_list_to_goal(RenamingGoals, GoalInfoImpureDet, RenamingGoal),
> + conj_list_to_goal([RecursiveGoal], GoalInfoImpureDet, ReSetGoal),
> % Create the switch on Retry at exit port.
> - make_switch_goal(RetryVar, RecursiveGoal, RenamingGoal, GoalInfo,
> + make_switch_goal(RetryVar, ReSetGoal, RenamingGoal, GoalInfoImpureDet,
> SwitchGoal),
Why "ReSetGoal"?
> @@ -316,121 +345,147 @@
...
> + % Make the ssdb_proc_id.
> + module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
> + make_proc_id_construction(!.PredInfo, !.ProcInfo, ProcIdGoals,
> + ProcIdVar, !Varset, !Vartypes),
> +
> + % Make a list which records the value for each of the head
> + % variables at the call port.
> + make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
> + CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> + !Vartypes, map.init, BoundVarDescsAtCall),
> +
> + % Generate the call to handle_event_call(ProcId, VarList).
> + make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
> + HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
> +
> + % Get the InstMap at the end of the procedure.
> + update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
> +
> + % We have to rename the output variables because, if we do a retry,
> + % we can get an other value.
in case we do a retry, the output variables
will be bound by the retried call.
> + proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
> + InstantiatedVars),
> + goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
> + create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
> + RenamingGoals, _NewVars, Renaming),
> + rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
> +
> + % Make the variable list at the exit port. It's currently a
> + % completely new list instead of adding on to the list generated
> + % for the call port.
> + make_arg_list(0, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
> + ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> + !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
> +
> + % Create DoRetryA output variable
> + make_retry_var("DoRetryA", RetryAVar, !Varset, !Vartypes),
> +
> + % Generate the call to
> + % handle_event_exit(ProcId, VarList, DoRetryA).
> + make_handle_event("handle_event_exit",
> + [ProcIdVar, ExitArgListVar, RetryAVar], HandleEventExitGoal,
> + !ModuleInfo, !Varset, !Vartypes),
> +
> + % Generate the recursive call in the case of a retry
> + make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
> + HeadVars, RecursiveGoal),
> +
> + % Generate the list of arguments at the fail port.
> + make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
> + FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> + !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
> +
> + % Create DoRetryA output variable
DoRetryB
> @@ -465,60 +520,51 @@
> !Vartypes, map.init, BoundVarDescsAtCall),
>
> % Generate the call to handle_event_call(ProcId, VarList).
> - make_handle_event("call", [ProcIdVar, CallArgListVar],
> + make_handle_event("handle_event_call_nondet",
> + [ProcIdVar, CallArgListVar],
> HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
>
> % Get the InstMap at the end of the procedure.
> update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
>
> - % We have to rename the output variables because, if we do a retry,
> - % we can get an other value.
> - proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
> - InstantiatedVars),
> - goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
> - create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
> - RenamingGoals, _NewVars, Renaming),
> - rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
> -
> % Make the variable list at the exit port. It's currently a completely
> % new list instead of adding on to the list generated for the call
> % port.
> - make_arg_list(0, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
> + make_arg_list(0, FinalInstMap, HeadVars, map.init, ExitArgListVar,
> ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
>
> - % Create DoRetryA output variable
> - make_retry_var("DoRetryA", RetryAVar, !Varset, !Vartypes),
> -
> - % Generate the call to handle_event_exit(ProcId, VarList, DoRetryA).
> - make_handle_event("exit", [ProcIdVar, ExitArgListVar, RetryAVar],
> + % Generate the call to handle_event_exit_nondet(ProcId, VarList).
> + make_handle_event("handle_event_exit_nondet",
> + [ProcIdVar, ExitArgListVar],
> HandleEventExitGoal, !ModuleInfo, !Varset, !Vartypes),
>
> % Generate the call to handle_event_redo(ProcId, VarList).
> - make_handle_event("redo", [ProcIdVar, ExitArgListVar],
> + make_handle_event("handle_event_redo_nondet",
> + [ProcIdVar, ExitArgListVar],
> HandleEventRedoGoal, !ModuleInfo, !Varset, !Vartypes),
>
> % Generate the list of argument at the fail port.
> - make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
> + make_arg_list(0, InitInstMap, [], map.init, FailArgListVar,
> FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
>
> % Create DoRetryB output variable
DoRetry
> - make_retry_var("DoRetryB", RetryBVar, !Varset, !Vartypes),
> + make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
>
> - % Generate the call to handle_event_fail(ProcId, VarList, DoRetryB).
> - make_handle_event("fail", [ProcIdVar, FailArgListVar, RetryBVar],
> + % Generate the call to
> + % handle_event_fail_nondet(ProcId, VarList, DoRetry).
> + make_handle_event("handle_event_fail_nondet",
> + [ProcIdVar, FailArgListVar, RetryVar],
> HandleEventFailGoal, !ModuleInfo, !Varset, !Vartypes),
>
> make_fail_call(FailGoal, !.ModuleInfo),
>
> % Organize the order of the generated code.
> - % XXX Need optimization in list append.
> -
> % Get a flattened goal to avoid nested conjuction.
> - goal_to_conj_list(BodyGoal1, BodyGoalList1),
> + goal_to_conj_list(BodyGoal0, BodyGoalList0),
> CallVarGoal0 = CallArgListGoals ++
> - [HandleEventCallGoal | BodyGoalList1] ++ ExitArgListGoals,
> + [HandleEventCallGoal | BodyGoalList0] ++ ExitArgListGoals,
> goal_info_init(GoalInfo0),
> conj_list_to_goal(CallVarGoal0, GoalInfo0, CallVarGoal1),
> goal_to_conj_list(CallVarGoal1, CallVarGoal),
> @@ -528,46 +574,210 @@
> RecursiveGoal),
>
> % Create the switch on DoRetryA at exit port.
> - Determinism = detism_det,
> - goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo),
> - conj_list_to_goal(RenamingGoals, GoalInfo, RenamingGoal),
> - make_switch_goal(RetryAVar, RecursiveGoal, RenamingGoal, GoalInfo,
> - SwitchExitPortGoal),
> + Det = detism_det,
> + FailDet = detism_failure,
> + NonDet = detism_non,
> + goal_info_set_purity(purity_impure, GoalInfo0,
> + GoalInfoImpure),
> + goal_info_set_determinism(Det, GoalInfoImpure, GoalInfoImpureDet),
> + goal_info_set_determinism(FailDet, GoalInfoImpure,
> + GoalInfoImpureFailDet),
> + goal_info_set_determinism(NonDet, GoalInfoImpure,
> + GoalInfoImpureNonDet),
> + goal_list_determinism(BodyGoalList0, Detism),
> + goal_info_set_determinism(Detism, GoalInfo0, GoalInfoDetism),
> + goal_info_set_determinism(Detism, GoalInfoImpure,
> + GoalInfoImpureDetism),
> +
> + conj_list_to_goal([RecursiveGoal], GoalInfoImpureDetism, ReSetGoal),
>
> % Create the switch on DoRetryB at fail port.
> - make_switch_goal(RetryBVar, RecursiveGoal, FailGoal, GoalInfo,
> + make_switch_goal(RetryVar, ReSetGoal, FailGoal, GoalInfoImpureNonDet,
As above.
> @@ -748,8 +944,37 @@
> "false", pf_predicate, only_mode, detism_failure, purity_pure,
> [], Features, InstMapSrc, ModuleInfo, Context, FailGoal).
>
> +
> + %
> + % Detect if all argument's mode are fully input or output.
> + % XXX Other mode than fully input or output are not managed for the
> + % moment. So the code of these procedures will not be generated.
> + %
> +:- pred check_arguments_modes(module_info::in, list(mer_mode)::in)
> + is semidet.
> +
> +check_arguments_modes(ModuleInfo, HeadModes) :-
> + (
> + all [Modes] (
> + list.member(Mode, HeadModes)
> + =>
> + ( mode_is_fully_input(ModuleInfo, Mode)
> + ; mode_is_fully_output(ModuleInfo, Mode)
> + )
> + )
> + ->
> + true
> + ;
> + fail
> + ).
Don't need the if-then-else.
> Index: ssdb/ssdb.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
> retrieving revision 1.10
> diff -u -r1.10 ssdb.m
> --- ssdb/ssdb.m 9 Nov 2007 02:07:37 -0000 1.10
> +++ ssdb/ssdb.m 3 Dec 2007 04:38:19 -0000
> @@ -18,6 +18,7 @@
> %----------------------------------------------------------------------------%
> %----------------------------------------------------------------------------%
>
> +
> :- module ssdb.
> :- interface.
> :- import_module list.
> @@ -31,11 +32,16 @@
> :- type ssdb_event_type
> ---> ssdb_call
> ; ssdb_exit
> - ; ssdb_redo
> ; ssdb_fail
> + ; ssdb_call_nondet
> + ; ssdb_exit_nondet
> + ; ssdb_redo_nondet
> + ; ssdb_fail_nondet
> .
>
> -
> + %
> + % Type to determine if it is necessary to do a retry.
> + %
> :- type ssdb_retry
> ---> do_retry
> ; do_not_retry
...
> + %
> + % Note: debugger_disabled must be first because io.init_state/2 is called
> + % before the `do_nothing' mutable is initialised. At that time `do_nothing'
> + % will have a value of zero. By putting debugger_disabled first, it will
> + % be represented by zero so the SSDB port code will correctly do nothing
> + % until after the library is initialised.
> + % XXX In near futur, the debugger_disabled state should be removed.
future
> - %
> - % Increment the current event number in the debugger state,
> - % returning the new event number.
> - %
> -:- impure pred get_event_num_inc(int::out) is det.
> + (
> + AutoRetry = do_retry,
> + (
> + semipure get_correct_frame_nondet(ProcId, PrintDepth+1,
> + StackFrame)
> + ->
> + EventNumF = StackFrame ^ se_event_number,
> + CSNF = StackFrame ^ se_csn,
> + impure set_cur_ssdb_event_number(EventNumF-1),
> + impure set_cur_ssdb_csn(CSNF-1)
> + ;
> + error("Unexpected error : In handle_event_fail_nondet :
> + get_correct_frame_nondet failed")
Split long line.
> + ),
> + WhatNext = wn_retry(CSN)
> + ;
> + AutoRetry = do_not_retry,
> + impure prompt(Event, ShadowStack0, 0, WhatNext, !IO)
> + ),
> - %
> - % Setter of the ssdb_event_number field.
> - %
> -:- impure pred set_event_num(int::in) is det.
> + stack.pop_det(ShadowStack0, _StackFrame, ShadowStack),
> + stack.pop_det(ShadowStackNonDet0, _StackFrameNonDet, ShadowStackNonDet),
> + impure set_cur_ssdb_shadow_stack(ShadowStack),
> + impure set_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet)
> + ;
> + DebuggerState = debugger_off,
>
> -set_event_num(EventNum) :-
> - semipure get_debugger_state(State0),
> - State = State0 ^ ssdb_event_number := EventNum,
> - impure set_debugger_state(State).
> + semipure get_cur_ssdb_depth(Depth),
> + % Do not succeed at each call
What do you mean?
> + (
> + semipure get_correct_frame_nondet(ProcId, Depth+1, _StackFrame)
> + ->
> + Stop = yes
> + ;
> + Stop = no
> + ),
> + (
> + Stop = yes,
> + impure set_debugger_state(debugger_on),
> + Retry = do_retry
> + ;
> + Stop = no,
> + Retry = do_not_retry
> + )
> + ;
> + DebuggerState = debugger_disabled,
> + Retry = do_not_retry
> + ).
>
>
> %
> - % For a given event type, update the depth in the debugger state,
> - % returning the updated depth.
> + % Call at redo port in nondet procedure. Write the event out and call
> + % the prompt.
> %
> -:- impure pred update_depth(ssdb_event_type::in, int::out) is det.
> +handle_event_redo_nondet(ProcId, _ListVarValue) :-
> + semipure get_debugger_state(DebuggerState),
> + (
> + DebuggerState = debugger_on,
> +
> + Event = ssdb_redo_nondet,
> + impure get_ssdb_event_number_inc(EventNum),
> + impure get_ssdb_depth_inc(PrintDepth),
>
> -update_depth(Event, ReturnDepth) :-
> - semipure get_debugger_state(State0),
> - Depth0 = State0 ^ ssdb_call_depth,
> (
> - ( Event = ssdb_call
> - ; Event = ssdb_redo
> - ),
> - Depth = Depth0 + 1,
> - ReturnDepth = Depth0
> + semipure get_correct_frame_nondet(ProcId, PrintDepth, StackFrame)
> + ->
> + semipure get_cur_ssdb_shadow_stack(ShadowStack0),
> + stack.push(ShadowStack0, StackFrame, ShadowStack),
> + impure set_cur_ssdb_shadow_stack(ShadowStack),
> + CSN = StackFrame ^ se_csn,
> +
> + semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId,
> + Stop, _AutoRetry),
> + (
> + Stop = yes,
> + some [!IO]
> + (
> + impure invent_io(!:IO),
> +
> + print_event_info(Event, EventNum, ProcId, PrintDepth, CSN,
> + !IO),
> +
> + impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
> +
> + impure consume_io(!.IO),
> +
> + impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack,
> + _Retry)
> + )
> ;
> - ( Event = ssdb_exit
> - ; Event = ssdb_fail
> - ),
> - Depth = Depth0 - 1,
> - ReturnDepth = Depth
> - ),
> - State = State0 ^ ssdb_call_depth := Depth,
> - impure set_debugger_state(State).
> + Stop = no
> + )
> + ;
> + error("\nUnexpected error : In handle_event_redo_nondet :
> + get_correct_frame_nondet failed")
Long string.
> +%----------------------------------------------------------------------------%
>
> + %
> + % Increment the depth and return the new value.
> + %
> +:- impure pred get_ssdb_depth_inc(int::out) is det.
> +
> +get_ssdb_depth_inc(Depth) :-
> + semipure get_cur_ssdb_shadow_stack(ShadowStack),
> + Depth0 = stack.depth(ShadowStack),
> + Depth = Depth0 + 1,
> + impure set_cur_ssdb_depth(Depth).
Do you need to keep the depth in a mutable?
>
> %
> - % what_next_stop(CSN, WhatNext, ShadowStack, NextStop, Retry).
> + % what_next_stop(CSN, EventNum, WhatNext, ShadowStack, Retry).
> %
> % Set the NextStop and the Retry variable according to the WhatNext value.
> % In the case where the WathNext is set for a retry, it modify the
> % debugger_state at his old value which it had at the call point.
> %
> -:- impure pred what_next_stop(int::in, what_next::in, stack(stack_elem)::in,
> - next_stop::out, ssdb_retry::out) is det.
> +:- impure pred what_next_stop(int::in, int::in, what_next::in,
> + stack(stack_elem)::in, ssdb_retry::out) is det.
>
> -what_next_stop(CSN, WhatNext, ShadowStack, NextStop, Retry) :-
> +what_next_stop(EventNum, CSN, WhatNext, _ShadowStack, Retry) :-
Any reason to keep the unused argument?
> + %
> + % This two following predicates get the right informations in the
> + % shadow_stack_nondet about the current analysed procedure.
Delete "analysed".
> + %
> +:- semipure pred get_correct_frame_nondet(ssdb_proc_id::in, int::in,
> + stack_elem::out) is semidet.
> +
> +get_correct_frame_nondet(ProcId, Depth, StackFrame) :-
> + semipure get_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet),
> + get_correct_frame_nondet_2(ProcId, Depth, ShadowStackNonDet, StackFrame).
> +
> +
> +:- pred get_correct_frame_nondet_2(ssdb_proc_id::in, int::in,
> + stack(stack_elem)::in, stack_elem::out) is semidet.
> +
> +get_correct_frame_nondet_2(ProcId, Depth, ShadowStackNonDet0, StackFrame) :-
> + (
> + stack.is_empty(ShadowStackNonDet0)
> + ->
> + fail
> + ;
> + stack.pop_det(ShadowStackNonDet0, Frame, ShadowStackNonDet),
> + (
> + Frame ^ se_proc_id ^ module_name = ProcId ^ module_name,
> + Frame ^ se_proc_id ^ proc_name = ProcId ^ proc_name,
> + Frame ^ se_depth = Depth
> + ->
> + StackFrame = Frame
> + ;
> + get_correct_frame_nondet_2(ProcId, Depth, ShadowStackNonDet,
> + StackFrame)
> + )
> ).
> - io.write_string("r :: retry", !IO),
> io.nl(!IO),
> + io.write_string("\nConsult the file :
> + compiler/ssdb/SSDB_COMMAND_HELP.txt for details", !IO),
Delete "compiler/" and split the string into two.
> @@ -754,74 +1101,307 @@
> )
>
> ;
> - ( Words = ["s"]
> - ; list.is_empty(Words)
> + ( list.is_empty(Words)
Words = []
> + ; Words = ["s"]
> + ; Words = ["step"]
> )
> ->
> WhatNext = wn_step
>
> - ; Words = ["c"] ->
> + ;
> + ( Words = ["c"]
> + ; Words = ["continue"]
> + )
> + ->
> WhatNext = wn_continue
>
> ;
> - Words = ["b", ModuleName, ProcedureName]
> + ( Words = ["b", ModuleName, ProcedureName]
> + ; Words = ["break", ModuleName, ProcedureName]
> + )
> + ->
> + semipure get_cur_ssdb_breakpoints(BreakPoints0),
> + Key = pair(ModuleName, ProcedureName),
> + ( map.contains(BreakPoints0, Key)
> ->
> - semipure get_debugger_state(State0),
> - Breakpoints0 = State0 ^ ssdb_breakpoints,
> - Breakpoints = set.insert(Breakpoints0, breakpoint(ModuleName,
> - ProcedureName)),
> - State = State0 ^ ssdb_breakpoints := Breakpoints,
> - io.print(Breakpoints, !IO),nl(!IO),
> - impure set_debugger_state(State),
> + io.write_string("The new breakpoint already exist\n", !IO),
> + impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
> + ;
> + semipure get_cur_ssdb_number_of_breakpoint(Number),
> + NewBreakPoint = breakpoint(Number+1, ModuleName,
> + ProcedureName, bp_state_enabled),
> + map.det_insert(BreakPoints0, Key, NewBreakPoint,
> + BreakPoints),
> + BreakPointsListValue = map.values(BreakPoints),
> + print_breakpoints(BreakPointsListValue, !IO),
> + impure set_cur_ssdb_breakpoints(BreakPoints),
> + impure set_cur_ssdb_number_of_breakpoint(Number+1),
> impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
> + )
>
> - ; Words = ["r"] ->
> + ;
> + ( Words = ["r"]
> + ; Words = ["retry"]
> + )
> + ->
> (
> ( Event = ssdb_exit
> ; Event = ssdb_fail
> - ) ->
> + ; Event = ssdb_fail_nondet
> + ),
> stack.top_det(ShadowStack, FrameStack),
> - CSN = FrameStack ^ se_initial_state ^ ssdb_csn,
> + EventNum = FrameStack ^ se_event_number,
> + CSN = FrameStack ^ se_csn,
> + impure set_cur_ssdb_event_number(EventNum-1),
> + impure set_cur_ssdb_csn(CSN-1),
> WhatNext = wn_retry(CSN)
> ;
> + Event = ssdb_exit_nondet,
> + stack.top_det(ShadowStack, FrameStack),
> + EventNum = FrameStack ^ se_event_number,
> + CSN = FrameStack ^ se_csn,
> + impure set_debugger_state(debugger_off),
> + % Set the event number and the CSN minus 1 because it will
> + % be increment at the next event. So, we need to be the
> + % event just before
before ... ?
> +
> + ;
> + ( Words = ["r", NStr]
> + ; Words = ["retry", NStr]
> + )
> + ->
> + (
> + string.to_int(NStr, Num),
> + semipure get_cur_ssdb_depth(CurDepth)
> + ->
> + (
> + Num >= 1,
> + Num =< CurDepth
> + ->
> + (
> + ( Event = ssdb_exit
> + ; Event = ssdb_fail
> + ; Event = ssdb_fail_nondet
> + ),
> + get_correct_frame_with_num(Num, ShadowStack,
> + FrameStack),
> + EventNum = FrameStack ^ se_event_number,
> + CSN = FrameStack ^ se_csn,
> + impure set_cur_ssdb_event_number(EventNum-1),
> + impure set_cur_ssdb_csn(CSN-1),
> + WhatNext = wn_retry(CSN)
> + ;
> + Event = ssdb_exit_nondet,
> + get_correct_frame_with_num(Num, ShadowStack,
> + FrameStack),
> + EventNum = FrameStack ^ se_event_number,
> + CSN = FrameStack ^ se_csn,
> + impure set_debugger_state(debugger_off),
> + % Set the event number and the CSN minus 1 because
> + % it will be increment at the next event. So, we
> + % need to be at the event just before the call.
> + impure set_cur_ssdb_event_number(EventNum-1),
> + impure set_cur_ssdb_csn(CSN-1),
> + WhatNext = wn_retry_nondet(CSN)
> + ;
> + ( Event = ssdb_call
> + ; Event = ssdb_call_nondet
> + ; Event = ssdb_redo_nondet
> + ),
> + io.write_string("Impossible at call or redo
> + port\n", !IO),
> + impure prompt(Event, ShadowStack, Depth, WhatNext,
> + !IO)
> + )
> + ;
> + io.format("The number must be between 1 and %i\n",
> + [i(CurDepth)], !IO),
> + impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
> + )
You should factor out the code for the "retry" and "retry N" (later).
> +
> + ;
> + ( Words = ["b", "info"]
> + ; Words = ["break", "info"]
> + )
> + ->
> + semipure get_cur_ssdb_breakpoints(BreakPoints),
> + BreakPointsListValue = map.values(BreakPoints),
> + print_breakpoints(BreakPointsListValue, !IO),
> + impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
> +
> + ; Words = ["disable", "*"] ->
> + impure modif_state_breakpoints(bp_state_disabled, !IO),
> + impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
modif?
> +
> + %
> + % get_correct_frame_with_num(Num, ShadowStack, Frame).
> + %
> + % Get the Nth frame from the shadow stack, begin from the top.
beginning
> + % If Num = 1, the current frame will be return.
the top frame will be returned.
> + % Num should be in the interval of 1 =< Num =< Depth.
> + % If Num = Depth, the debugger will reach the end of the program.
Do you mean abort?
Peter
--------------------------------------------------------------------------
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