View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2023, SWI-Prolog Solutions b.v.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(prolog_profile,
   36          [ profile/1,                  % :Goal
   37            profile/2,                  % :Goal, +Options
   38            show_profile/1,             % +Options
   39            profile_data/1,             % -Dict
   40            profile_procedure_data/2    % :PI, -Data
   41          ]).   42:- autoload(library(error),[must_be/2]).   43:- autoload(library(lists), [member/2]).   44:- autoload(library(option), [option/3]).   45:- autoload(library(pairs), [map_list_to_pairs/3, pairs_values/2]).   46:- autoload(library(prolog_code), [predicate_sort_key/2, predicate_label/2]).   47
   48:- meta_predicate
   49    profile(0),
   50    profile(0, +),
   51    profile_procedure_data(:, -).   52
   53:- set_prolog_flag(generate_debug_info, false).

Execution profiler

This module provides a simple frontend on the execution profiler with a hook to the GUI visualiser for profiling results defined in library(swi/pce_profile). */

   62:- multifile
   63    prolog:show_profile_hook/1.
 profile(:Goal)
 profile(:Goal, +Options)
Run once(Goal) under the execution profiler. If the (xpce) GUI is enabled this predicate is hooked by library(swi/pce_profile) and results are presented in a gui that enables navigating the call tree and jump to predicate implementations. Without the GUI, a simple textual report is generated. Defined options are:
time(Which)
Profile cpu or wall time. The default is CPU time.
sample_rate(Rate)
Samples per second, any numeric value between 1 and 1000
ports(Bool)
Specifies ports counted - true (all ports), false (call port only) or classic (all with some errors). Accomodates space/accuracy tradeoff building call tree.
top(N)
When generating a textual report, show the top N predicates.
cumulative(Bool)
If true (default false), show cumulative output in a textual report.
See also
- show_coverage/2 from library(test_cover).
To be done
- The textual input reflects only part of the information.
   91profile(Goal) :-
   92    profile(Goal, []).
   93
   94profile(Goal0, Options) :-
   95    option(time(Which), Options, cpu),
   96    time_name(Which, How),
   97    option(ports(Ports), Options, classic),
   98    must_be(oneof([true,false,classic]),Ports),
   99    option(sample_rate(Rate), Options, 200),
  100    must_be(between(1.0,1000), Rate),
  101    expand_goal(Goal0, Goal),
  102    call_cleanup('$profile'(Goal, How, Ports, Rate),
  103                 prolog_statistics:show_profile(Options)).
  104
  105time_name(cpu,      cputime)  :- !.
  106time_name(wall,     walltime) :- !.
  107time_name(cputime,  cputime)  :- !.
  108time_name(walltime, walltime) :- !.
  109time_name(Time, _) :-
  110    must_be(oneof([cpu,wall]), Time).
 show_profile(+Options)
Display last collected profiling data. Options are
top(N)
When generating a textual report, show the top N predicates.
cumulative(Bool)
If true (default false), show cumulative output in a textual report.
  122show_profile(N) :-
  123    integer(N),
  124    !,
  125    show_profile([top(N)]).
  126show_profile(Options) :-
  127    profiler(Old, false),
  128    show_profile_(Options),
  129    profiler(_, Old).
  130
  131show_profile_(Options) :-
  132    prolog:show_profile_hook(Options),
  133    !.
  134show_profile_(Options) :-
  135    prof_statistics(Stat),
  136    sort_on(Options, SortKey),
  137    findall(Node, profile_procedure_data(_:_, Node), Nodes),
  138    sort_prof_nodes(SortKey, Nodes, Sorted),
  139    format('~`=t~69|~n'),
  140    format('Total time: ~3f seconds~n', [Stat.time]),
  141    format('~`=t~69|~n'),
  142    format('~w~t~w =~45|~t~w~60|~t~w~69|~n',
  143           [ 'Predicate', 'Box Entries', 'Calls+Redos', 'Time'
  144           ]),
  145    format('~`=t~69|~n'),
  146    option(top(N), Options, 25),
  147    show_plain(Sorted, N, Stat, SortKey).
  148
  149sort_on(Options, ticks_self) :-
  150    option(cumulative(false), Options, false),
  151    !.
  152sort_on(_, ticks).
  153
  154sort_prof_nodes(ticks, Nodes, Sorted) :-
  155    !,
  156    map_list_to_pairs(key_ticks, Nodes, Keyed),
  157    sort(1, >=, Keyed, KeySorted),
  158    pairs_values(KeySorted, Sorted).
  159sort_prof_nodes(Key, Nodes, Sorted) :-
  160    sort(Key, >=, Nodes, Sorted).
  161
  162key_ticks(Node, Ticks) :-
  163    Ticks is Node.ticks_self + Node.ticks_siblings.
  164
  165show_plain([], _, _, _).
  166show_plain(_, 0, _, _) :- !.
  167show_plain([H|T], N, Stat, Key) :-
  168    show_plain(H, Stat, Key),
  169    N2 is N - 1,
  170    show_plain(T, N2, Stat, Key).
  171
  172show_plain(Node, Stat, Key) :-
  173    value(label,                       Node, Pred),
  174    value(call,                        Node, Call),
  175    value(redo,                        Node, Redo),
  176    value(time(Key, percentage, Stat), Node, Percent),
  177    IntPercent is round(Percent*10),
  178    Entry is Call + Redo,
  179    format('~w~t~D =~45|~t~D+~55|~D ~t~1d%~69|~n',
  180           [Pred, Entry, Call, Redo, IntPercent]).
  181
  182
  183                 /*******************************
  184                 *         DATA GATHERING       *
  185                 *******************************/
 profile_data(-Data) is det
Gather all relevant data from profiler. This predicate may be called while profiling is active in which case it is suspended while collecting the data. Data is a dict providing the following fields:
summary:Dict
Overall statistics providing
  • samples:Count: Times the statistical profiler was called
  • ticks:Count Virtual ticks during profiling
  • accounting:Count Tick spent on accounting
  • time:Seconds Total time sampled
  • nodes:Count Nodes in the call graph.
  • sample_period: MicroSeconds Same interval timer period in micro seconds
  • ports: Ports One of true, false or classic
nodes
List of nodes. Each node provides:
  • predicate:PredicateIndicator
  • ticks_self:Count
  • ticks_siblings:Count
  • call:Count
  • redo:Count
  • exit:Count
  • callers:list_of(Relative)
  • callees:list_of(Relative)

Relative is a term of the shape below that represents a caller or callee. Future versions are likely to use a dict instead.

node(PredicateIndicator, CycleID, Ticks, TicksSiblings,
     Calls, Redos, Exits)
  226profile_data(Data) :-
  227    setup_call_cleanup(
  228        profiler(Old, false),
  229        profile_data_(Data),
  230        profiler(_, Old)).
  231
  232profile_data_(profile{summary:Summary, nodes:Nodes}) :-
  233    prof_statistics(Summary),
  234    findall(Node, profile_procedure_data(_:_, Node), Nodes).
 prof_statistics(-Node) is det
Get overall statistics
Arguments:
Node- term of the format prof(Ticks, Account, Time, Nodes)
  242prof_statistics(summary{samples:Samples, ticks:Ticks,
  243                        accounting:Account, time:Time,
  244                        nodes:Nodes,
  245                        sample_period: Period,
  246                        ports: Ports
  247                       }) :-
  248    '$prof_statistics'(Samples, Ticks, Account, Time, Nodes, Period, Ports).
 profile_procedure_data(?Pred, -Data:dict) is nondet
Collect data for Pred. If Pred is unbound data for each predicate that has profile data available is returned. Data is described in profile_data/1 as an element of the nodes key.
  256profile_procedure_data(Pred, Node) :-
  257    Node = node{predicate:Pred,
  258                ticks_self:TicksSelf, ticks_siblings:TicksSiblings,
  259                call:Call, redo:Redo, exit:Exit,
  260                callers:Parents, callees:Siblings},
  261    (   specified(Pred)
  262    ->  true
  263    ;   profiled_predicates(Preds),
  264        member(Pred, Preds)
  265    ),
  266    '$prof_procedure_data'(Pred,
  267                           TicksSelf, TicksSiblings,
  268                           Call, Redo, Exit,
  269                           Parents, Siblings).
  270
  271specified(Module:Head) :-
  272    atom(Module),
  273    callable(Head).
  274
  275profiled_predicates(Preds) :-
  276    setof(Pred, prof_impl(Pred), Preds).
  277
  278prof_impl(Pred) :-
  279    prof_node_id(Node),
  280    node_id_pred(Node, Pred).
  281
  282prof_node_id(N) :-
  283    prof_node_id_below(N, -).
  284
  285prof_node_id_below(N, Root) :-
  286    '$prof_sibling_of'(N0, Root),
  287    (   N = N0
  288    ;   prof_node_id_below(N, N0)
  289    ).
  290
  291node_id_pred(Node, Pred) :-
  292    '$prof_node'(Node, Pred, _Calls, _Redos, _Exits, _Recur,
  293                 _Ticks, _SiblingTicks).
 value(+Key, +NodeData, -Value)
Obtain possible computed attributes from NodeData.
  299value(name, Data, Name) :-
  300    !,
  301    predicate_sort_key(Data.predicate, Name).
  302value(label, Data, Label) :-
  303    !,
  304    predicate_label(Data.predicate, Label).
  305value(ticks, Data, Ticks) :-
  306    !,
  307    Ticks is Data.ticks_self + Data.ticks_siblings.
  308value(time(Key, percentage, Stat), Data, Percent) :-
  309    !,
  310    value(Key, Data, Ticks),
  311    Total = Stat.ticks,
  312    Account = Stat.accounting,
  313    (   Total-Account > 0
  314    ->  Percent is 100 * (Ticks/(Total-Account))
  315    ;   Percent is 0.0
  316    ).
  317value(Name, Data, Value) :-
  318    Value = Data.Name