Files
mercury/compiler/llds_common.m
Fergus Henderson cbbd48080f Restructure the handling of RTTI and pseudo_type_infos
Estimated hours taken: 30

Restructure the handling of RTTI and pseudo_type_infos
to reduce dependencies on the LLDS.

compiler/rtti.m:
	- Change the various occurrences of llds__rval to rtti_data.
	- Add `field_types' and `pseudo_type_info' as
	  new alternatives in the rtti_data and rtti_name types,
	  to provide ways of representing things that were
	  previously represented as create() llds__rvals.

compiler/rtti_out.m:
	- Add some documentation to the interface.
	- Modify to handle the changes to rtti.m.

compiler/type_ctor_info.m:
	- Modify to handle the changes to rtti.m.
	- Don't thread the cell_count or module_info through
	  most of the code here, since it is no longer necessary.
	- Modify the interface to eliminate dependency on LLDS:
	  change generate_llds to return a list(rtti_data)
	  rather than a list(llds__comp_gen_c_data), and rename
	  it as generate_rtti.

compiler/mercury_compile.m:
	Update to reflect the changed interface to type_ctor_info.m.

compiler/pseudo_type_info.m:
	Rewrite much of this module to eliminate all dependencies on LLDS.
	Rather than generating an llds__rval, this module now generates a new
	type pseudo_type_info (which is used in the pseudo_type_info
	alternative of the rtti_data type).

compiler/ll_pseudo_type_info.m:
	New file, contains the parts of pseudo_type_info.m that depended on
	LLDS.  This is needed for stack_layout.m, which still needs
	pseudo_type_infos represented as llds__rvals.

compiler/stack_layout.m:
	Call the routines in ll_pseudo_type_info rather than those in
	pseudo_type_info.

compiler/llds_common.m:
	Don't traverse rtti_data rvals, since they can't contain create()
	rvals anymore.

compiler/opt_debug.m:
	Handle the new `field_types' and `pseudo_type_info' alternatives in
	the rtti_data and rtti_name types.

compiler/rtti.m:
compiler/rtti_out.m:
compiler/llds_out.m:
	The predicate `rtti_address_would_include_code_addrs' was
	duplicated in both rtti.m and rtti_out.m. I deleted
	the version in rtti.m, exported the version in rtti_out.m,
	and changed llds_out.m to call the version in rtti_out.m.

runtime/mercury_type_info.h:
	- Define macros for defining MR_TypeInfo and MR_PseudoTypeInfo
	  struct types of different arities, for use by the code
	  generated by compiler/rtti_out.m.
	- Define MR_TypeCtorInfo as a pointer to a _const_ struct type,
	  to avoid the need to generate casts to cast-away-const in
	  various places in compiler/rtti_out.m.
	  Likewise for MR_PseudoTypeInfo.
	  (It would be nice to do the same thing for MR_TypeInfo,
	  since we never modify MR_TypeInfo values after
	  constructing them, but currently they are modified by the
	  MR_fill_in_*() macros which are used to construct them.)
	- Fix a couple of places where macro arguments were not
	  properly parenthesized.
2000-04-02 08:09:50 +00:00

360 lines
11 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2000 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 rtti, 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(rtti_data(RttiData), rtti_data(RttiData),
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, Reconstruction),
llds_common__process_instrs(Instrs0, Instrs, Info0, Info),
Proc = c_procedure(Name, Arity, PredProcId, Instrs, Reconstruction).
:- 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 = free_heap(_),
Instr = Instr0,
Info = Info0
;
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 = prune_ticket,
Instr = Instr0,
Info = Info0
;
Instr0 = mark_ticket_stack(_),
Instr = Instr0,
Info = Info0
;
Instr0 = prune_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, _Reuse),
( 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_rval(maybe(rval)::in,
maybe(rval)::out, common_info::in, common_info::out) is det.
llds_common__process_maybe_rval(MaybeRval0, MaybeRval, Info0, Info) :-
(
MaybeRval0 = yes(Rval0),
llds_common__process_rval(Rval0, Rval, Info0, Info),
MaybeRval = yes(Rval)
;
MaybeRval0 = no,
MaybeRval = no,
Info = Info0
).
:- 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) :-
llds_common__process_maybe_rval(MaybeRval0, MaybeRval, Info0, Info1),
llds_common__process_maybe_rvals(MaybeRvals0, MaybeRvals, Info1, Info).