[m-rev.] ssdb version 1.0 misstakes fixed
oan at missioncriticalit.com
oan at missioncriticalit.com
Tue Dec 4 16:23:41 AEDT 2007
On 4/12/2007, "Peter Wang" <novalazy at gmail.com> wrote:
>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.
No way, there is one extra braket pair in the model.
>
>> @@ -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"?
In the past, I had some code lines to reset some values. It disappear in
the last version and I forgot to modify the name...
>
>> @@ -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?
Deleted. It was note for me ;)
>
>> + (
>> + 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?
This predicate is use only to increment the depth. The mutable allow me
to use the getter (and the setter but does not matter because I use two
other predicates to set the value by computation of the stack's depth)
of the depth where I want in the code.
>
>>
>> %
>> - % 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?
No, deleted
>
>> + %
>> + % 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 ... ?
Before the event retried.
>
>> +
>> + ;
>> + ( 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?
No, little misstake, it simply mean that you get the deepest frame. I
corrected that.
>
>
>Peter
>
Thank.
>--------------------------------------------------------------------------
>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
>--------------------------------------------------------------------------
--------------------------------------------------------------------------
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