[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