The R13B03 release.OTP_R13B03

1 files changed, 529 insertions, 0 deletions

diff --git a/lib/et/src/et_selector.erl b/lib/et/src/et_selector.erl
new file mode 100644
index 0000000000..845359622d
--- /dev/null
+++ b/lib/et/src/et_selector.erl
@@ -0,0 +1,529 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Define event transforms and trace patterns 
+%%----------------------------------------------------------------------
+
+-module(et_selector).
+
+-export([
+         make_pattern/1, 
+         change_pattern/1,
+         parse_event/2
+        ]).
+
+-include("../include/et.hrl").
+
+%%----------------------------------------------------------------------
+%% make_pattern(RawPattern) -> TracePattern
+%%
+%% Makes a trace pattern suitable to feed change_pattern/1
+%% See also erlang:trace_pattern/2 for more info about its match_spec()
+%%
+%% RawPattern = detail_level()
+%% TracePattern = erlang_trace_pattern_match_spec()
+%%
+%% detail_level() = min | max | integer(X) when X =< 0, X >= 100
+%%
+%%   min       - minimum level of tracing  (ignore calls to report_event/4,5)
+%%   max       - maximum level of tracing  (all calls to report_event/4,5)
+%%   integer() - explicit detail level of tracing
+%%----------------------------------------------------------------------
+
+make_pattern(undefined) ->
+    {undefined, undefined};
+make_pattern({Mod, Pattern}) when atom(Mod) ->
+    case Pattern of
+	min ->
+	    {Mod, []};
+	max ->
+	    Head = ['$1', '_', '_', '_', '_'],
+	    Body = [],
+	    Cond = [],
+	    {Mod, [{Head, Cond, Body}]};
+	DetailLevel when integer(DetailLevel) ->
+	    Head = ['$1', '_', '_', '_', '_'],
+	    Body = [],
+	    Cond = [{ '<', '$1', DetailLevel}],
+	    {Mod, [{Head, Cond, Body}]};
+	undefined ->
+	    {Mod, undefined};
+	_ ->
+	    exit({bad_pattern, Pattern})
+    end.
+
+%%----------------------------------------------------------------------
+%% change_pattern(Pattern) -> ok
+%%
+%% Activates/deactivates tracing by changing the current trace pattern
+%%
+%% Pattern = detail_level() |
+%%           empty_match_spec() |
+%%           erlang_trace_pattern_match_spec()
+%%
+%% detail_level() = min | max | integer(X) when X =<0, X >= 100
+%% empty_match_spec() = [] 
+%%
+%% Min detail level deactivates tracing of calls to report_event/4,5
+%%
+%% Max detail level activates tracing of all calls to report_event/4,5
+%%
+%% integer(X) detail level activates tracing of all calls to
+%% report_event/4,5 whose detail level argument is lesser than X.
+%%
+%% An empty match spec deactivates tracing of calls to report_event/4,5
+%%
+%% Other match specs activates tracing of calls to report_event/4,5
+%% accordlingly with erlang:trace_pattern/2.
+%%----------------------------------------------------------------------
+
+change_pattern({Mod, Pattern}) when atom(Mod) ->
+    MFA = {Mod, report_event, 5},
+    case Pattern of
+	undefined ->
+	    ignore;
+        [] ->
+            error_to_exit(dbg:ctp(MFA)),
+            error_to_exit(dbg:p(all, clear));
+        List when list(List) ->
+            error_to_exit(dbg:ctp(MFA)),
+            error_to_exit(dbg:tp(MFA, Pattern)),
+            error_to_exit(dbg:p(all, [call, timestamp]));
+        Other ->
+            change_pattern(make_pattern({Mod, Other}))
+    end,
+    ok.
+
+error_to_exit({error, Reason}) ->
+    exit(Reason);
+error_to_exit({ok, Res}) ->
+    Res.
+
+%%----------------------------------------------------------------------
+%% parse_event(Mod, ValidTraceData) -> false | true | {true, Event}
+%%
+%% Transforms trace data and makes an event record out of it
+%%
+%% ValidTraceData = erlang_trace_data() | record(event)
+%% Mod = module_name() | undefined
+%% module_name() = atom()
+%%
+%% erlang_trace_data() =
+%% 
+%%     {trace, Pid, Label, Info} | 
+%%     {trace, Pid, Label, Info, Extra} | 
+%%     {trace_ts, Pid, Label, Info, ReportedTS} | 
+%%     {trace_ts, Pid, Label, Info, Extra, ReportedTS} | 
+%%     {seq_trace, Label, Info} | 
+%%     {seq_trace, Label, Info, ReportedTS} | 
+%%     {drop, NumberOfDroppedItems}
+%%
+%% See erlang:trace/3 for more info about the semantics of
+%% the trace data.
+%%
+%% An event record consists of the following fields:
+%%
+%%     detail_level - Noise has a high level as opposed to essentials.
+%%     trace_ts     - Time when the trace was generated.
+%%                    Same as event_ts if omitted in trace data.
+%%     event_ts     - Time when the event record was created.
+%%     from         - From actor, such as sender of a message.
+%%     to           - To actor, such as receiver of message.
+%%     label        - Label intended to provide a brief event summary.
+%%     contents     - All nitty gritty details of the event.
+%%
+%% See et:report_event/4 and et:report_event/5 for details.
+%%     
+%% Returns: 
+%%
+%%   {true, Event} - where Event is an #event{} record representing the
+%%                   trace data
+%%   true          - means that the trace data already is an event
+%%                   record and that it is valid as it is.
+%%                   No transformation is needed.
+%%   false         - means that the trace data is uninteresting and
+%%                   should be dropped
+%%----------------------------------------------------------------------
+
+parse_event(_Mod, E) when record(E, event) ->
+    true;
+parse_event(Mod, Trace) ->
+    ParsedTS = erlang:now(),
+    case Trace of
+        {trace, Pid, Label, Info} ->
+            parse_event(Mod, Trace, ParsedTS, ParsedTS, Pid, Label, [Info]);
+        {trace, Pid, Label, Info, Extra} ->
+            parse_event(Mod, Trace, ParsedTS, ParsedTS, Pid, Label, [Info, Extra]);
+        {trace_ts, Pid, Label, Info, ReportedTS} ->
+            parse_event(Mod, Trace, ParsedTS, ReportedTS, Pid, Label, [Info]);
+        {trace_ts, Pid, Label, Info, Extra, ReportedTS} ->
+            parse_event(Mod, Trace, ParsedTS, ReportedTS, Pid, Label, [Info, Extra]);
+        {seq_trace, Label, Info} ->
+            parse_seq_event(Trace, ParsedTS, ParsedTS, Label, Info);
+        {seq_trace, Label, Info, ReportedTS} ->
+            parse_seq_event(Trace, ParsedTS, ReportedTS, Label, Info);
+        {drop, NumberOfDroppedItems} ->
+            DetailLevel = 20,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ParsedTS,
+                          event_ts     = ParsedTS,
+                          from         = undefined,
+                          to           = undefined, 
+                          label        = drop, 
+                          contents     = [{label, drop},
+					  {detail_level, DetailLevel},
+					  {from, undefined},
+					  {to, undefined},
+					  {drop, NumberOfDroppedItems}]}};
+        _ ->
+            error_logger:format("~p(~p): Ignoring unknown trace type -> ~p~n~n",
+                                [?MODULE, ?LINE, Trace]),
+            false
+    end.
+
+parse_seq_event(Trace, ParsedTS, ReportedTS, Label, Info) ->
+    case Info of
+        {send, Serial, From, To, Msg} ->
+            DetailLevel = 15,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS, 
+                          event_ts     = ParsedTS,
+                          from         = From, 
+                          to           = To, 
+                          label        = {seq_send, Label},
+                          contents     = [{label, {seq_send, Label}},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, To},
+					  {serial, Serial},
+					  {msg, Msg}]}};
+        {'receive', Serial, From, To, Msg} ->
+            DetailLevel = 10,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From, 
+                          to           = To,
+                          label        = {seq_receive, Label}, 
+                          contents     = [{label, {seq_receive, Label}},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, To},
+					  {serial, Serial},
+					  {msg, Msg}]}};
+        {print, Serial, From, _, UserInfo} ->
+            DetailLevel = 5,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS, 
+                          event_ts     = ParsedTS,
+                          from         = From, 
+                          to           = From, 
+                          label        = {seq_print, Label},
+                          contents     = [{label, {seq_print, Label}},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {serial, Serial},
+					  {user_info, UserInfo}]}};
+        _ ->
+            error_logger:format("~p(~p): Ignoring unknown trace type -> ~p~n~n",
+                                [?MODULE, ?LINE, Trace]),
+            false
+    end.
+
+parse_event(Mod, Trace, ParsedTS, ReportedTS, From, Label, Contents) ->
+    case Label of
+        'receive' ->
+            DetailLevel = 35,
+            [Msg] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {msg, Msg}]}};
+        send ->
+            DetailLevel = 40,
+            [Msg, To] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = To,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, To},
+					  {msg, Msg}]}};
+        send_to_non_existing_process ->
+            DetailLevel = 40,
+            [Msg, To] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = To,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, To},
+					  {msg, Msg}]}};
+        call ->
+            case Contents of
+                [{M, report_event, [UserDetailLevel, UserFrom, UserTo, UserLabel, UserContents]}] when M == Mod, Mod /= undefined ->
+                    {true, #event{detail_level = UserDetailLevel,
+                                  trace_ts     = ReportedTS,
+                                  event_ts     = ParsedTS,
+                                  from         = UserFrom,
+                                  to           = UserTo,
+                                  label        = UserLabel,
+                                  contents     = UserContents}}; % Term
+                [MFA] ->
+                    DetailLevel = 45,
+                    {true, #event{detail_level = DetailLevel,
+                                  trace_ts     = ReportedTS,
+                                  event_ts     = ParsedTS,
+                                  from         = From,
+                                  to           = From,
+                                  label        = Label,
+                                  contents     = [{label, Label},
+						  {detail_level, DetailLevel},
+						  {from, From},
+						  {to, From},
+						  {mfa, MFA}]}};
+                [MFA, PamResult] ->
+                    DetailLevel = 45,
+                    {true, #event{detail_level = DetailLevel,
+                                  trace_ts     = ReportedTS,
+                                  event_ts     = ParsedTS,
+                                  from         = From,
+                                  to           = From,
+                                  label        = Label,
+                                  contents     = [{label, Label},
+						  {detail_level, DetailLevel},
+						  {from, From},
+						  {to, From},
+						  {mfa, MFA},
+						  {pam_result, PamResult}]}}
+            end;
+        return_to ->
+            DetailLevel = 50,
+            [MFA] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {mfa, MFA}]}};
+        return_from ->
+            DetailLevel = 52,
+            [MFA, ReturnValue] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {mfa, MFA},
+					  {return, ReturnValue}]}};
+        spawn ->
+            DetailLevel = 25,
+            [NewPid, MFA] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = NewPid,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, NewPid},
+					  {mfa, MFA}]}};  % MFA | Term
+        exit ->
+            DetailLevel = 30,
+            [Reason] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {reason, Reason}]}};
+        link ->
+            DetailLevel = 55,
+            [LinkTo] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = LinkTo,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, LinkTo}]}};
+        unlink ->
+            DetailLevel = 60,
+            [UnlinkFrom] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = UnlinkFrom,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, UnlinkFrom}]}};
+        getting_linked ->
+            DetailLevel = 65,
+            [LinkTo] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = LinkTo,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, LinkTo}]}};
+        getting_unlinked ->
+            DetailLevel = 67,
+            [UnlinkFrom] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = UnlinkFrom,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, UnlinkFrom}]}};
+        register ->
+            DetailLevel = 70,
+            [Name] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {name, Name}]}};
+        unregister ->
+            DetailLevel = 75,
+            [Name] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {name, Name}]}};
+        in ->
+            DetailLevel = 90,
+            [MFA] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {mfa, MFA}]}}; % MFA | 0
+        out ->
+            DetailLevel = 95,
+            [MFA] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {mfa, MFA}]}}; % MFA | 0
+        gc_start ->
+            DetailLevel = 80,
+            [GcKeyValueList] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {gc_items, GcKeyValueList}]}};
+        gc_end ->
+            DetailLevel = 85,
+            [GcKeyValueList] = Contents,
+            {true, #event{detail_level = DetailLevel,
+                          trace_ts     = ReportedTS,
+                          event_ts     = ParsedTS,
+                          from         = From,
+                          to           = From,
+                          label        = Label,
+                          contents     = [{label, Label},
+					  {detail_level, DetailLevel},
+					  {from, From},
+					  {to, From},
+					  {gc_items, GcKeyValueList}]}};
+        _ ->
+            error_logger:format("~p(~p): Ignoring unknown trace type -> ~p~n~n",
+                                [?MODULE, ?LINE, Trace]),
+            false
+    end.