1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19-module(dbg_debugged).
20
21%% External exports
22-export([eval/3]).
23
24%%====================================================================
25%% External exports
26%%====================================================================
27
28%%--------------------------------------------------------------------
29%% eval(Mod, Func, Args) -> Value
30%% Main entry point from external (non-interpreted) code.
31%% Called via the error handler.
32%%--------------------------------------------------------------------
33eval(Mod, Func, Args) ->
34    Meta = dbg_ieval:eval(Mod, Func, Args),
35    Mref = erlang:monitor(process, Meta),
36    msg_loop(Meta, Mref).
37
38%%====================================================================
39%% Internal functions
40%%====================================================================
41
42msg_loop(Meta, Mref) ->
43    receive
44
45	%% Evaluated function has returned a value
46	{sys, Meta, {ready, Val}} ->
47	    erlang:demonitor(Mref, [flush]),
48            case Val of
49                {dbg_apply,M,F,A} ->
50                    apply(M, F, A);
51                _ ->
52                    Val
53	    end;
54
55	%% Evaluated function raised an (uncaught) exception
56	{sys, Meta, {exception,{Class,Reason,Stacktrace}}} ->
57	    erlang:demonitor(Mref, [flush]),
58
59	    %% ...raise the same exception
60	    erlang:error(erlang:raise(Class, Reason, Stacktrace),
61			 [Class,Reason,Stacktrace]);
62
63	%% Meta is evaluating a receive, must be done within context
64	%% of real (=this) process
65	{sys, Meta, {'receive',Msg}} ->
66	    receive Msg ->
67		Meta ! {self(), rec_acked},
68		ok
69	    end,
70	    msg_loop(Meta, Mref);
71
72	%% Meta needs something evaluated within context of real process
73	{sys, Meta, {command,Command}} ->
74	    Reply = handle_command(Command),
75	    Meta ! {sys, self(), Reply},
76	    msg_loop(Meta, Mref);
77
78	%% Meta has terminated
79	%% Must be due to int:stop() (or -heaven forbid- a debugger bug)
80	{'DOWN', Mref, _, _, Reason} ->
81            {interpreter_terminated, Reason}
82    end.
83
84handle_command(Command) ->
85    try
86	reply(Command)
87    catch Class:Reason:Stacktrace ->
88	    {exception,{Class,Reason,stacktrace_f(Stacktrace)}}
89    end.
90
91reply({apply,M,F,As}) ->
92    {value, erlang:apply(M,F,As)};
93reply({eval,Expr,Bs}) ->
94    %% Bindings is an orddict (sort them)
95    erl_eval:expr(Expr, lists:sort(Bs)). % {value, Value, Bs2}
96
97%% Fix stacktrace - keep all above call to this module.
98%%
99stacktrace_f([]) -> [];
100stacktrace_f([{?MODULE,_,_,_}|_]) -> [];
101stacktrace_f([F|S]) -> [F|stacktrace_f(S)].
102