mercury/browser/collect_lib.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1999-2002, 2005-2006 The University of Melbourne.
% Copyright (C) 2015-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: collect_lib.m.
% Author: jahier.
% Purpose:
%   This module defines functions that are needed to implement the
%   `collect' primitive.
%
%   `collect' collects runtime information from Mercury program executions.
%   It is intended to let users easily implement their own monitors with
%   acceptable performances.
%
%   To use it, users just need to define 4 things in a file, using the
%   Mercury syntax:
%       1) `accumulator_type' which is the type of the accumulator.
%       2) The predicate initialize/1 which initializes the
%          collecting variable. initialize/1 should respect the
%          following declarations:
%           :- pred initialize(accumulator_type).
%           :- mode initialize(out) is det.
%       3) The predicate filter/4 which updates the collecting
%          variable at each execution event. filter/4 also outputs
%          a variable that indicates whether to stop collecting.
%          If this variable is set to `stop', the collect process
%          stops; if it is set to `continue', it continues. If this
%          variable is always set to `continue', the collecting will
%          process until the last event is reached. filter/4 should
%          respect the following declarations:
%           :- pred filter(event, accumulator_type, accumulator_type,
%               stop_or_continue).
%           :- mode filter(in, di, uo, out) is det.
%               4) Optionally, a `post_process/2' function that lets
%                  one post-process the final value of the
%                  accumulator. `post_process/2' should respect the
%                  following declarations:
%                   :- pred post_process(accumulator_type, collected_type).
%                   :- mode post_process(in, out) is det.
%              If `collected_type' is different from `accumulator_type',
%              the `accumulator_type' should also be defined; otherwise
%              by default, `accumulator_type' is automatically defined as
%              being the same type as `collected_type'.
%       5) And optionally the mode definition of the second and the
%          third arguments of filter/4: `acc_in' and `acc_out'. Those
%          mode have `di' and `uo' respectively as default values.
%
%   Then, this file is used to generate the Mercury module `collect.m',
%   which is compiled and dynamically linked with the current execution.
%   When a `collect' request is made from the external debugger, a variable
%   of type accumulator_type is first initialized (with initialize/1) and
%   then updated (with filter/4) for all the events of the remaining
%   execution. When the end of the execution is reached, the last value of
%   the collecting variable is send to the debugger.

:- module mdb.collect_lib.
:- interface.

:- pred dummy_pred_to_avoid_warning_about_nothing_exported is det.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

:- import_module mdb.dl.

:- import_module char.
:- import_module io.

%---------------------------------------------------------------------------%

dummy_pred_to_avoid_warning_about_nothing_exported.

:- pragma foreign_export("C",
    link_collect(in, out, out, out, out, out, out, out, di, uo),
    "ML_CL_link_collect").

:- pragma foreign_export("C", unlink_collect(in, di, uo),
    "ML_CL_unlink_collect").

% We need Handle to be able to close the shared object (dl.close) later on.
% When the link failed, we output NULL pointers instead of maybe pointers
% for performance reasons; indeed, filter will be called at every event
% so we don't want to pay the price of the maybe variable de-construction
% at each event.

% dynamically link the collect module;
:- pred link_collect(string::in, c_pointer::out, c_pointer::out,
    c_pointer::out, c_pointer::out, c_pointer::out, dl_result(handle)::out,
    char::out, io::di, io::uo) is det.

link_collect(ObjectFile, Filter, Initialize, PostProcess, SendResult,
        GetCollectType, MaybeHandle, Result, !IO) :-
    % Link in the object code for the module `collect' from ObjectFile.
    dl.open(ObjectFile, lazy, scope_local, MaybeHandle, !IO),
    (
        MaybeHandle = dl_error(Msg),
        % XXX Our caller should tell us on what stream we should print
        % any error messages, but
        %
        % - since link_collect is exported to C, that would require changes
        %   to the relevant C code, and
        %
        % - that C code has not been used in a long time, so there is
        %   no good way to test such changes.
        %
        % The code here preserves old behavior.
        io.output_stream(Stream, !IO),
        io.print(Stream, "dlopen failed: ", !IO),
        io.print(Stream, Msg, !IO),
        io.nl(Stream, !IO),
        set_to_null_pointer(Initialize),
        set_to_null_pointer(Filter),
        set_to_null_pointer(PostProcess),
        set_to_null_pointer(SendResult),
        set_to_null_pointer(GetCollectType),
        Result = 'n'
    ;
        MaybeHandle = dl_ok(Handle),

        % Look up the address of the C functions corresponding to the
        % initialize/1 and filter/15 predicates in the collect module.
        dl.sym(Handle, "ML_COLLECT_initialize", MaybeInitialize, !IO),
        dl.sym(Handle, "ML_COLLECT_filter", MaybeFilter, !IO),
        dl.sym(Handle, "ML_COLLECT_post_process", MaybePostProcess, !IO),
        dl.sym(Handle, "ML_COLLECT_send_collect_result", MaybeSendResult, !IO),
        dl.sym(Handle, "ML_COLLECT_collected_variable_type", MaybeType, !IO),
        ( if
            MaybeInitialize = dl_ok(Initialize0),
            MaybeFilter = dl_ok(Filter0),
            MaybePostProcess = dl_ok(PostProcess0),
            MaybeSendResult = dl_ok(SendResult0),
            MaybeType = dl_ok(Type0)
        then
            Result = 'y',
            Initialize = Initialize0,
            Filter = Filter0,
            PostProcess = PostProcess0,
            GetCollectType = Type0,
            SendResult = SendResult0
        else
            set_to_null_pointer(Initialize),
            set_to_null_pointer(Filter),
            set_to_null_pointer(PostProcess),
            set_to_null_pointer(SendResult),
            set_to_null_pointer(GetCollectType),
            Result = 'n'
        )
    ).

:- pred set_to_null_pointer(c_pointer::out) is det.
:- pragma no_determinism_warning(set_to_null_pointer/1).

:- pragma foreign_proc("C",
    set_to_null_pointer(Pointer::out),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    (Pointer = (MR_Word) NULL)
").

set_to_null_pointer(_) :-
    private_builtin.sorry("collect_lib.set_to_null_pointer").

%---------------------------------------------------------------------------%

    % Dynamically unlink a module that was dynamically linked in
    % using `link_collect'.
    %
:- pred unlink_collect(dl_result(handle)::in, io::di, io::uo) is det.

unlink_collect(MaybeHandle, !IO) :-
    (
        MaybeHandle = dl_error(_)
        % There is nothing to close since an error(_) here means that
        % the dlopen failed.
    ;
        MaybeHandle = dl_ok(Handle),
        dl.close(Handle, Result, !IO),
        % XXX See the comment in link_collect about streams.
        io.output_stream(Stream, !IO),
        display_close_result(Stream, Result, !IO)
    ).

:- pred display_close_result(io.text_output_stream::in, dl_result::in,
    io::di, io::uo) is det.

display_close_result(_Stream, dl_ok, !IO).
display_close_result(Stream, dl_error(String), !IO) :-
    io.print(Stream, String, !IO),
    io.nl(Stream, !IO).