mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-23 05:13:48 +00:00
ca0b3b7c6b
Estimated hours taken: 8 Add an option that causes the compiler to pass information to the execution tracing system in one struct, rather than four separate arguments. Two of these arguments are pointers, which each require two instructions to set up on SPARC, MIPS and other RISCs that do not use a global pool. The other two arguments are small constants. Therefore on 32-bit RISCs, replacing MR_trace/4 with MR_trace_struct/1 will probably replace six instructions with two, which saves four instructions' worth of time and 16 bytes of code, at the cost of 12 bytes of data, and possibly the cost of some instructions later loading the info from the struct into registers. However, this loading cost does not have to be paid if tracing is not enabled, and other optimizations may reduce the cost even if tracing is enabled. For example, I strongly suspect that on out-of-order machines, which means most CPUs you can buy today, the load instructions are effectively free, because they happen while the indirect jump to MR_trace_real takes place. I intend to benchmark this option on our various platforms, and have autoconfigure set it on the machines in which it is beneficial. doc/user_guide.texi: Document the new --call-trace-struct option, and say it is not for general use. compiler/options.m: Add the new option. compiler/trace.m: If the option is set, call MR_trace_struct instead of MR_trace, and create a new kind of static (in both senses) global data structure to hold the arguments. Move the definition of trace_port to llds.m, and the procedure to convert it to string to llds_out.m compiler/code_info.m: Add an extra code_info slot to hold this new kind of global data, and its access predicates. compiler/code_gen.m: Transfer this new kind of global data from code_info to the global_data part of module_info. compiler/hlds_module.m: Add a new field to the global_data data structure to hold this data. compiler/mercury_compile.m: Include the new global data in the list of things we give to llds_out. compiler/llds.m: Add a new kind of comp_gen_c_data to hold MR_trace_struct arguments. Also move the definition of trace_port from trace.m to here, since the new kind of comp_gen_c_data refers to this type. compiler/llds_out.m: Add code to print the new kind of comp_gen_c_data. Move the code to print trace_ports from trace.m to here. compiler/llds_common.m: Ignore the new kind of comp_gen_c_data, since by construction its contents are never common with anything else. runtime/mercury_trace_base.[ch]: Add a new variant of MR_trace, MR_trace_struct, that consolidates the arguments into a single MR_Trace_Call_Info struct. Fix a bad variable name: the int argument to MR_trace is a max r register number, not a max mr register number.
347 lines
11 KiB
Mathematica
347 lines
11 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-1999 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This module looks for static data structures in create rvals so that
|
|
% it can make them global, in the hope of replacing multiple local definitions
|
|
% by a single global one.
|
|
%
|
|
% Processes a list of procedures, and a list of c_modules, intended
|
|
% to contain any extra c_data structures the compiler generates.
|
|
% Any other contents of the c_modules list will be untouched.
|
|
|
|
% Main author: zs.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module llds_common.
|
|
|
|
:- interface.
|
|
|
|
:- import_module llds.
|
|
:- import_module prog_data. % for module_name
|
|
:- import_module list.
|
|
|
|
:- pred llds_common(list(c_procedure)::in, list(comp_gen_c_data)::in,
|
|
module_name::in, list(c_procedure)::out, list(comp_gen_c_data)::out)
|
|
is det.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module llds_out.
|
|
:- import_module bool, int, assoc_list, map, std_util, require.
|
|
|
|
:- type cell_info
|
|
---> cell_info(
|
|
int % what is the number of the cell?
|
|
).
|
|
|
|
:- type cell_content == pair(list(maybe(rval)), create_arg_types).
|
|
:- type cell_map == map(cell_content, cell_info).
|
|
:- type cell_list == assoc_list(cell_content, cell_info).
|
|
|
|
:- type common_info
|
|
---> common_info(
|
|
module_name, % base file name
|
|
int, % next cell number
|
|
cell_map
|
|
% map cell contents (including types)
|
|
% to cell declaration information
|
|
).
|
|
|
|
llds_common(Procedures0, Data0, BaseName, Procedures, Data) :-
|
|
map__init(CellMap0),
|
|
Info0 = common_info(BaseName, 0, CellMap0),
|
|
llds_common__process_procs(Procedures0, Procedures, Info0, Info1),
|
|
llds_common__process_datas(Data0, Data1, Info1, Info),
|
|
Info = common_info(_, _, CellMap),
|
|
map__to_assoc_list(CellMap, CellPairs0),
|
|
list__sort(lambda([CellPairA::in, CellPairB::in, Compare::out] is det,
|
|
(
|
|
CellPairA = _ - cell_info(ANum),
|
|
CellPairB = _ - cell_info(BNum),
|
|
compare(Compare, ANum, BNum)
|
|
)), CellPairs0, CellPairs),
|
|
llds_common__cell_pairs_to_modules(CellPairs, BaseName, CommonData),
|
|
list__append(CommonData, Data1, Data).
|
|
|
|
:- pred llds_common__cell_pairs_to_modules(cell_list::in, module_name::in,
|
|
list(comp_gen_c_data)::out) is det.
|
|
|
|
llds_common__cell_pairs_to_modules([], _, []).
|
|
llds_common__cell_pairs_to_modules([CellContent - CellInfo | CellPairs],
|
|
BaseName, [Common | Commons]) :-
|
|
CellInfo = cell_info(VarNum),
|
|
CellContent = Args - ArgTypes,
|
|
Common = comp_gen_c_data(BaseName, common(VarNum), no,
|
|
Args, ArgTypes, []),
|
|
llds_common__cell_pairs_to_modules(CellPairs, BaseName, Commons).
|
|
|
|
:- pred llds_common__process_create(tag::in, list(maybe(rval))::in,
|
|
create_arg_types::in, rval::out, common_info::in, common_info::out)
|
|
is det.
|
|
|
|
llds_common__process_create(Tag, Args0, ArgTypes, Rval, Info0, Info) :-
|
|
llds_common__process_maybe_rvals(Args0, Args, Info0, Info1),
|
|
Info1 = common_info(BaseName, NextCell0, CellMap0),
|
|
( map__search(CellMap0, Args - ArgTypes, CellInfo0) ->
|
|
CellInfo0 = cell_info(VarNum),
|
|
DataConst = data_addr_const(
|
|
data_addr(BaseName, common(VarNum))),
|
|
Rval = mkword(Tag, const(DataConst)),
|
|
Info = Info1
|
|
;
|
|
DataConst = data_addr_const(
|
|
data_addr(BaseName, common(NextCell0))),
|
|
Rval = mkword(Tag, const(DataConst)),
|
|
CellInfo = cell_info(NextCell0),
|
|
NextCell is NextCell0 + 1,
|
|
map__det_insert(CellMap0, Args - ArgTypes, CellInfo, CellMap),
|
|
Info = common_info(BaseName, NextCell, CellMap)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The rest of the file is quite boring. Its only job is to traverse
|
|
% the various components of c_modules to arrive at the creates.
|
|
|
|
:- pred llds_common__process_datas(list(comp_gen_c_data)::in,
|
|
list(comp_gen_c_data)::out, common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_datas([], [], Info, Info).
|
|
llds_common__process_datas([Data0 | Datas0], [Data | Datas], Info0, Info) :-
|
|
llds_common__process_data(Data0, Data, Info0, Info1),
|
|
llds_common__process_datas(Datas0, Datas, Info1, Info).
|
|
|
|
:- pred llds_common__process_data(comp_gen_c_data::in, comp_gen_c_data::out,
|
|
common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_data(
|
|
comp_gen_c_data(Name, DataName, Export, Args0, ArgTypes, Refs),
|
|
comp_gen_c_data(Name, DataName, Export, Args, ArgTypes, Refs),
|
|
Info0, Info) :-
|
|
llds_common__process_maybe_rvals(Args0, Args, Info0, Info).
|
|
llds_common__process_data(
|
|
trace_call_info(Label, Path, MaxRegInUse, Port),
|
|
trace_call_info(Label, Path, MaxRegInUse, Port),
|
|
Info, Info).
|
|
|
|
:- pred llds_common__process_procs(list(c_procedure)::in,
|
|
list(c_procedure)::out, common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_procs([], [], Info, Info).
|
|
llds_common__process_procs([Proc0 | Procs0], [Proc | Procs], Info0, Info) :-
|
|
llds_common__process_proc(Proc0, Proc, Info0, Info1),
|
|
llds_common__process_procs(Procs0, Procs, Info1, Info).
|
|
|
|
:- pred llds_common__process_proc(c_procedure::in, c_procedure::out,
|
|
common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_proc(Proc0, Proc, Info0, Info) :-
|
|
Proc0 = c_procedure(Name, Arity, PredProcId, Instrs0),
|
|
llds_common__process_instrs(Instrs0, Instrs, Info0, Info),
|
|
Proc = c_procedure(Name, Arity, PredProcId, Instrs).
|
|
|
|
:- pred llds_common__process_instrs(list(instruction)::in,
|
|
list(instruction)::out, common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_instrs([], [], Info, Info).
|
|
llds_common__process_instrs([Uinstr0 - Comment | Instrs0],
|
|
[Uinstr - Comment | Instrs], Info0, Info) :-
|
|
llds_common__process_instr(Uinstr0, Uinstr, Info0, Info1),
|
|
llds_common__process_instrs(Instrs0, Instrs, Info1, Info).
|
|
|
|
:- pred llds_common__process_instr(instr::in, instr::out,
|
|
common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_instr(Instr0, Instr, Info0, Info) :-
|
|
(
|
|
Instr0 = comment(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = livevals(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = block(NR, NF, Instrs0),
|
|
llds_common__process_instrs(Instrs0, Instrs, Info0, Info),
|
|
Instr = block(NR, NF, Instrs)
|
|
;
|
|
Instr0 = assign(Lval, Rval0),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info),
|
|
Instr = assign(Lval, Rval)
|
|
;
|
|
Instr0 = call(_, _, _, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = mkframe(_, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = label(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = goto(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
% unlikely to find anything to share, but why not try?
|
|
Instr0 = computed_goto(Rval0, Labels),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info),
|
|
Instr = computed_goto(Rval, Labels)
|
|
;
|
|
Instr0 = c_code(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
% unlikely to find anything to share, but why not try?
|
|
Instr0 = if_val(Rval0, Target),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info),
|
|
Instr = if_val(Rval, Target)
|
|
;
|
|
% unlikely to find anything to share, but why not try?
|
|
Instr0 = incr_hp(Lval, MaybeTag, Rval0, Msg),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info),
|
|
Instr = incr_hp(Lval, MaybeTag, Rval, Msg)
|
|
;
|
|
Instr0 = mark_hp(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
% unlikely to find anything to share, but why not try?
|
|
Instr0 = restore_hp(Rval0),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info),
|
|
Instr = restore_hp(Rval)
|
|
;
|
|
Instr0 = store_ticket(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
% unlikely to find anything to share, but why not try?
|
|
Instr0 = reset_ticket(Rval0, Reason),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info),
|
|
Instr = reset_ticket(Rval, Reason)
|
|
;
|
|
Instr0 = discard_ticket,
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = mark_ticket_stack(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = discard_tickets_to(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = incr_sp(_, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = decr_sp(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = init_sync_term(_, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = fork(_, _, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = join_and_terminate(_),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = join_and_continue(_, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
;
|
|
Instr0 = pragma_c(_, _, _, _, _),
|
|
Instr = Instr0,
|
|
Info = Info0
|
|
).
|
|
|
|
:- pred llds_common__process_rval(rval::in, rval::out,
|
|
common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info) :-
|
|
(
|
|
Rval0 = lval(_),
|
|
Rval = Rval0,
|
|
Info = Info0
|
|
;
|
|
Rval0 = var(_),
|
|
error("var rval found in llds_common__process_rval")
|
|
;
|
|
Rval0 = create(Tag, Args, ArgTypes, StatDyn, _LabelNo, _Msg),
|
|
( StatDyn \= must_be_dynamic ->
|
|
llds_common__process_create(Tag, Args, ArgTypes, Rval,
|
|
Info0, Info)
|
|
;
|
|
Rval = Rval0,
|
|
Info = Info0
|
|
)
|
|
;
|
|
Rval0 = mkword(Tag, SubRval0),
|
|
llds_common__process_rval(SubRval0, SubRval, Info0, Info),
|
|
Rval = mkword(Tag, SubRval)
|
|
;
|
|
Rval0 = const(_),
|
|
Rval = Rval0,
|
|
Info = Info0
|
|
;
|
|
Rval0 = unop(Unop, SubRval0),
|
|
llds_common__process_rval(SubRval0, SubRval, Info0, Info),
|
|
Rval = unop(Unop, SubRval)
|
|
;
|
|
Rval0 = binop(Binop, Left0, Right0),
|
|
llds_common__process_rval(Left0, Left, Info0, Info1),
|
|
llds_common__process_rval(Right0, Right, Info1, Info),
|
|
Rval = binop(Binop, Left, Right)
|
|
;
|
|
Rval0 = mem_addr(MemRef0),
|
|
llds_common__process_mem_ref(MemRef0, MemRef, Info0, Info),
|
|
Rval = mem_addr(MemRef)
|
|
).
|
|
|
|
:- pred llds_common__process_mem_ref(mem_ref::in, mem_ref::out,
|
|
common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_mem_ref(stackvar_ref(N), stackvar_ref(N), Info, Info).
|
|
llds_common__process_mem_ref(framevar_ref(N), framevar_ref(N), Info, Info).
|
|
llds_common__process_mem_ref(heap_ref(Rval0, Tag, N), heap_ref(Rval, Tag, N),
|
|
Info0, Info) :-
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info).
|
|
|
|
:- pred llds_common__process_rvals(list(rval)::in, list(rval)::out,
|
|
common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_rvals([], [], Info, Info).
|
|
llds_common__process_rvals([Rval0 | Rvals0], [Rval | Rvals], Info0, Info) :-
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info1),
|
|
llds_common__process_rvals(Rvals0, Rvals, Info1, Info).
|
|
|
|
:- pred llds_common__process_maybe_rvals(list(maybe(rval))::in,
|
|
list(maybe(rval))::out, common_info::in, common_info::out) is det.
|
|
|
|
llds_common__process_maybe_rvals([], [], Info, Info).
|
|
llds_common__process_maybe_rvals([MaybeRval0 | MaybeRvals0],
|
|
[MaybeRval | MaybeRvals], Info0, Info) :-
|
|
(
|
|
MaybeRval0 = yes(Rval0),
|
|
llds_common__process_rval(Rval0, Rval, Info0, Info1),
|
|
MaybeRval = yes(Rval)
|
|
;
|
|
MaybeRval0 = no,
|
|
MaybeRval = no,
|
|
Info1 = Info0
|
|
),
|
|
llds_common__process_maybe_rvals(MaybeRvals0, MaybeRvals, Info1, Info).
|