Files
mercury/compiler/mlds_to_c_global.m
Julien Fischer d21de2c981 Update and fix more copyright notices.
compiler/*.m:
    As above.
2024-12-15 17:14:22 +11:00

491 lines
20 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2018, 2020, 2022-2023 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% Output the declarations and definitions of global data structures.
%
%---------------------------------------------------------------------------%
:- module ml_backend.mlds_to_c_global.
:- interface.
:- import_module libs.
:- import_module libs.indent.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.mlds.
:- import_module ml_backend.mlds_to_c_util.
:- import_module assoc_list.
:- import_module io.
:- import_module list.
%---------------------------------------------------------------------------%
:- pred mlds_output_scalar_cell_group_decls(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in,
assoc_list(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
io::di, io::uo) is det.
:- pred mlds_output_scalar_cell_group_defns(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in,
assoc_list(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
:- pred mlds_output_vector_cell_group_decls(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, mlds_module_name::in, string::in,
assoc_list(ml_vector_common_type_num, ml_vector_cell_group)::in,
io::di, io::uo) is det.
:- pred mlds_output_vector_cell_group_defns(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in,
assoc_list(ml_vector_common_type_num, ml_vector_cell_group)::in,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
:- pred mlds_output_alloc_site_decls(io.text_output_stream::in, indent::in,
assoc_list(mlds_alloc_id, ml_alloc_site_data)::in, io::di, io::uo) is det.
:- pred mlds_output_alloc_site_defns(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, mlds_module_name::in,
assoc_list(mlds_alloc_id, ml_alloc_site_data)::in, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
:- pred mlds_output_global_var_decls(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in,
mlds_module_name::in, list(mlds_global_var_defn)::in,
io::di, io::uo) is det.
:- type maybe_blank_line_between_defns
---> no_blank_line_between_defns
; blank_line_between_defns.
:- pred mlds_output_global_var_defns(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, maybe_blank_line_between_defns::in,
mlds_module_name::in, list(mlds_global_var_defn)::in,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.c_util.
:- import_module backend_libs.rtti.
:- import_module libs.globals.
:- import_module ml_backend.mlds_to_c_class.
:- import_module ml_backend.mlds_to_c_data.
:- import_module ml_backend.mlds_to_c_name.
:- import_module ml_backend.mlds_to_c_stmt.
:- import_module ml_backend.mlds_to_c_type.
:- import_module ml_backend.mlds_to_target_util.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module char.
:- import_module cord.
:- import_module int.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term_context.
:- import_module uint.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
mlds_output_scalar_cell_group_decls(_, _, _, _, [], !IO).
mlds_output_scalar_cell_group_decls(Opts, Stream, Indent,
MangledModuleName, [CellGroup | CellGroups], !IO) :-
mlds_output_scalar_cell_group_decl(Opts, Stream, Indent,
MangledModuleName, CellGroup, !IO),
mlds_output_scalar_cell_group_decls(Opts, Stream, Indent,
MangledModuleName, CellGroups, !IO).
:- pred mlds_output_scalar_cell_group_decl(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in,
pair(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
io::di, io::uo) is det.
mlds_output_scalar_cell_group_decl(Opts, Stream, Indent, MangledModuleName,
TypeNum - CellGroup, !IO) :-
TypeNum = ml_scalar_common_type_num(TypeRawNum),
CellGroup = ml_scalar_cell_group(Type, InitArraySize,
_Counter, _Members, Rows),
( if Type = mlds_mostly_generic_array_type(ElemTypes) then
mlds_output_scalar_cell_group_struct_defn(Opts, Stream, Indent,
MangledModuleName, TypeRawNum, ElemTypes, !IO)
else
true
),
NumRows = cord.length(Rows),
TypeNameStr = scalar_cell_group_type_and_name_to_string_for_c(Opts,
MangledModuleName, TypeRawNum, Type, InitArraySize, NumRows),
io.format(Stream, "\nstatic /* final */ const %s;\n",
[s(TypeNameStr)], !IO).
:- func scalar_cell_group_type_and_name_to_string_for_c(mlds_to_c_opts,
string, int, mlds_type, initializer_array_size, int) = string.
scalar_cell_group_type_and_name_to_string_for_c(Opts, MangledModuleName,
TypeRawNum, Type, InitArraySize, NumRows) = Str :-
( if Type = mlds_mostly_generic_array_type(_) then
string.format("struct %s_scalar_cell_group_%d %s_scalar_common_%d[%d]",
[s(MangledModuleName), i(TypeRawNum),
s(MangledModuleName), i(TypeRawNum), i(NumRows)], Str)
else
type_to_prefix_suffix_for_c(Opts, Type, InitArraySize,
TypePrefix, TypeSuffix),
string.format("%s %s_scalar_common_%d[%d]%s",
[s(TypePrefix), s(MangledModuleName), i(TypeRawNum),
i(NumRows), s(TypeSuffix)], Str)
).
%---------------------%
mlds_output_scalar_cell_group_defns(_, _, _, _, [], !IO).
mlds_output_scalar_cell_group_defns(Opts, Stream, Indent,
MangledModuleName, [CellGroup | CellGroups], !IO) :-
mlds_output_scalar_cell_group_defn(Opts, Stream, Indent,
MangledModuleName, CellGroup, !IO),
mlds_output_scalar_cell_group_defns(Opts, Stream, Indent,
MangledModuleName, CellGroups, !IO).
:- pred mlds_output_scalar_cell_group_defn(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in,
pair(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
io::di, io::uo) is det.
mlds_output_scalar_cell_group_defn(Opts, Stream, Indent, MangledModuleName,
TypeNum - CellGroup, !IO) :-
TypeNum = ml_scalar_common_type_num(TypeRawNum),
CellGroup = ml_scalar_cell_group(Type, InitArraySize,
_Counter, _Members, RowCords),
Rows = cord.list(RowCords),
list.length(Rows, NumRows),
IndentStr = indent2_string(Indent),
TypeNameStr = scalar_cell_group_type_and_name_to_string_for_c(Opts,
MangledModuleName, TypeRawNum, Type, InitArraySize, NumRows),
io.format(Stream, "\n%sstatic /* final */ const %s = {\n",
[s(IndentStr), s(TypeNameStr)], !IO),
list.foldl2(mlds_output_cell(Opts, Stream, Indent + 1u), Rows, 0, _, !IO),
io.format(Stream, "%s};\n", [s(IndentStr)], !IO).
:- pred mlds_output_scalar_cell_group_struct_defn(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in, int::in,
list(mlds_type)::in, io::di, io::uo) is det.
mlds_output_scalar_cell_group_struct_defn(Opts, Stream, Indent,
MangledModuleName, TypeRawNum, ElemTypes, !IO) :-
output_pragma_pack_push(Stream, !IO),
IndentStr = indent2_string(Indent),
io.format(Stream, "%sstruct %s_scalar_cell_group_%d {\n",
[s(IndentStr), s(MangledModuleName), i(TypeRawNum)], !IO),
list.foldl2(
mlds_output_scalar_cell_group_struct_field(Opts, Stream, Indent + 1u),
ElemTypes, 1, _, !IO),
io.format(Stream, "%s};\n", [s(IndentStr)], !IO),
output_pragma_pack_pop(Stream, !IO).
:- pred mlds_output_scalar_cell_group_struct_field(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, mlds_type::in, int::in, int::out,
io::di, io::uo) is det.
mlds_output_scalar_cell_group_struct_field(Opts, Stream, Indent, FieldType,
Num, Num + 1, !IO) :-
IndentStr = indent2_string(Indent),
( if
% Ensure double-word float, int64 and uint64 structure members
% are word-aligned, not double-aligned.
(
FieldType = mlds_builtin_type_float,
TypeName = "MR_Float_Aligned"
;
FieldType = mlds_builtin_type_int(IntType),
(
IntType = int_type_int64,
TypeName = "MR_Int64Aligned"
;
IntType = int_type_uint64,
TypeName = "MR_Uint64Aligned"
)
)
then
io.format(Stream, "%s%s f%d;\n",
[s(IndentStr), s(TypeName), i(Num)], !IO)
else
type_to_prefix_suffix_for_c_no_size(Opts, FieldType,
TypePrefix, TypeSuffix),
expect(unify(TypeSuffix, ""), $pred, "TypeSuffix is not empty"),
io.format(Stream, "%s%s f%d;\n",
[s(IndentStr), s(TypePrefix), i(Num)], !IO)
).
%---------------------------------------------------------------------------%
mlds_output_vector_cell_group_decls(_, _, _, _, _, [], !IO).
mlds_output_vector_cell_group_decls(Opts, Stream, Indent,
ModuleName, MangledModuleName, [CellGroup | CellGroups], !IO) :-
mlds_output_vector_cell_group_decl(Opts, Stream, Indent,
ModuleName, MangledModuleName, CellGroup, !IO),
mlds_output_vector_cell_group_decls(Opts, Stream, Indent,
ModuleName, MangledModuleName, CellGroups, !IO).
:- pred mlds_output_vector_cell_group_decl(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, mlds_module_name::in, string::in,
pair(ml_vector_common_type_num, ml_vector_cell_group)::in,
io::di, io::uo) is det.
mlds_output_vector_cell_group_decl(Opts, Stream, Indent,
ModuleName, MangledModuleName, TypeNum - CellGroup, !IO) :-
TypeNum = ml_vector_common_type_num(TypeRawNum),
CellGroup = ml_vector_cell_group(Type, StructDefn, _FieldNames,
_NextRow, Rows),
NumRows = cord.length(Rows),
IndentStr = indent2_string(Indent),
type_to_prefix_suffix_for_c(Opts, Type, no_size, TypePrefix, TypeSuffix),
mlds_output_struct_defn(Opts, Stream, Indent, ModuleName, StructDefn, !IO),
io.format(Stream,
"\n%sstatic /* final */ const %s %s_vector_common_%d[%d]%s;\n",
[s(IndentStr), s(TypePrefix),
s(MangledModuleName), i(TypeRawNum), i(NumRows), s(TypeSuffix)], !IO).
%---------------------%
mlds_output_vector_cell_group_defns(_, _, _, _, [], !IO).
mlds_output_vector_cell_group_defns(Opts, Stream, Indent,
MangledModuleName, [CellGroup | CellGroups], !IO) :-
mlds_output_vector_cell_group_defn(Opts, Stream, Indent,
MangledModuleName, CellGroup, !IO),
mlds_output_vector_cell_group_defns(Opts, Stream, Indent,
MangledModuleName, CellGroups, !IO).
:- pred mlds_output_vector_cell_group_defn(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, string::in,
pair(ml_vector_common_type_num, ml_vector_cell_group)::in,
io::di, io::uo) is det.
mlds_output_vector_cell_group_defn(Opts, Stream, Indent, MangledModuleName,
TypeNum - CellGroup, !IO) :-
TypeNum = ml_vector_common_type_num(TypeRawNum),
CellGroup = ml_vector_cell_group(Type, _ClassDefn, _FieldNames,
_NextRow, RowCords),
Rows = cord.list(RowCords),
list.length(Rows, NumRows),
IndentStr = indent2_string(Indent),
type_to_prefix_suffix_for_c(Opts, Type, no_size, TypePrefix, TypeSuffix),
io.format(Stream,
"\n%sstatic /* final */ const %s %s_vector_common_%d[%d]%s = {\n",
[s(IndentStr), s(TypePrefix),
s(MangledModuleName), i(TypeRawNum), i(NumRows), s(TypeSuffix)], !IO),
list.foldl2(mlds_output_cell(Opts, Stream, Indent + 1u), Rows, 0, _, !IO),
io.format(Stream, "%s};\n", [s(IndentStr)], !IO).
:- pred mlds_output_cell(mlds_to_c_opts::in, io.text_output_stream::in,
indent::in, mlds_initializer::in, int::in, int::out,
io::di, io::uo) is det.
mlds_output_cell(Opts, Stream, Indent, Initializer, !RowNum, !IO) :-
IndentStr = indent2_string(Indent),
( if Initializer = init_struct(_, [_]) then
EndChar = ' '
else
EndChar = '\n'
),
ThisRowNum = !.RowNum,
!:RowNum = !.RowNum + 1,
io.format(Stream, "%s/* row %3d */%c",
[s(IndentStr), i(ThisRowNum), c(EndChar)], !IO),
mlds_output_initializer_body(Opts, Stream, Indent, Initializer, !IO),
io.write_string(Stream, ",\n", !IO).
%---------------------------------------------------------------------------%
mlds_output_alloc_site_decls(Stream, Indent, AllocSites, !IO) :-
(
AllocSites = []
;
AllocSites = [_ | _],
list.length(AllocSites, NumAllocSites),
IndentStr = indent2_string(Indent),
io.format(Stream, "%sstatic MR_AllocSiteInfo MR_alloc_sites[%d];\n",
[s(IndentStr), i(NumAllocSites)], !IO)
).
%---------------------%
mlds_output_alloc_site_defns(Opts, Stream, Indent, MLDS_ModuleName,
AllocSites, !IO) :-
(
AllocSites = []
;
AllocSites = [_ | _],
list.length(AllocSites, NumAllocSites),
IndentStr = indent2_string(Indent),
io.format(Stream, "%sstatic MR_AllocSiteInfo MR_alloc_sites[%d] = {\n",
[s(IndentStr), i(NumAllocSites)], !IO),
list.foldl(
mlds_output_alloc_site_defn(Opts, Stream, Indent + 1u,
MLDS_ModuleName),
AllocSites, !IO),
io.format(Stream, "%s};\n", [s(IndentStr)], !IO)
).
:- pred mlds_output_alloc_site_defn(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, mlds_module_name::in,
pair(mlds_alloc_id, ml_alloc_site_data)::in, io::di, io::uo) is det.
mlds_output_alloc_site_defn(_Opts, Stream, Indent, MLDS_ModuleName,
_AllocId - AllocData, !IO) :-
AllocData = ml_alloc_site_data(FuncName, Context, Type, Size),
QualFuncName = qual_function_name(MLDS_ModuleName, FuncName),
QualFuncNameStr = qual_function_name_to_string_for_c(QualFuncName),
TypeStr = quote_string_c(Type),
Context = context(FileName, LineNumber),
FileNameStr = quote_string_c(FileName),
IndentStr = indent2_string(Indent),
io.format(Stream, "%s{ %s, %s, %d, %s, %d },\n",
[s(IndentStr), s(QualFuncNameStr), s(FileNameStr), i(LineNumber),
s(TypeStr), i(Size)], !IO).
%---------------------------------------------------------------------------%
mlds_output_global_var_decls(_, _, _, _, [], !IO).
mlds_output_global_var_decls(Opts, Stream, Indent, ModuleName,
[GlobalVarDefn | GlobalVarDefns], !IO) :-
io.nl(Stream, !IO),
mlds_output_global_var_decl(Opts, Stream, Indent,
ModuleName, GlobalVarDefn, !IO),
mlds_output_global_var_decls(Opts, Stream, Indent, ModuleName,
GlobalVarDefns, !IO).
:- pred mlds_output_global_var_decl(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, mlds_module_name::in,
mlds_global_var_defn::in, io::di, io::uo) is det.
mlds_output_global_var_decl(Opts, Stream, Indent, MLDS_ModuleName,
GlobalVarDefn, !IO) :-
GlobalVarDefn = mlds_global_var_defn(GlobalVarName, Context, Flags,
Type, Initializer, _GCStmt),
IndentStr = indent2_string(Indent),
FlagsPrefix = global_var_decl_flags_to_prefix(forward_decl, Flags),
TypeNameStr = global_var_decl_to_type_name_string(Opts, MLDS_ModuleName,
GlobalVarName, Type, get_initializer_array_size(Initializer)),
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
io.format(Stream, "%s%s%s;\n",
[s(IndentStr), s(FlagsPrefix), s(TypeNameStr)], !IO).
:- func global_var_decl_to_type_name_string(mlds_to_c_opts, mlds_module_name,
mlds_global_var_name, mlds_type, initializer_array_size) = string.
global_var_decl_to_type_name_string(Opts, MLDS_ModuleName, GlobalVarName,
Type, InitializerSize) = DeclStr :-
type_to_prefix_suffix_for_c(Opts, Type, InitializerSize,
TypePrefix, TypeSuffix),
QualGlobalVarNameStr = maybe_qual_global_var_name_to_string_for_c(
MLDS_ModuleName, GlobalVarName),
string.format("%s %s%s",
[s(TypePrefix), s(QualGlobalVarNameStr), s(TypeSuffix)], DeclStr).
%---------------------%
mlds_output_global_var_defns(_, _, _, _, _, [], !IO).
mlds_output_global_var_defns(Opts, Stream, Indent, BlankLine, ModuleName,
[GlobalVarDefn | GlobalVarDefns], !IO) :-
mlds_output_global_var_defn(Opts, Stream, Indent, BlankLine, ModuleName,
GlobalVarDefn, !IO),
mlds_output_global_var_defns(Opts, Stream, Indent, BlankLine, ModuleName,
GlobalVarDefns, !IO).
:- pred mlds_output_global_var_defn(mlds_to_c_opts::in,
io.text_output_stream::in, indent::in, maybe_blank_line_between_defns::in,
mlds_module_name::in, mlds_global_var_defn::in, io::di, io::uo) is det.
mlds_output_global_var_defn(Opts, Stream, Indent, BlankLine,
MLDS_ModuleName, GlobalVarDefn, !IO) :-
GlobalVarDefn = mlds_global_var_defn(GlobalVarName, Context, Flags,
Type, Initializer, GCStmt),
Flags = mlds_global_var_decl_flags(Access, _Constness),
ShouldModuleQual = should_module_qualify_global_var_name(GlobalVarName),
( if
Access = gvar_acc_whole_program,
ShouldModuleQual = no,
% Some rtti variables are supposed to be exported without being module
% qualified.
GlobalVarName \= gvn_rtti_var(_)
then
unexpected($pred,
"whole-program visible global var is not module qualified")
else
true
),
(
BlankLine = blank_line_between_defns,
io.nl(Stream, !IO)
;
BlankLine = no_blank_line_between_defns
),
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
IndentStr = indent2_string(Indent),
FlagsPrefix = global_var_decl_flags_to_prefix(definition, Flags),
TypeNameStr = global_var_decl_to_type_name_string(Opts, MLDS_ModuleName,
GlobalVarName, Type, get_initializer_array_size(Initializer)),
io.format(Stream, "%s%s%s",
[s(IndentStr), s(FlagsPrefix), s(TypeNameStr)], !IO),
mlds_output_initializer(Opts, Stream, Type, Initializer, !IO),
io.write_string(Stream, ";\n", !IO),
mlds_output_gc_statement(Opts, Stream, Indent, GCStmt, "", !IO).
%---------------------------------------------------------------------------%
:- func global_var_decl_flags_to_prefix(decl_or_defn,
mlds_global_var_decl_flags) = string.
global_var_decl_flags_to_prefix(DeclOrDefn, Flags) = Prefix :-
Flags = mlds_global_var_decl_flags(Access, Constness),
AccessPrefix = global_var_extern_or_static_prefix(DeclOrDefn, Access),
ConstnessPrefix = constness_prefix(Constness),
Prefix = AccessPrefix ++ ConstnessPrefix.
% mlds_output_global_var_extern_or_static does for global variables
% what mlds_output_extern_or_static does for other entities.
%
:- func global_var_extern_or_static_prefix(decl_or_defn, global_var_access)
= string.
global_var_extern_or_static_prefix(DeclOrDefn, Access) = Prefix :-
(
Access = gvar_acc_module_only,
Prefix = "static "
;
Access = gvar_acc_whole_program,
(
DeclOrDefn = forward_decl,
Prefix = "extern "
;
DeclOrDefn = definition,
% Print no storage class.
Prefix = ""
)
).
:- func constness_prefix(constness) = string.
constness_prefix(const) = "const ".
constness_prefix(modifiable) = "".
%---------------------------------------------------------------------------%
:- end_module ml_backend.mlds_to_c_global.
%---------------------------------------------------------------------------%