mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-15 22:03:26 +00:00
Estimated hours taken: 2 Branches: main compiler/*.m: Import only one compiler module per line. Sort the blocks of imports. This makes it easier to merge in changes. In a couple of places, remove unnecessary imports.
4582 lines
153 KiB
Mathematica
4582 lines
153 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2003 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.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% LLDS - The Low-Level Data Structure.
|
|
|
|
% This module defines the routines for printing out LLDS,
|
|
% the Low Level Data Structure.
|
|
|
|
% Main authors: conway, fjh, zs.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module ll_backend__llds_out.
|
|
|
|
:- interface.
|
|
|
|
:- import_module aditi_backend__rl_file.
|
|
:- import_module backend_libs__builtin_ops.
|
|
:- import_module backend_libs__proc_label.
|
|
:- import_module hlds__hlds_data.
|
|
:- import_module libs__globals.
|
|
:- import_module ll_backend__llds.
|
|
:- import_module parse_tree__prog_data.
|
|
|
|
:- import_module bool, std_util, list, map, io.
|
|
|
|
% Given a 'c_file' structure, output the LLDS code inside it
|
|
% into one or more .c files, depending on the setting of the
|
|
% --split-c-files option. The second argument gives the set of
|
|
% labels that have layout structures. The third gives the Aditi-RL
|
|
% code for the module.
|
|
|
|
:- pred output_llds(c_file::in, map(label, data_addr)::in, maybe(rl_file)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
% output_c_file_intro_and_grade(SourceFileName, Version)
|
|
% outputs a comment which includes the settings used to generate
|
|
% the C file. This is used by configure to check the any
|
|
% existing C files are consistent with the current
|
|
% configuration. SourceFileName is the name of the file from
|
|
% which the C is generated, while Version is the version name
|
|
% of the mercury compiler.
|
|
:- pred output_c_file_intro_and_grade(string, string, io__state, io__state).
|
|
:- mode output_c_file_intro_and_grade(in, in, di, uo) is det.
|
|
|
|
% output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
% DeclSet0, DeclSet) outputs the declarations of any static constants,
|
|
% etc. that need to be declared before output_rval(Rval) is called.
|
|
% FirstIndent is output before the first declaration, while
|
|
% LaterIndent is output before all later declaration; N0 and N
|
|
% give the number of declarations output before and after this call.
|
|
%
|
|
% Every time we emit a declaration for a symbol, we insert it into the
|
|
% set of symbols we've already declared. That way, we avoid generating
|
|
% the same symbol twice, which would cause an error in the C code.
|
|
|
|
:- pred output_rval_decls(rval, string, string, int, int, decl_set, decl_set,
|
|
io__state, io__state).
|
|
:- mode output_rval_decls(in, in, in, in, out, in, out, di, uo) is det.
|
|
|
|
:- pred output_rvals_decls(list(rval)::in, string::in, string::in,
|
|
int::in, int::out, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
% output an rval (not converted to any particular type,
|
|
% but instead output as its "natural" type)
|
|
|
|
:- pred output_rval(rval, io__state, io__state).
|
|
:- mode output_rval(in, di, uo) is det.
|
|
|
|
% output_code_addr_decls(CodeAddr, ...) outputs the declarations of any
|
|
% extern symbols, etc. that need to be declared before
|
|
% output_code_addr(CodeAddr) is called. The meanings of the other
|
|
% arguments are as above.
|
|
|
|
:- pred output_code_addr_decls(code_addr, string, string, int, int,
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_code_addr_decls(in, in, in, in, out, in, out, di, uo) is det.
|
|
|
|
:- pred output_code_addrs_decls(list(code_addr), string, string, int, int,
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_code_addrs_decls(in, in, in, in, out, in, out, di, uo) is det.
|
|
|
|
:- pred output_code_addr(code_addr, io__state, io__state).
|
|
:- mode output_code_addr(in, di, uo) is det.
|
|
|
|
% output_data_addr_decls(DataAddr, ...) outputs the declarations of
|
|
% any static constants, etc. that need to be declared before
|
|
% output_data_addr(DataAddr) is called. The meanings of the other
|
|
% arguments are as above.
|
|
|
|
:- pred output_data_addr_decls(data_addr::in, string::in, string::in,
|
|
int::in, int::out, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
:- pred output_data_addrs_decls(list(data_addr)::in, string::in, string::in,
|
|
int::in, int::out, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
:- pred output_data_addr(data_addr::in, io__state::di, io__state::uo) is det.
|
|
|
|
% All the C data structures we generate which are either fully static
|
|
% or static after initialization should have this prefix.
|
|
:- func mercury_data_prefix = string.
|
|
|
|
% c_data_linkage_string(Globals, DefaultLinkage, StaticEvenIfSplit,
|
|
% BeingDefined):
|
|
% Return a C string that gives the storage class appropriate for the
|
|
% definition of a global variable with the specified properties.
|
|
|
|
:- func c_data_linkage_string(globals, linkage, bool, bool) = string.
|
|
|
|
% Given a boolean that states whether a data item includes code
|
|
% addresses or not, return a C string that gives its "const-ness".
|
|
|
|
:- pred c_data_const_string(globals::in, bool::in, string::out) is det.
|
|
|
|
% Convert an lval to a string description of that lval.
|
|
|
|
:- pred llds_out__lval_to_string(lval, string).
|
|
:- mode llds_out__lval_to_string(in, out) is semidet.
|
|
|
|
% Convert a register to a string description of that register.
|
|
|
|
:- pred llds_out__reg_to_string(reg_type, int, string).
|
|
:- mode llds_out__reg_to_string(in, in, out) is det.
|
|
|
|
% Convert a binary operator to a string description of that operator.
|
|
|
|
:- pred llds_out__binary_op_to_string(binary_op, string).
|
|
:- mode llds_out__binary_op_to_string(in, out) is det.
|
|
|
|
% Output an instruction and (if the third arg is yes) the comment.
|
|
% This predicate is provided for debugging use only.
|
|
|
|
:- pred output_instruction_and_comment(instr, string, bool,
|
|
io__state, io__state).
|
|
:- mode output_instruction_and_comment(in, in, in, di, uo) is det.
|
|
|
|
% Output an instruction.
|
|
% This predicate is provided for debugging use only.
|
|
|
|
:- pred output_instruction(instr, io__state, io__state).
|
|
:- mode output_instruction(in, di, uo) is det.
|
|
|
|
% Output a label (used by garbage collection).
|
|
|
|
:- pred output_label(label, io__state, io__state).
|
|
:- mode output_label(in, di, uo) is det.
|
|
|
|
% Output a proc label (used for building static call graph for prof).
|
|
|
|
:- pred output_proc_label(proc_label, io__state, io__state).
|
|
:- mode output_proc_label(in, di, uo) is det.
|
|
|
|
% Get a proc label string (used by procs which are exported to C).
|
|
% The boolean controls whether a prefix ("mercury__") is added to the
|
|
% proc label.
|
|
|
|
:- pred llds_out__get_proc_label(proc_label, bool, string).
|
|
:- mode llds_out__get_proc_label(in, in, out) is det.
|
|
|
|
% Get a label string.
|
|
% The boolean controls whether a prefix ("mercury__") is added to the
|
|
% label.
|
|
|
|
:- pred llds_out__get_label(label, bool, string).
|
|
:- mode llds_out__get_label(in, in, out) is det.
|
|
|
|
% Mangle an arbitrary name into a C identifier
|
|
|
|
:- pred llds_out__name_mangle(string, string).
|
|
:- mode llds_out__name_mangle(in, out) is det.
|
|
|
|
% Mangle a possibly module-qualified Mercury symbol name
|
|
% into a C identifier.
|
|
|
|
:- pred llds_out__sym_name_mangle(sym_name, string).
|
|
:- mode llds_out__sym_name_mangle(in, out) is det.
|
|
|
|
% Produces a string of the form Module__Name.
|
|
|
|
:- pred llds_out__qualify_name(string, string, string).
|
|
:- mode llds_out__qualify_name(in, in, out) is det.
|
|
|
|
% Convert a string into a form suitable for outputting as a C string,
|
|
% by converting special characters into backslashes escapes.
|
|
:- pred llds_out__quote_c_string(string, string).
|
|
:- mode llds_out__quote_c_string(in, out) is det.
|
|
|
|
% Like quote_c_string except the resulting string is written to
|
|
% the current output stream.
|
|
:- pred output_c_quoted_string(string, io__state, io__state).
|
|
:- mode output_c_quoted_string(in, di, uo) is det.
|
|
|
|
% Like quote_c_quoted_string except that the string may have
|
|
% NULL characters embedded in it.
|
|
:- pred output_c_quoted_multi_string(int, string, io__state, io__state).
|
|
:- mode output_c_quoted_multi_string(in, in, di, uo) is det.
|
|
|
|
% Create a name for base_typeclass_info
|
|
|
|
:- pred llds_out__make_base_typeclass_info_name(class_id, string, string).
|
|
:- mode llds_out__make_base_typeclass_info_name(in, in, out) is det.
|
|
|
|
% output the name for base_typeclass_info,
|
|
% with the appropriate "mercury_data_" prefix.
|
|
|
|
:- pred output_base_typeclass_info_name(class_id, string, io__state, io__state).
|
|
:- mode output_base_typeclass_info_name(in, in, di, uo) is det.
|
|
|
|
% Convert a label to a string description of the stack layout
|
|
% structure of that label.
|
|
|
|
% Returns the name of the initialization function
|
|
% for a given module.
|
|
|
|
:- pred llds_out__make_init_name(module_name, string).
|
|
:- mode llds_out__make_init_name(in, out) is det.
|
|
|
|
% Returns the name of the Aditi-RL code constant
|
|
% for a given module.
|
|
|
|
:- pred llds_out__make_rl_data_name(module_name, string).
|
|
:- mode llds_out__make_rl_data_name(in, out) is det.
|
|
|
|
% Print out the name of the tabling variable for the specified
|
|
% procedure.
|
|
|
|
:- pred output_tabling_pointer_var_name(proc_label::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
% The following are exported to rtti_out. It may be worthwhile
|
|
% to put these in a new module (maybe llds_out_util).
|
|
|
|
:- type decl_id ---> create_label(int)
|
|
; float_label(string)
|
|
; code_addr(code_addr)
|
|
; data_addr(data_addr)
|
|
; pragma_c_struct(string).
|
|
|
|
:- type decl_set.
|
|
|
|
% Every time we emit a declaration for a symbol, we insert it into the
|
|
% set of symbols we've already declared. That way, we avoid generating
|
|
% the same symbol twice, which would cause an error in the C code.
|
|
|
|
:- pred decl_set_init(decl_set::out) is det.
|
|
|
|
:- pred decl_set_insert(decl_set::in, decl_id::in, decl_set::out) is det.
|
|
|
|
:- pred decl_set_is_member(decl_id::in, decl_set::in) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% Note that we need to know the linkage not just at the definition,
|
|
% but also at every use, because if the use is prior to the definition,
|
|
% then we need to declare the name first, and the linkage used in that
|
|
% declaration must be consistent with the linkage in the definition.
|
|
% For this reason, the field in c_data (which holds the information about
|
|
% the definition) which says whether or not a data name is exported
|
|
% is not useful. Instead, we need to determine whether or not something
|
|
% is exported from its `data_name'.
|
|
%
|
|
|
|
:- type linkage ---> extern ; static.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module backend_libs__c_util.
|
|
:- import_module backend_libs__compile_target_code.
|
|
:- import_module backend_libs__export.
|
|
:- import_module backend_libs__foreign.
|
|
:- import_module backend_libs__rtti.
|
|
:- import_module hlds__hlds_pred.
|
|
:- import_module hlds__passes_aux.
|
|
:- import_module libs__options.
|
|
:- import_module libs__trace_params.
|
|
:- import_module ll_backend__exprn_aux.
|
|
:- import_module ll_backend__layout.
|
|
:- import_module ll_backend__layout_out.
|
|
:- import_module ll_backend__rtti_out.
|
|
:- import_module parse_tree__mercury_to_mercury.
|
|
:- import_module parse_tree__modules.
|
|
:- import_module parse_tree__prog_out.
|
|
:- import_module parse_tree__prog_util.
|
|
|
|
:- import_module int, char, string, std_util.
|
|
:- import_module set, bintree_set, assoc_list, require.
|
|
:- import_module varset, term.
|
|
:- import_module library. % for the version number.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type decl_set == map(decl_id, unit).
|
|
|
|
decl_set_init(DeclSet) :-
|
|
map__init(DeclSet).
|
|
|
|
decl_set_insert(DeclSet0, DeclId, DeclSet) :-
|
|
map__set(DeclSet0, DeclId, unit, DeclSet).
|
|
|
|
decl_set_is_member(DeclId, DeclSet) :-
|
|
map__search(DeclSet, DeclId, _).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
output_llds(C_File, StackLayoutLabels, MaybeRLFile) -->
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
( { SplitFiles = yes } ->
|
|
{ C_File = c_file(ModuleName, C_HeaderInfo,
|
|
UserForeignCodes, Exports, Vars, Datas, Modules) },
|
|
module_name_to_file_name(ModuleName, ".dir", yes, ObjDirName),
|
|
make_directory(ObjDirName),
|
|
|
|
output_split_c_file_init(ModuleName, Modules, Datas,
|
|
StackLayoutLabels, MaybeRLFile),
|
|
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
|
|
C_HeaderInfo, StackLayoutLabels, 1, Num1),
|
|
output_split_c_exports(Exports, ModuleName,
|
|
C_HeaderInfo, StackLayoutLabels, Num1, Num2),
|
|
output_split_comp_gen_c_vars(Vars, ModuleName,
|
|
C_HeaderInfo, StackLayoutLabels, Num2, Num3),
|
|
output_split_comp_gen_c_datas(Datas, ModuleName,
|
|
C_HeaderInfo, StackLayoutLabels, Num3, Num4),
|
|
output_split_comp_gen_c_modules(Modules, ModuleName,
|
|
C_HeaderInfo, StackLayoutLabels, Num4, Num),
|
|
|
|
compile_target_code__write_num_split_c_files(ModuleName,
|
|
Num, Succeeded),
|
|
( { Succeeded = no } ->
|
|
compile_target_code__remove_split_c_output_files(
|
|
ModuleName, Num)
|
|
;
|
|
[]
|
|
)
|
|
;
|
|
output_single_c_file(C_File, no,
|
|
StackLayoutLabels, MaybeRLFile)
|
|
).
|
|
|
|
:- pred output_split_user_foreign_codes(list(user_foreign_code)::in,
|
|
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
|
|
int::in, int::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_split_user_foreign_codes([], _, _, _, Num, Num) --> [].
|
|
output_split_user_foreign_codes([UserForeignCode | UserForeignCodes],
|
|
ModuleName, C_HeaderLines, StackLayoutLabels, Num0, Num) -->
|
|
{ CFile = c_file(ModuleName, C_HeaderLines,
|
|
[UserForeignCode], [], [], [], []) },
|
|
output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
|
|
{ Num1 = Num0 + 1 },
|
|
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
|
|
C_HeaderLines, StackLayoutLabels, Num1, Num).
|
|
|
|
:- pred output_split_c_exports(list(foreign_export)::in,
|
|
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
|
|
int::in, int::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_split_c_exports([], _, _, _, Num, Num) --> [].
|
|
output_split_c_exports([Export | Exports], ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num0, Num) -->
|
|
{ CFile = c_file(ModuleName, C_HeaderLines,
|
|
[], [Export], [], [], []) },
|
|
output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
|
|
{ Num1 = Num0 + 1 },
|
|
output_split_c_exports(Exports, ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num1, Num).
|
|
|
|
:- pred output_split_comp_gen_c_vars(list(comp_gen_c_var)::in,
|
|
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
|
|
int::in, int::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_split_comp_gen_c_vars([], _, _, _, Num, Num) --> [].
|
|
output_split_comp_gen_c_vars([Var | Vars], ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num0, Num) -->
|
|
{ CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], []) },
|
|
output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
|
|
{ Num1 = Num0 + 1 },
|
|
output_split_comp_gen_c_vars(Vars, ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num1, Num).
|
|
|
|
:- pred output_split_comp_gen_c_datas(list(comp_gen_c_data)::in,
|
|
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
|
|
int::in, int::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_split_comp_gen_c_datas([], _, _, _, Num, Num) --> [].
|
|
output_split_comp_gen_c_datas([Data | Datas], ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num0, Num) -->
|
|
{ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], []) },
|
|
output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
|
|
{ Num1 = Num0 + 1 },
|
|
output_split_comp_gen_c_datas(Datas, ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num1, Num).
|
|
|
|
:- pred output_split_comp_gen_c_modules(list(comp_gen_c_module)::in,
|
|
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
|
|
int::in, int::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_split_comp_gen_c_modules([], _, _, _, Num, Num) --> [].
|
|
output_split_comp_gen_c_modules([Module | Modules], ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num0, Num) -->
|
|
{ CFile = c_file(ModuleName, C_HeaderLines,
|
|
[], [], [], [], [Module]) },
|
|
output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
|
|
{ Num1 = Num0 + 1 },
|
|
output_split_comp_gen_c_modules(Modules, ModuleName, C_HeaderLines,
|
|
StackLayoutLabels, Num1, Num).
|
|
|
|
:- pred output_split_c_file_init(module_name, list(comp_gen_c_module),
|
|
list(comp_gen_c_data), map(label, data_addr), maybe(rl_file),
|
|
io__state, io__state).
|
|
:- mode output_split_c_file_init(in, in, in, in, in, di, uo) is det.
|
|
|
|
output_split_c_file_init(ModuleName, Modules, Datas,
|
|
StackLayoutLabels, MaybeRLFile) -->
|
|
module_name_to_file_name(ModuleName, ".m", no, SourceFileName),
|
|
module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName),
|
|
|
|
io__open_output(FileName, Result),
|
|
(
|
|
{ Result = ok(FileStream) }
|
|
->
|
|
{ library__version(Version) },
|
|
io__set_output_stream(FileStream, OutputStream),
|
|
output_c_file_intro_and_grade(SourceFileName, Version),
|
|
output_init_comment(ModuleName),
|
|
output_c_file_mercury_headers,
|
|
io__write_string("\n"),
|
|
{ decl_set_init(DeclSet0) },
|
|
output_c_module_init_list(ModuleName, Modules, Datas,
|
|
StackLayoutLabels, DeclSet0, _DeclSet),
|
|
output_rl_file(ModuleName, MaybeRLFile),
|
|
io__set_output_stream(OutputStream, _),
|
|
io__close_output(FileStream)
|
|
;
|
|
io__progname_base("llds.m", ProgName),
|
|
io__write_string("\n"),
|
|
io__write_string(ProgName),
|
|
io__write_string(": can't open `"),
|
|
io__write_string(FileName),
|
|
io__write_string("' for output\n"),
|
|
io__set_exit_status(1)
|
|
).
|
|
|
|
:- pred output_c_file_mercury_headers(io__state, io__state).
|
|
:- mode output_c_file_mercury_headers(di, uo) is det.
|
|
|
|
output_c_file_mercury_headers -->
|
|
globals__io_get_trace_level(TraceLevel),
|
|
( { given_trace_level_is_none(TraceLevel) = no } ->
|
|
io__write_string("#include ""mercury_imp.h""\n"),
|
|
io__write_string("#include ""mercury_trace_base.h""\n")
|
|
;
|
|
io__write_string("#include ""mercury_imp.h""\n")
|
|
),
|
|
globals__io_lookup_bool_option(profile_deep, DeepProfile),
|
|
(
|
|
{ DeepProfile = yes },
|
|
io__write_string("#include ""mercury_deep_profiling.h""\n")
|
|
;
|
|
{ DeepProfile = no }
|
|
),
|
|
globals__io_lookup_bool_option(generate_bytecode, GenBytecode),
|
|
(
|
|
{ GenBytecode = yes },
|
|
io__write_string("#include ""mb_interface_stub.h""\n")
|
|
;
|
|
{ GenBytecode = no }
|
|
).
|
|
|
|
output_c_file_intro_and_grade(SourceFileName, Version) -->
|
|
globals__io_lookup_int_option(num_tag_bits, NumTagBits),
|
|
{ string__int_to_string(NumTagBits, NumTagBitsStr) },
|
|
globals__io_lookup_bool_option(unboxed_float, UnboxedFloat),
|
|
{ convert_bool_to_string(UnboxedFloat, UnboxedFloatStr) },
|
|
|
|
io__write_strings(["/*\n",
|
|
"** Automatically generated from `", SourceFileName,
|
|
"' by the Mercury compiler,\n",
|
|
"** version ", Version, ".\n",
|
|
"** Do not edit.\n",
|
|
"**\n",
|
|
"** The autoconfigured grade settings governing\n",
|
|
"** the generation of this C file were\n",
|
|
"**\n",
|
|
"** TAG_BITS=", NumTagBitsStr, "\n",
|
|
"** UNBOXED_FLOAT=", UnboxedFloatStr, "\n",
|
|
"**\n",
|
|
"** END_OF_C_GRADE_INFO\n",
|
|
"*/\n",
|
|
"\n",
|
|
"#define MR_TYPE_CTOR_INFO_HAS_FLAG 1\n",
|
|
"\n"
|
|
]).
|
|
|
|
:- pred convert_bool_to_string(bool, string).
|
|
:- mode convert_bool_to_string(in, out) is det.
|
|
|
|
convert_bool_to_string(no, "no").
|
|
convert_bool_to_string(yes, "yes").
|
|
|
|
:- pred output_single_c_file(c_file, maybe(int), map(label, data_addr),
|
|
maybe(rl_file), io__state, io__state).
|
|
:- mode output_single_c_file(in, in, in, in, di, uo) is det.
|
|
|
|
output_single_c_file(CFile, SplitFiles, StackLayoutLabels, MaybeRLFile) -->
|
|
{ CFile = c_file(ModuleName, C_HeaderLines,
|
|
UserForeignCode, Exports, Vars, Datas, Modules) },
|
|
( { SplitFiles = yes(Num) } ->
|
|
module_name_to_split_c_file_name(ModuleName, Num, ".c",
|
|
FileName)
|
|
;
|
|
module_name_to_file_name(ModuleName, ".c", yes, FileName)
|
|
),
|
|
io__open_output(FileName, Result),
|
|
(
|
|
{ Result = ok(FileStream) }
|
|
->
|
|
{ library__version(Version) },
|
|
io__set_output_stream(FileStream, OutputStream),
|
|
module_name_to_file_name(ModuleName, ".m", no, SourceFileName),
|
|
output_c_file_intro_and_grade(SourceFileName, Version),
|
|
( { SplitFiles = yes(_) } ->
|
|
[]
|
|
;
|
|
output_init_comment(ModuleName)
|
|
),
|
|
output_c_file_mercury_headers,
|
|
|
|
output_foreign_header_include_lines(C_HeaderLines),
|
|
io__write_string("\n"),
|
|
|
|
{ gather_c_file_labels(Modules, Labels) },
|
|
{ decl_set_init(DeclSet0) },
|
|
output_c_data_type_def_list(Datas, DeclSet0, DeclSet1),
|
|
output_c_label_decl_list(Labels, StackLayoutLabels,
|
|
DeclSet1, DeclSet2),
|
|
output_comp_gen_c_var_list(Vars, DeclSet2, DeclSet3),
|
|
output_comp_gen_c_data_list(Datas, DeclSet3, DeclSet4),
|
|
output_comp_gen_c_module_list(Modules, StackLayoutLabels,
|
|
DeclSet4, DeclSet5),
|
|
output_user_foreign_code_list(UserForeignCode),
|
|
output_exported_c_functions(Exports),
|
|
|
|
( { SplitFiles = yes(_) } ->
|
|
[]
|
|
;
|
|
io__write_string("\n"),
|
|
output_c_module_init_list(ModuleName, Modules, Datas,
|
|
StackLayoutLabels, DeclSet5, _DeclSet)
|
|
),
|
|
output_rl_file(ModuleName, MaybeRLFile),
|
|
io__set_output_stream(OutputStream, _),
|
|
io__close_output(FileStream)
|
|
;
|
|
io__progname_base("llds.m", ProgName),
|
|
io__write_string("\n"),
|
|
io__write_string(ProgName),
|
|
io__write_string(": can't open `"),
|
|
io__write_string(FileName),
|
|
io__write_string("' for output\n"),
|
|
io__set_exit_status(1)
|
|
).
|
|
|
|
:- pred output_c_module_init_list(module_name::in, list(comp_gen_c_module)::in,
|
|
list(comp_gen_c_data)::in, map(label, data_addr)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_c_module_init_list(ModuleName, Modules, Datas, StackLayoutLabels,
|
|
DeclSet0, DeclSet) -->
|
|
{ MustInit = lambda([Module::in] is semidet, (
|
|
module_defines_label_with_layout(Module, StackLayoutLabels)
|
|
)) },
|
|
{ list__filter(MustInit, Modules,
|
|
AlwaysInitModules, MaybeInitModules) },
|
|
{ list__chunk(AlwaysInitModules, 40, AlwaysInitModuleBunches) },
|
|
{ list__chunk(MaybeInitModules, 40, MaybeInitModuleBunches) },
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
|
|
output_init_bunch_defs(AlwaysInitModuleBunches, ModuleName,
|
|
"always", 0, SplitFiles),
|
|
|
|
( { MaybeInitModuleBunches = [] } ->
|
|
[]
|
|
;
|
|
io__write_string("#ifdef MR_MAY_NEED_INITIALIZATION\n\n"),
|
|
output_init_bunch_defs(MaybeInitModuleBunches, ModuleName,
|
|
"maybe", 0, SplitFiles),
|
|
io__write_string("#endif\n\n")
|
|
),
|
|
|
|
io__write_string("/* suppress gcc -Wmissing-decls warnings */\n"),
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init(void);\n"),
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init_type_tables(void);\n"),
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init_debugger(void);\n"),
|
|
io__write_string("#ifdef MR_DEEP_PROFILING\n"),
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("write_out_proc_statics(FILE *fp);\n"),
|
|
io__write_string("#endif\n"),
|
|
io__write_string("\n"),
|
|
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init(void)\n"),
|
|
io__write_string("{\n"),
|
|
io__write_string("\tstatic MR_bool done = MR_FALSE;\n"),
|
|
io__write_string("\tif (done) {\n"),
|
|
io__write_string("\t\treturn;\n"),
|
|
io__write_string("\t}\n"),
|
|
io__write_string("\tdone = MR_TRUE;\n"),
|
|
|
|
output_init_bunch_calls(AlwaysInitModuleBunches, ModuleName,
|
|
"always", 0),
|
|
|
|
( { MaybeInitModuleBunches = [] } ->
|
|
[]
|
|
;
|
|
io__write_string("\n#ifdef MR_MAY_NEED_INITIALIZATION\n"),
|
|
output_init_bunch_calls(MaybeInitModuleBunches, ModuleName,
|
|
"maybe", 0),
|
|
io__write_string("#endif\n\n")
|
|
),
|
|
|
|
output_c_data_init_list(Datas),
|
|
% The call to the debugger initialization function
|
|
% is for bootstrapping; once the debugger has been modified
|
|
% to call do_init_modules_debugger() and all debuggable
|
|
% object files created before this change have been
|
|
% overwritten, it can be deleted.
|
|
io__write_string("\t"),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init_debugger();\n"),
|
|
io__write_string("}\n\n"),
|
|
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init_type_tables(void)\n"),
|
|
io__write_string("{\n"),
|
|
io__write_string("\tstatic MR_bool done = MR_FALSE;\n"),
|
|
io__write_string("\tif (done) {\n"),
|
|
io__write_string("\t\treturn;\n"),
|
|
io__write_string("\t}\n"),
|
|
io__write_string("\tdone = MR_TRUE;\n"),
|
|
output_type_tables_init_list(Datas, SplitFiles),
|
|
io__write_string("}\n\n"),
|
|
|
|
output_debugger_init_list_decls(Datas, DeclSet0, DeclSet1),
|
|
io__write_string("\n"),
|
|
io__write_string("void "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init_debugger(void)\n"),
|
|
io__write_string("{\n"),
|
|
io__write_string("\tstatic MR_bool done = MR_FALSE;\n"),
|
|
io__write_string("\tif (done) {\n"),
|
|
io__write_string("\t\treturn;\n"),
|
|
io__write_string("\t}\n"),
|
|
io__write_string("\tdone = MR_TRUE;\n"),
|
|
output_debugger_init_list(Datas),
|
|
io__write_string("}\n\n"),
|
|
|
|
io__write_string("#ifdef MR_DEEP_PROFILING\n"),
|
|
output_write_proc_static_list_decls(Datas, DeclSet1, DeclSet),
|
|
io__write_string("\nvoid "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("write_out_proc_statics(FILE *fp)\n"),
|
|
io__write_string("{\n"),
|
|
output_write_proc_static_list(Datas),
|
|
io__write_string("}\n"),
|
|
io__write_string("\n#endif\n\n"),
|
|
|
|
io__write_string(
|
|
"/* ensure everything is compiled with the same grade */\n"),
|
|
io__write_string(
|
|
"static const void *const MR_grade = &MR_GRADE_VAR;\n").
|
|
|
|
:- pred module_defines_label_with_layout(comp_gen_c_module::in,
|
|
map(label, data_addr)::in) is semidet.
|
|
|
|
module_defines_label_with_layout(Module, StackLayoutLabels) :-
|
|
% Checking whether the set is empty or not
|
|
% allows us to avoid calling gather_c_module_labels.
|
|
\+ map__is_empty(StackLayoutLabels),
|
|
Module = comp_gen_c_module(_, Procedures),
|
|
gather_c_module_labels(Procedures, Labels),
|
|
list__member(Label, Labels),
|
|
map__search(StackLayoutLabels, Label, _).
|
|
|
|
:- pred output_init_bunch_defs(list(list(comp_gen_c_module))::in,
|
|
module_name::in, string::in, int::in, bool::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_init_bunch_defs([], _, _, _, _) --> [].
|
|
output_init_bunch_defs([Bunch | Bunches], ModuleName, InitStatus, Seq,
|
|
SplitFiles) -->
|
|
io__write_string("static void "),
|
|
output_bunch_name(ModuleName, InitStatus, Seq),
|
|
io__write_string("(void)\n"),
|
|
io__write_string("{\n"),
|
|
output_init_bunch_def(Bunch, ModuleName, SplitFiles),
|
|
io__write_string("}\n\n"),
|
|
{ NextSeq = Seq + 1 },
|
|
output_init_bunch_defs(Bunches, ModuleName, InitStatus, NextSeq,
|
|
SplitFiles).
|
|
|
|
:- pred output_init_bunch_def(list(comp_gen_c_module)::in, module_name::in,
|
|
bool::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_init_bunch_def([], _, _) --> [].
|
|
output_init_bunch_def([Module | Modules], ModuleName, SplitFiles) -->
|
|
{ Module = comp_gen_c_module(C_ModuleName, _) },
|
|
( { SplitFiles = yes } ->
|
|
io__write_string("\t{ extern MR_ModuleFunc "),
|
|
io__write_string(C_ModuleName),
|
|
io__write_string(";\n"),
|
|
io__write_string("\t "),
|
|
io__write_string(C_ModuleName),
|
|
io__write_string("(); }\n")
|
|
;
|
|
io__write_string("\t"),
|
|
io__write_string(C_ModuleName),
|
|
io__write_string("();\n")
|
|
),
|
|
output_init_bunch_def(Modules, ModuleName, SplitFiles).
|
|
|
|
:- pred output_init_bunch_calls(list(list(comp_gen_c_module))::in,
|
|
module_name::in, string::in, int::in, io__state::di, io__state::uo)
|
|
is det.
|
|
|
|
output_init_bunch_calls([], _, _, _) --> [].
|
|
output_init_bunch_calls([_ | Bunches], ModuleName, InitStatus, Seq) -->
|
|
io__write_string("\t"),
|
|
output_bunch_name(ModuleName, InitStatus, Seq),
|
|
io__write_string("();\n"),
|
|
{ NextSeq = Seq + 1 },
|
|
output_init_bunch_calls(Bunches, ModuleName, InitStatus, NextSeq).
|
|
|
|
% Output MR_INIT_TYPE_CTOR_INFO(TypeCtorInfo, Typector);
|
|
% for each type_ctor_info defined in this module.
|
|
|
|
:- pred output_c_data_init_list(list(comp_gen_c_data)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_c_data_init_list([]) --> [].
|
|
output_c_data_init_list([Data | Datas]) -->
|
|
( { Data = rtti_data(RttiData) } ->
|
|
rtti_out__init_rtti_data_if_nec(RttiData)
|
|
;
|
|
[]
|
|
),
|
|
output_c_data_init_list(Datas).
|
|
|
|
% Output code to register each type_ctor_info defined in this module.
|
|
|
|
:- pred output_type_tables_init_list(list(comp_gen_c_data)::in,
|
|
bool::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_type_tables_init_list([], _) --> [].
|
|
output_type_tables_init_list([Data | Datas], SplitFiles) -->
|
|
(
|
|
{ Data = rtti_data(RttiData) }
|
|
->
|
|
rtti_out__register_rtti_data_if_nec(RttiData, SplitFiles)
|
|
;
|
|
[]
|
|
),
|
|
output_type_tables_init_list(Datas, SplitFiles).
|
|
|
|
% Output declarations for each module layout defined in this module
|
|
% (there should only be one, of course).
|
|
:- pred output_debugger_init_list_decls(list(comp_gen_c_data)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_debugger_init_list_decls([], DeclSet, DeclSet) --> [].
|
|
output_debugger_init_list_decls([Data | Datas], DeclSet0, DeclSet) -->
|
|
(
|
|
{ Data = layout_data(LayoutData) },
|
|
{ LayoutData = module_layout_data(ModuleName, _,_,_,_,_,_) }
|
|
->
|
|
output_data_addr_decls(layout_addr(module_layout(ModuleName)),
|
|
"", "", 0, _, DeclSet0, DeclSet1)
|
|
;
|
|
{ DeclSet1 = DeclSet0 }
|
|
),
|
|
output_debugger_init_list_decls(Datas, DeclSet1, DeclSet).
|
|
|
|
% Output calls to MR_register_module_layout()
|
|
% for each module layout defined in this module
|
|
% (there should only be one, of course).
|
|
|
|
:- pred output_debugger_init_list(list(comp_gen_c_data)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_debugger_init_list([]) --> [].
|
|
output_debugger_init_list([Data | Datas]) -->
|
|
(
|
|
{ Data = layout_data(LayoutData) },
|
|
{ LayoutData = module_layout_data(ModuleName, _,_,_,_,_,_) }
|
|
->
|
|
io__write_string("\tif (MR_register_module_layout != NULL) {\n"),
|
|
io__write_string("\t\t(*MR_register_module_layout)("),
|
|
io__write_string("\n\t\t\t&"),
|
|
output_layout_name(module_layout(ModuleName)),
|
|
io__write_string(");\n\t}\n")
|
|
;
|
|
[]
|
|
),
|
|
output_debugger_init_list(Datas).
|
|
|
|
:- pred output_write_proc_static_list_decls(list(comp_gen_c_data)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_write_proc_static_list_decls([], DeclSet, DeclSet) --> [].
|
|
output_write_proc_static_list_decls([Data | Datas], DeclSet0, DeclSet) -->
|
|
(
|
|
{ Data = layout_data(LayoutData) },
|
|
{ LayoutData = proc_static_data(_, _, _, _, _) }
|
|
->
|
|
output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet1)
|
|
;
|
|
{ DeclSet1 = DeclSet0 }
|
|
),
|
|
output_write_proc_static_list_decls(Datas,
|
|
DeclSet1, DeclSet).
|
|
|
|
:- pred output_write_proc_static_list(list(comp_gen_c_data)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_write_proc_static_list([]) --> [].
|
|
output_write_proc_static_list([Data | Datas]) -->
|
|
(
|
|
{ Data = layout_data(LayoutData) },
|
|
{ LayoutData = proc_static_data(RttiProcLabel, _, _, _, _) }
|
|
->
|
|
io__write_string("\tMR_write_out_proc_static(fp, "),
|
|
io__write_string("(MR_ProcStatic *)\n\t\t&"),
|
|
output_layout_name(proc_static(RttiProcLabel)),
|
|
io__write_string(");\n")
|
|
;
|
|
[]
|
|
),
|
|
output_write_proc_static_list(Datas).
|
|
|
|
% Output a comment to tell mkinit what functions to
|
|
% call from <module>_init.c.
|
|
:- pred output_init_comment(module_name, io__state, io__state).
|
|
:- mode output_init_comment(in, di, uo) is det.
|
|
|
|
output_init_comment(ModuleName) -->
|
|
io__write_string("/*\n"),
|
|
io__write_string("INIT "),
|
|
output_init_name(ModuleName),
|
|
io__write_string("init\n"),
|
|
globals__io_lookup_bool_option(aditi, Aditi),
|
|
( { Aditi = yes } ->
|
|
{ llds_out__make_rl_data_name(ModuleName, RLName) },
|
|
io__write_string("ADITI_DATA "),
|
|
io__write_string(RLName),
|
|
io__write_string("\n")
|
|
;
|
|
[]
|
|
),
|
|
io__write_string("ENDINIT\n"),
|
|
io__write_string("*/\n\n").
|
|
|
|
:- pred output_init_name(module_name, io__state, io__state).
|
|
:- mode output_init_name(in, di, uo) is det.
|
|
|
|
output_init_name(ModuleName) -->
|
|
{ llds_out__make_init_name(ModuleName, InitName) },
|
|
io__write_string(InitName).
|
|
|
|
llds_out__make_init_name(ModuleName, InitName) :-
|
|
llds_out__sym_name_mangle(ModuleName, MangledModuleName),
|
|
string__append_list(["mercury__", MangledModuleName, "__"],
|
|
InitName).
|
|
|
|
llds_out__make_rl_data_name(ModuleName, RLDataConstName) :-
|
|
llds_out__sym_name_mangle(ModuleName, MangledModuleName),
|
|
string__append("mercury__aditi_rl_data__", MangledModuleName,
|
|
RLDataConstName).
|
|
|
|
:- pred output_bunch_name(module_name, string, int, io__state, io__state).
|
|
:- mode output_bunch_name(in, in, in, di, uo) is det.
|
|
|
|
output_bunch_name(ModuleName, InitStatus, Number) -->
|
|
io__write_string("mercury__"),
|
|
{ llds_out__sym_name_mangle(ModuleName, MangledModuleName) },
|
|
io__write_string(MangledModuleName),
|
|
io__write_string("_"),
|
|
io__write_string(InitStatus),
|
|
io__write_string("_bunch_"),
|
|
io__write_int(Number).
|
|
|
|
%
|
|
% output_c_data_type_def_list outputs all the type definitions of
|
|
% the module. This is needed because some compilers need the
|
|
% data definition to appear before any use of the type in
|
|
% forward declarations of static constants.
|
|
%
|
|
:- pred output_c_data_type_def_list(list(comp_gen_c_data), decl_set, decl_set,
|
|
io__state, io__state).
|
|
:- mode output_c_data_type_def_list(in, in, out, di, uo) is det.
|
|
|
|
output_c_data_type_def_list([], DeclSet, DeclSet) --> [].
|
|
output_c_data_type_def_list([M | Ms], DeclSet0, DeclSet) -->
|
|
output_c_data_type_def(M, DeclSet0, DeclSet1),
|
|
output_c_data_type_def_list(Ms, DeclSet1, DeclSet).
|
|
|
|
:- pred output_c_data_type_def(comp_gen_c_data, decl_set, decl_set,
|
|
io__state, io__state).
|
|
:- mode output_c_data_type_def(in, in, out, di, uo) is det.
|
|
|
|
output_c_data_type_def(comp_gen_c_data(ModuleName, VarName, ExportedFromModule,
|
|
ArgVals, ArgTypes, _Refs), DeclSet0, DeclSet) -->
|
|
io__write_string("\n"),
|
|
{ data_name_linkage(VarName, Linkage) },
|
|
{
|
|
( Linkage = extern, ExportedFromModule = yes
|
|
; Linkage = static, ExportedFromModule = no
|
|
)
|
|
->
|
|
true
|
|
;
|
|
error("linkage mismatch")
|
|
},
|
|
|
|
% The code for data local to a Mercury module
|
|
% should normally be visible only within the C file
|
|
% generated for that module. However, if we generate
|
|
% multiple C files, the code in each C file must be
|
|
% visible to the other C files for that Mercury module.
|
|
( { ExportedFromModule = yes } ->
|
|
{ ExportedFromFile = yes }
|
|
;
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
{ ExportedFromFile = SplitFiles }
|
|
),
|
|
|
|
{ DeclId = data_addr(data_addr(ModuleName, VarName)) },
|
|
output_const_term_decl(ArgVals, ArgTypes, DeclId, ExportedFromFile,
|
|
yes, yes, no, "", "", 0, _),
|
|
{ decl_set_insert(DeclSet0, DeclId, DeclSet) }.
|
|
output_c_data_type_def(rtti_data(RttiData), DeclSet0, DeclSet) -->
|
|
output_rtti_data_decl(RttiData, DeclSet0, DeclSet).
|
|
output_c_data_type_def(layout_data(LayoutData), DeclSet0, DeclSet) -->
|
|
output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet).
|
|
|
|
:- pred output_comp_gen_c_module_list(list(comp_gen_c_module)::in,
|
|
map(label, data_addr)::in, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_comp_gen_c_module_list([], _, DeclSet, DeclSet) --> [].
|
|
output_comp_gen_c_module_list([Module | Modules], StackLayoutLabels,
|
|
DeclSet0, DeclSet) -->
|
|
output_comp_gen_c_module(Module, StackLayoutLabels,
|
|
DeclSet0, DeclSet1),
|
|
output_comp_gen_c_module_list(Modules, StackLayoutLabels,
|
|
DeclSet1, DeclSet).
|
|
|
|
:- pred output_comp_gen_c_module(comp_gen_c_module::in,
|
|
map(label, data_addr)::in, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_comp_gen_c_module(comp_gen_c_module(ModuleName, Procedures),
|
|
StackLayoutLabels, DeclSet0, DeclSet) -->
|
|
io__write_string("\n"),
|
|
output_c_procedure_list_decls(Procedures, StackLayoutLabels,
|
|
DeclSet0, DeclSet),
|
|
io__write_string("\n"),
|
|
io__write_string("MR_BEGIN_MODULE("),
|
|
io__write_string(ModuleName),
|
|
io__write_string(")\n"),
|
|
{ gather_c_module_labels(Procedures, Labels) },
|
|
output_c_label_init_list(Labels, StackLayoutLabels),
|
|
io__write_string("MR_BEGIN_CODE\n"),
|
|
io__write_string("\n"),
|
|
globals__io_lookup_bool_option(auto_comments, PrintComments),
|
|
globals__io_lookup_bool_option(emit_c_loops, EmitCLoops),
|
|
output_c_procedure_list(Procedures, PrintComments, EmitCLoops),
|
|
io__write_string("MR_END_MODULE\n").
|
|
|
|
:- pred output_comp_gen_c_var_list(list(comp_gen_c_var)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_comp_gen_c_var_list([], DeclSet, DeclSet) --> [].
|
|
output_comp_gen_c_var_list([Var | Vars], DeclSet0, DeclSet) -->
|
|
output_comp_gen_c_var(Var, DeclSet0, DeclSet1),
|
|
output_comp_gen_c_var_list(Vars, DeclSet1, DeclSet).
|
|
|
|
:- pred output_comp_gen_c_var(comp_gen_c_var::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_comp_gen_c_var(tabling_pointer_var(ModuleName, ProcLabel),
|
|
DeclSet0, DeclSet) -->
|
|
io__write_string("\nMR_TableNode "),
|
|
output_tabling_pointer_var_name(ProcLabel),
|
|
io__write_string(" = { 0 };\n"),
|
|
{ DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)) },
|
|
{ decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) }.
|
|
|
|
output_tabling_pointer_var_name(ProcLabel) -->
|
|
io__write_string("mercury_var__table_root__"),
|
|
output_proc_label(ProcLabel).
|
|
|
|
:- pred output_comp_gen_c_data_list(list(comp_gen_c_data)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_comp_gen_c_data_list([], DeclSet, DeclSet) --> [].
|
|
output_comp_gen_c_data_list([Data | Datas], DeclSet0, DeclSet) -->
|
|
output_comp_gen_c_data(Data, DeclSet0, DeclSet1),
|
|
output_comp_gen_c_data_list(Datas, DeclSet1, DeclSet).
|
|
|
|
:- pred output_comp_gen_c_data(comp_gen_c_data::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_comp_gen_c_data(comp_gen_c_data(ModuleName, VarName, ExportedFromModule,
|
|
ArgVals, ArgTypes, _Refs), DeclSet0, DeclSet) -->
|
|
io__write_string("\n"),
|
|
output_cons_arg_decls(ArgVals, "", "", 0, _, DeclSet0, DeclSet1),
|
|
|
|
%
|
|
% sanity check: check that the (redundant) ExportedFromModule field
|
|
% in the c_data, which we use for the definition, matches the linkage
|
|
% computed by linkage/2 from the dataname, which we use for any
|
|
% prior declarations.
|
|
%
|
|
{ data_name_linkage(VarName, Linkage) },
|
|
{
|
|
( Linkage = extern, ExportedFromModule = yes
|
|
; Linkage = static, ExportedFromModule = no
|
|
)
|
|
->
|
|
true
|
|
;
|
|
error("linkage mismatch")
|
|
},
|
|
|
|
% The code for data local to a Mercury module
|
|
% should normally be visible only within the C file
|
|
% generated for that module. However, if we generate
|
|
% multiple C files, the code in each C file must be
|
|
% visible to the other C files for that Mercury module.
|
|
( { ExportedFromModule = yes } ->
|
|
{ ExportedFromFile = yes }
|
|
;
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
{ ExportedFromFile = SplitFiles }
|
|
),
|
|
{ DeclId = data_addr(data_addr(ModuleName, VarName)) },
|
|
output_const_term_decl(ArgVals, ArgTypes, DeclId, ExportedFromFile,
|
|
no, yes, yes, "", "", 0, _),
|
|
{ decl_set_insert(DeclSet1, DeclId, DeclSet) }.
|
|
output_comp_gen_c_data(rtti_data(RttiData), DeclSet0, DeclSet) -->
|
|
output_rtti_data_defn(RttiData, DeclSet0, DeclSet).
|
|
output_comp_gen_c_data(layout_data(LayoutData), DeclSet0, DeclSet) -->
|
|
output_layout_data_defn(LayoutData, DeclSet0, DeclSet).
|
|
|
|
:- pred output_user_foreign_code_list(list(user_foreign_code)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_user_foreign_code_list([]) --> [].
|
|
output_user_foreign_code_list([UserForeignCode | UserCCodes]) -->
|
|
output_user_foreign_code(UserForeignCode),
|
|
output_user_foreign_code_list(UserCCodes).
|
|
|
|
:- pred output_user_foreign_code(user_foreign_code::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_user_foreign_code(user_foreign_code(Lang, Foreign_Code, Context)) -->
|
|
( { Lang = c } ->
|
|
globals__io_lookup_bool_option(auto_comments, PrintComments),
|
|
( { PrintComments = yes } ->
|
|
io__write_string("/* "),
|
|
prog_out__write_context(Context),
|
|
io__write_string(" pragma foreign_code */\n")
|
|
;
|
|
[]
|
|
),
|
|
output_set_line_num(Context),
|
|
io__write_string(Foreign_Code),
|
|
io__write_string("\n"),
|
|
output_reset_line_num
|
|
;
|
|
{ error("llds_out__output_user_foreign_code: unimplemented: foreign code other than C") }
|
|
).
|
|
|
|
% output_foreign_header_include_lines reverses the list of c
|
|
% header lines and passes them to
|
|
% output_c_header_include_lines_2 which outputs them. The list
|
|
% must be reversed since they are inserted in reverse order.
|
|
:- pred output_foreign_header_include_lines(list(foreign_decl_code)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_foreign_header_include_lines(Headers) -->
|
|
{ list__reverse(Headers, RevHeaders) },
|
|
output_foreign_header_include_lines_2(RevHeaders).
|
|
|
|
:- pred output_foreign_header_include_lines_2(list(foreign_decl_code)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_foreign_header_include_lines_2([]) --> [].
|
|
output_foreign_header_include_lines_2(
|
|
[foreign_decl_code(Lang, Code, Context) | Hs]) -->
|
|
( { Lang = c } ->
|
|
globals__io_lookup_bool_option(auto_comments, PrintComments),
|
|
( { PrintComments = yes } ->
|
|
io__write_string("/* "),
|
|
prog_out__write_context(Context),
|
|
io__write_string(" pragma foreign_decl_code( "),
|
|
io__write(Lang),
|
|
io__write_string(" */\n")
|
|
;
|
|
[]
|
|
),
|
|
output_set_line_num(Context),
|
|
io__write_string(Code),
|
|
io__write_string("\n"),
|
|
output_reset_line_num
|
|
;
|
|
{ error("llds_out__output_user_foreign_code: unexpected: foreign code other than C") }
|
|
),
|
|
output_foreign_header_include_lines_2(Hs).
|
|
|
|
:- pred output_exported_c_functions(list(string), io__state, io__state).
|
|
:- mode output_exported_c_functions(in, di, uo) is det.
|
|
|
|
output_exported_c_functions([]) --> [].
|
|
output_exported_c_functions([F | Fs]) -->
|
|
io__write_string(F),
|
|
output_exported_c_functions(Fs).
|
|
|
|
:- pred output_c_label_decl_list(list(label), map(label, data_addr),
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_c_label_decl_list(in, in, in, out, di, uo) is det.
|
|
|
|
output_c_label_decl_list([], _, DeclSet, DeclSet) --> [].
|
|
output_c_label_decl_list([Label | Labels], StackLayoutLabels,
|
|
DeclSet0, DeclSet) -->
|
|
output_c_label_decl(Label, StackLayoutLabels, DeclSet0, DeclSet1),
|
|
output_c_label_decl_list(Labels, StackLayoutLabels, DeclSet1, DeclSet).
|
|
|
|
:- pred output_c_label_decl(label::in, map(label, data_addr)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_c_label_decl(Label, StackLayoutLabels, DeclSet0, DeclSet) -->
|
|
%
|
|
% Declare the stack layout entry for this label, if needed.
|
|
%
|
|
( { map__search(StackLayoutLabels, Label, DataAddr) } ->
|
|
output_stack_layout_decl(DataAddr, DeclSet0, DeclSet1)
|
|
;
|
|
{ DeclSet1 = DeclSet0 }
|
|
),
|
|
%
|
|
% Declare the label itself.
|
|
%
|
|
(
|
|
{ Label = exported(_) },
|
|
io__write_string("MR_define_extern_entry(")
|
|
;
|
|
{ Label = local(_) },
|
|
% The code for procedures local to a Mercury module
|
|
% should normally be visible only within the C file
|
|
% generated for that module. However, if we generate
|
|
% multiple C files, the code in each C file must be
|
|
% visible to the other C files for that Mercury module.
|
|
globals__io_lookup_bool_option(split_c_files,
|
|
SplitFiles),
|
|
( { SplitFiles = no } ->
|
|
io__write_string("MR_declare_static(")
|
|
;
|
|
io__write_string("MR_define_extern_entry(")
|
|
)
|
|
;
|
|
{ Label = c_local(_) },
|
|
io__write_string("MR_declare_local(")
|
|
;
|
|
{ Label = local(_, _) },
|
|
io__write_string("MR_declare_label(")
|
|
),
|
|
{ decl_set_insert(DeclSet1, code_addr(label(Label)), DeclSet) },
|
|
output_label(Label),
|
|
io__write_string(");\n").
|
|
|
|
:- pred output_stack_layout_decl(data_addr::in, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_stack_layout_decl(DataAddr, DeclSet0, DeclSet) -->
|
|
output_data_addr_decls(DataAddr, "", "", 0, _, DeclSet0, DeclSet).
|
|
|
|
:- pred output_c_label_init_list(list(label), map(label, data_addr),
|
|
io__state, io__state).
|
|
:- mode output_c_label_init_list(in, in, di, uo) is det.
|
|
|
|
output_c_label_init_list([], _) --> [].
|
|
output_c_label_init_list([Label | Labels], StackLayoutLabels) -->
|
|
output_c_label_init(Label, StackLayoutLabels),
|
|
output_c_label_init_list(Labels, StackLayoutLabels).
|
|
|
|
:- pred output_c_label_init(label, map(label, data_addr), io__state, io__state).
|
|
:- mode output_c_label_init(in, in, di, uo) is det.
|
|
|
|
output_c_label_init(Label, StackLayoutLabels) -->
|
|
{ map__search(StackLayoutLabels, Label, DataAddr) ->
|
|
SuffixOpen = "_sl(",
|
|
( DataAddr = layout_addr(proc_layout(_, _)) ->
|
|
% Labels whose stack layouts are proc layouts may need
|
|
% to have the code address in that layout initialized
|
|
% at run time (if code addresses are not static).
|
|
InitProcLayout = yes
|
|
;
|
|
% Labels whose stack layouts are internal layouts
|
|
% do not have code addresses in their layouts.
|
|
InitProcLayout = no
|
|
)
|
|
;
|
|
SuffixOpen = "(",
|
|
% This label has no stack layout to initialize.
|
|
InitProcLayout = no
|
|
},
|
|
(
|
|
{ Label = exported(_) },
|
|
{ TabInitMacro = "\tMR_init_entry" }
|
|
;
|
|
{ Label = local(_) },
|
|
{ TabInitMacro = "\tMR_init_entry" }
|
|
;
|
|
{ Label = c_local(_) },
|
|
{ TabInitMacro = "\tMR_init_local" }
|
|
;
|
|
{ Label = local(_, _) },
|
|
{ TabInitMacro = "\tMR_init_label" }
|
|
),
|
|
io__write_string(TabInitMacro),
|
|
io__write_string(SuffixOpen),
|
|
output_label(Label),
|
|
io__write_string(");\n"),
|
|
( { InitProcLayout = yes } ->
|
|
io__write_string("\tMR_INIT_PROC_LAYOUT_ADDR("),
|
|
output_label(Label),
|
|
io__write_string(");\n")
|
|
;
|
|
[]
|
|
).
|
|
|
|
:- pred label_is_proc_entry(label::in, bool::out) is det.
|
|
|
|
label_is_proc_entry(local(_, _), no).
|
|
label_is_proc_entry(c_local(_), yes).
|
|
label_is_proc_entry(local(_), yes).
|
|
label_is_proc_entry(exported(_), yes).
|
|
|
|
:- pred output_c_procedure_list_decls(list(c_procedure)::in,
|
|
map(label, data_addr)::in, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_c_procedure_list_decls([], _, DeclSet, DeclSet) --> [].
|
|
output_c_procedure_list_decls([Proc | Procs], StackLayoutLabels,
|
|
DeclSet0, DeclSet) -->
|
|
output_c_procedure_decls(Proc, StackLayoutLabels, DeclSet0, DeclSet1),
|
|
output_c_procedure_list_decls(Procs, StackLayoutLabels,
|
|
DeclSet1, DeclSet).
|
|
|
|
:- pred output_c_procedure_list(list(c_procedure)::in, bool::in, bool::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_c_procedure_list([], _, _) --> [].
|
|
output_c_procedure_list([Proc | Procs], PrintComments, EmitCLoops) -->
|
|
output_c_procedure(Proc, PrintComments, EmitCLoops),
|
|
output_c_procedure_list(Procs, PrintComments, EmitCLoops).
|
|
|
|
:- pred output_c_procedure_decls(c_procedure::in, map(label, data_addr)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_c_procedure_decls(Proc, StackLayoutLabels, DeclSet0, DeclSet) -->
|
|
{ Proc = c_procedure(_Name, _Arity, _PredProcId, Instrs, _, _, _) },
|
|
output_instruction_list_decls(Instrs, StackLayoutLabels,
|
|
DeclSet0, DeclSet).
|
|
|
|
:- pred output_c_procedure(c_procedure::in, bool::in, bool::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_c_procedure(Proc, PrintComments, EmitCLoops) -->
|
|
{ Proc = c_procedure(Name, Arity, proc(_, ProcId), Instrs, _, _, _) },
|
|
{ proc_id_to_int(ProcId, ModeNum) },
|
|
( { PrintComments = yes } ->
|
|
io__write_string("\n/*-------------------------------------"),
|
|
io__write_string("------------------------------------*/\n")
|
|
;
|
|
[]
|
|
),
|
|
io__write_string("/* code for predicate '"),
|
|
% Now that we have unused_args.m mangling predicate names,
|
|
% we should probably demangle them here.
|
|
io__write_string(Name),
|
|
io__write_string("'/"),
|
|
io__write_int(Arity),
|
|
io__write_string(" in mode "),
|
|
io__write_int(ModeNum),
|
|
io__write_string(" */\n"),
|
|
{ llds_out__find_caller_label(Instrs, CallerLabel) },
|
|
{ bintree_set__init(ContLabelSet0) },
|
|
{ llds_out__find_cont_labels(Instrs, ContLabelSet0, ContLabelSet) },
|
|
{ bintree_set__init(WhileSet0) },
|
|
( { EmitCLoops = yes } ->
|
|
{ llds_out__find_while_labels(Instrs, WhileSet0, WhileSet) }
|
|
;
|
|
{ WhileSet = WhileSet0 }
|
|
),
|
|
output_instruction_list(Instrs, PrintComments,
|
|
CallerLabel - ContLabelSet, WhileSet).
|
|
|
|
% Find the entry label for the procedure,
|
|
% for use as the profiling "caller label"
|
|
% field in calls within this procedure.
|
|
|
|
:- pred llds_out__find_caller_label(list(instruction), label).
|
|
:- mode llds_out__find_caller_label(in, out) is det.
|
|
|
|
llds_out__find_caller_label([], _) :-
|
|
error("cannot find caller label").
|
|
llds_out__find_caller_label([Instr0 - _ | Instrs], CallerLabel) :-
|
|
( Instr0 = label(Label) ->
|
|
( Label = local(_, _) ->
|
|
error("caller label is internal label")
|
|
;
|
|
CallerLabel = Label
|
|
)
|
|
;
|
|
llds_out__find_caller_label(Instrs, CallerLabel)
|
|
).
|
|
|
|
% Locate all the labels which are the continuation labels for calls,
|
|
% nondet disjunctions, forks or joins, and store them in ContLabelSet.
|
|
|
|
:- pred llds_out__find_cont_labels(list(instruction),
|
|
bintree_set(label), bintree_set(label)).
|
|
:- mode llds_out__find_cont_labels(in, in, out) is det.
|
|
|
|
llds_out__find_cont_labels([], ContLabelSet, ContLabelSet).
|
|
llds_out__find_cont_labels([Instr - _ | Instrs], ContLabelSet0, ContLabelSet)
|
|
:-
|
|
(
|
|
(
|
|
Instr = call(_, label(ContLabel), _, _, _, _)
|
|
;
|
|
Instr = mkframe(_, label(ContLabel))
|
|
;
|
|
Instr = join_and_continue(_, ContLabel)
|
|
;
|
|
Instr = assign(redoip(lval(_)),
|
|
const(code_addr_const(label(ContLabel))))
|
|
)
|
|
->
|
|
bintree_set__insert(ContLabelSet0, ContLabel, ContLabelSet1)
|
|
;
|
|
Instr = fork(Label1, Label2, _)
|
|
->
|
|
bintree_set__insert_list(ContLabelSet0, [Label1, Label2],
|
|
ContLabelSet1)
|
|
;
|
|
Instr = block(_, _, Block)
|
|
->
|
|
llds_out__find_cont_labels(Block, ContLabelSet0, ContLabelSet1)
|
|
;
|
|
ContLabelSet1 = ContLabelSet0
|
|
),
|
|
llds_out__find_cont_labels(Instrs, ContLabelSet1, ContLabelSet).
|
|
|
|
% Locate all the labels which can be profitably turned into
|
|
% labels starting while loops. The idea is to do this transform:
|
|
%
|
|
% L1: L1:
|
|
% while (1) {
|
|
% ... ...
|
|
% if (...) goto L1 if (...) continue
|
|
% ... => ...
|
|
% if (...) goto L? if (...) goto L?
|
|
% ... ...
|
|
% if (...) goto L1 if (...) continue
|
|
% ... ...
|
|
% break;
|
|
% }
|
|
% L2: L2:
|
|
%
|
|
% The second of these is better if we don't have fast jumps.
|
|
|
|
:- pred llds_out__find_while_labels(list(instruction),
|
|
bintree_set(label), bintree_set(label)).
|
|
:- mode llds_out__find_while_labels(in, in, out) is det.
|
|
|
|
llds_out__find_while_labels([], WhileSet, WhileSet).
|
|
llds_out__find_while_labels([Instr0 - _ | Instrs0], WhileSet0, WhileSet) :-
|
|
(
|
|
Instr0 = label(Label),
|
|
llds_out__is_while_label(Label, Instrs0, Instrs1, 0, UseCount),
|
|
UseCount > 0
|
|
->
|
|
bintree_set__insert(WhileSet0, Label, WhileSet1),
|
|
llds_out__find_while_labels(Instrs1, WhileSet1, WhileSet)
|
|
;
|
|
llds_out__find_while_labels(Instrs0, WhileSet0, WhileSet)
|
|
).
|
|
|
|
:- pred llds_out__is_while_label(label, list(instruction), list(instruction),
|
|
int, int).
|
|
:- mode llds_out__is_while_label(in, in, out, in, out) is det.
|
|
|
|
llds_out__is_while_label(_, [], [], Count, Count).
|
|
llds_out__is_while_label(Label, [Instr0 - Comment0 | Instrs0], Instrs,
|
|
Count0, Count) :-
|
|
( Instr0 = label(_) ->
|
|
Count = Count0,
|
|
Instrs = [Instr0 - Comment0 | Instrs0]
|
|
; Instr0 = goto(label(Label)) ->
|
|
Count1 = Count0 + 1,
|
|
llds_out__is_while_label(Label, Instrs0, Instrs, Count1, Count)
|
|
; Instr0 = if_val(_, label(Label)) ->
|
|
Count1 = Count0 + 1,
|
|
llds_out__is_while_label(Label, Instrs0, Instrs, Count1, Count)
|
|
;
|
|
llds_out__is_while_label(Label, Instrs0, Instrs, Count0, Count)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_instruction_list_decls(list(instruction)::in,
|
|
map(label, data_addr)::in, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_instruction_list_decls([], _, DeclSet, DeclSet) --> [].
|
|
output_instruction_list_decls([Instr0 - _Comment0 | Instrs], StackLayoutLabels,
|
|
DeclSet0, DeclSet) -->
|
|
output_instruction_decls(Instr0, StackLayoutLabels,
|
|
DeclSet0, DeclSet1),
|
|
output_instruction_list_decls(Instrs, StackLayoutLabels,
|
|
DeclSet1, DeclSet).
|
|
|
|
:- pred output_instruction_decls(instr::in, map(label, data_addr)::in,
|
|
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_instruction_decls(comment(_), _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(livevals(_), _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(block(_TempR, _TempF, Instrs), StackLayoutLabels,
|
|
DeclSet0, DeclSet) -->
|
|
output_instruction_list_decls(Instrs, StackLayoutLabels,
|
|
DeclSet0, DeclSet).
|
|
output_instruction_decls(assign(Lval, Rval), _, DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet1, DeclSet).
|
|
output_instruction_decls(call(Target, ContLabel, _, _, _, _), _,
|
|
DeclSet0, DeclSet) -->
|
|
output_code_addr_decls(Target, "", "", 0, _, DeclSet0, DeclSet1),
|
|
output_code_addr_decls(ContLabel, "", "", 0, _, DeclSet1, DeclSet).
|
|
output_instruction_decls(c_code(_, _), _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(mkframe(FrameInfo, FailureContinuation), _,
|
|
DeclSet0, DeclSet) -->
|
|
(
|
|
{ FrameInfo = ordinary_frame(_, _, yes(Struct)) },
|
|
{ Struct = pragma_c_struct(StructName, StructFields,
|
|
MaybeStructFieldsContext) }
|
|
->
|
|
{
|
|
decl_set_is_member(pragma_c_struct(StructName),
|
|
DeclSet0)
|
|
->
|
|
string__append_list(["struct ", StructName,
|
|
" has been declared already"], Msg),
|
|
error(Msg)
|
|
;
|
|
true
|
|
},
|
|
io__write_string("struct "),
|
|
io__write_string(StructName),
|
|
io__write_string(" {\n"),
|
|
( { MaybeStructFieldsContext = yes(StructFieldsContext) } ->
|
|
output_set_line_num(StructFieldsContext),
|
|
io__write_string(StructFields),
|
|
output_reset_line_num
|
|
;
|
|
io__write_string(StructFields)
|
|
),
|
|
io__write_string("\n};\n"),
|
|
{ decl_set_insert(DeclSet0, pragma_c_struct(StructName),
|
|
DeclSet1) }
|
|
;
|
|
{ DeclSet1 = DeclSet0 }
|
|
),
|
|
output_code_addr_decls(FailureContinuation, "", "", 0, _,
|
|
DeclSet1, DeclSet).
|
|
output_instruction_decls(label(_), _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(goto(CodeAddr), _, DeclSet0, DeclSet) -->
|
|
output_code_addr_decls(CodeAddr, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(computed_goto(Rval, _Labels), _,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(if_val(Rval, Target), _, DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet1),
|
|
output_code_addr_decls(Target, "", "", 0, _, DeclSet1, DeclSet).
|
|
output_instruction_decls(incr_hp(Lval, _Tag, Rval, _), _,
|
|
DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet1, DeclSet).
|
|
output_instruction_decls(mark_hp(Lval), _, DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(restore_hp(Rval), _, DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(free_heap(Rval), _, DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(store_ticket(Lval), _, DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(reset_ticket(Rval, _Reason), _, DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(discard_ticket, _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(prune_ticket, _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(mark_ticket_stack(Lval), _, DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(prune_tickets_to(Rval), _, DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(incr_sp(_, _), _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(decr_sp(_), _, DeclSet, DeclSet) --> [].
|
|
output_instruction_decls(pragma_c(_, Comps, _, _,
|
|
MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, _),
|
|
StackLayoutLabels, DeclSet0, DeclSet) -->
|
|
( { MaybeLayoutLabel = yes(Label) } ->
|
|
{ map__lookup(StackLayoutLabels, Label, DataAddr) },
|
|
output_stack_layout_decl(DataAddr, DeclSet0, DeclSet1)
|
|
;
|
|
{ DeclSet1 = DeclSet0 }
|
|
),
|
|
( { MaybeOnlyLayoutLabel = yes(OnlyLabel) } ->
|
|
{ map__lookup(StackLayoutLabels, OnlyLabel, OnlyDataAddr) },
|
|
output_stack_layout_decl(OnlyDataAddr, DeclSet1, DeclSet2)
|
|
;
|
|
{ DeclSet2 = DeclSet1 }
|
|
),
|
|
output_pragma_c_component_list_decls(Comps, DeclSet2, DeclSet).
|
|
output_instruction_decls(init_sync_term(Lval, _), _, DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(fork(Child, Parent, _), _, DeclSet0, DeclSet) -->
|
|
output_code_addr_decls(label(Child), "", "", 0, _, DeclSet0, DeclSet2),
|
|
output_code_addr_decls(label(Parent), "", "", 0, _, DeclSet2, DeclSet).
|
|
output_instruction_decls(join_and_terminate(Lval), _, DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
|
|
output_instruction_decls(join_and_continue(Lval, Label), _, DeclSet0, DeclSet)
|
|
-->
|
|
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
|
|
output_code_addr_decls(label(Label), "", "", 0, _, DeclSet1, DeclSet).
|
|
|
|
:- pred output_pragma_c_component_list_decls(list(pragma_c_component),
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_pragma_c_component_list_decls(in, in, out, di, uo) is det.
|
|
|
|
output_pragma_c_component_list_decls([], DeclSet, DeclSet) --> [].
|
|
output_pragma_c_component_list_decls([Component | Components],
|
|
DeclSet0, DeclSet) -->
|
|
output_pragma_c_component_decls(Component, DeclSet0, DeclSet1),
|
|
output_pragma_c_component_list_decls(Components, DeclSet1, DeclSet).
|
|
|
|
:- pred output_pragma_c_component_decls(pragma_c_component,
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_pragma_c_component_decls(in, in, out, di, uo) is det.
|
|
|
|
output_pragma_c_component_decls(pragma_c_inputs(Inputs), DeclSet0, DeclSet) -->
|
|
output_pragma_input_rval_decls(Inputs, DeclSet0, DeclSet).
|
|
output_pragma_c_component_decls(pragma_c_outputs(Outputs), DeclSet0, DeclSet)
|
|
-->
|
|
output_pragma_output_lval_decls(Outputs, DeclSet0, DeclSet).
|
|
output_pragma_c_component_decls(pragma_c_raw_code(_, _), DeclSet, DeclSet)
|
|
--> [].
|
|
output_pragma_c_component_decls(pragma_c_user_code(_, _), DeclSet, DeclSet)
|
|
--> [].
|
|
output_pragma_c_component_decls(pragma_c_fail_to(_), DeclSet, DeclSet) --> [].
|
|
output_pragma_c_component_decls(pragma_c_noop, DeclSet, DeclSet) --> [].
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_instruction_list(list(instruction), bool,
|
|
pair(label, bintree_set(label)), bintree_set(label),
|
|
io__state, io__state).
|
|
:- mode output_instruction_list(in, in, in, in, di, uo) is det.
|
|
|
|
output_instruction_list([], _, _, _) --> [].
|
|
output_instruction_list([Instr0 - Comment0 | Instrs], PrintComments, ProfInfo,
|
|
WhileSet) -->
|
|
output_instruction_and_comment(Instr0, Comment0,
|
|
PrintComments, ProfInfo),
|
|
( { Instr0 = label(Label), bintree_set__is_member(Label, WhileSet) } ->
|
|
io__write_string("\twhile (1) {\n"),
|
|
output_instruction_list_while(Instrs, Label,
|
|
PrintComments, ProfInfo, WhileSet)
|
|
;
|
|
output_instruction_list(Instrs, PrintComments, ProfInfo,
|
|
WhileSet)
|
|
).
|
|
|
|
:- pred output_instruction_list_while(list(instruction), label,
|
|
bool, pair(label, bintree_set(label)), bintree_set(label),
|
|
io__state, io__state).
|
|
:- mode output_instruction_list_while(in, in, in, in, in, di, uo) is det.
|
|
|
|
output_instruction_list_while([], _, _, _, _) -->
|
|
io__write_string("\tbreak; } /* end while */\n").
|
|
output_instruction_list_while([Instr0 - Comment0 | Instrs], Label,
|
|
PrintComments, ProfInfo, WhileSet) -->
|
|
( { Instr0 = label(_) } ->
|
|
io__write_string("\tbreak; } /* end while */\n"),
|
|
output_instruction_list([Instr0 - Comment0 | Instrs],
|
|
PrintComments, ProfInfo, WhileSet)
|
|
; { Instr0 = goto(label(Label)) } ->
|
|
io__write_string("\t/* continue */ } /* end while */\n"),
|
|
output_instruction_list(Instrs, PrintComments, ProfInfo,
|
|
WhileSet)
|
|
; { Instr0 = if_val(Rval, label(Label)) } ->
|
|
io__write_string("\tif ("),
|
|
output_rval(Rval),
|
|
io__write_string(")\n\t\tcontinue;\n"),
|
|
( { PrintComments = yes, Comment0 \= "" } ->
|
|
io__write_string("\t\t/* "),
|
|
io__write_string(Comment0),
|
|
io__write_string(" */\n")
|
|
;
|
|
[]
|
|
),
|
|
output_instruction_list_while(Instrs, Label,
|
|
PrintComments, ProfInfo, WhileSet)
|
|
;
|
|
output_instruction_and_comment(Instr0, Comment0,
|
|
PrintComments, ProfInfo),
|
|
output_instruction_list_while(Instrs, Label,
|
|
PrintComments, ProfInfo, WhileSet)
|
|
).
|
|
|
|
:- pred output_instruction_and_comment(instr, string, bool,
|
|
pair(label, bintree_set(label)), io__state, io__state).
|
|
:- mode output_instruction_and_comment(in, in, in, in, di, uo) is det.
|
|
|
|
output_instruction_and_comment(Instr, Comment, PrintComments,
|
|
ProfInfo) -->
|
|
(
|
|
{ PrintComments = no },
|
|
( { Instr = comment(_) ; Instr = livevals(_) } ->
|
|
[]
|
|
;
|
|
output_instruction(Instr, ProfInfo)
|
|
)
|
|
;
|
|
{ PrintComments = yes },
|
|
output_instruction(Instr, ProfInfo),
|
|
( { Comment = "" } ->
|
|
[]
|
|
;
|
|
io__write_string("\t\t/* "),
|
|
io__write_string(Comment),
|
|
io__write_string(" */\n")
|
|
)
|
|
).
|
|
|
|
% output_instruction_and_comment/5 is only for debugging.
|
|
% Normally we use output_instruction_and_comment/6.
|
|
|
|
output_instruction_and_comment(Instr, Comment, PrintComments) -->
|
|
{ bintree_set__init(ContLabelSet) },
|
|
{ hlds_pred__initial_proc_id(ProcId) },
|
|
{ DummyModule = unqualified("DEBUG") },
|
|
{ DummyPredName = "DEBUG" },
|
|
{ ProfInfo = local(proc(DummyModule, predicate, DummyModule,
|
|
DummyPredName, 0, ProcId)) - ContLabelSet },
|
|
output_instruction_and_comment(Instr, Comment, PrintComments, ProfInfo).
|
|
|
|
% output_instruction/3 is only for debugging.
|
|
% Normally we use output_instruction/4.
|
|
|
|
output_instruction(Instr) -->
|
|
{ bintree_set__init(ContLabelSet) },
|
|
{ hlds_pred__initial_proc_id(ProcId) },
|
|
{ DummyModule = unqualified("DEBUG") },
|
|
{ DummyPredName = "DEBUG" },
|
|
{ ProfInfo = local(proc(DummyModule, predicate, DummyModule,
|
|
DummyPredName, 0, ProcId)) - ContLabelSet },
|
|
output_instruction(Instr, ProfInfo).
|
|
|
|
:- pred output_instruction(instr, pair(label, bintree_set(label)),
|
|
io__state, io__state).
|
|
:- mode output_instruction(in, in, di, uo) is det.
|
|
|
|
output_instruction(comment(Comment), _) -->
|
|
io__write_strings(["/* ", Comment, " */\n"]).
|
|
|
|
output_instruction(livevals(LiveVals), _) -->
|
|
io__write_string("/*\n * Live lvalues:\n"),
|
|
{ set__to_sorted_list(LiveVals, LiveValsList) },
|
|
output_livevals(LiveValsList),
|
|
io__write_string(" */\n").
|
|
|
|
output_instruction(block(TempR, TempF, Instrs), ProfInfo) -->
|
|
io__write_string("\t{\n"),
|
|
( { TempR > 0 } ->
|
|
io__write_string("\tMR_Word "),
|
|
output_temp_decls(TempR, "r"),
|
|
io__write_string(";\n")
|
|
;
|
|
[]
|
|
),
|
|
( { TempF > 0 } ->
|
|
io__write_string("\tMR_Float "),
|
|
output_temp_decls(TempF, "f"),
|
|
io__write_string(";\n")
|
|
;
|
|
[]
|
|
),
|
|
globals__io_lookup_bool_option(auto_comments, PrintComments),
|
|
{ bintree_set__init(WhileSet0) },
|
|
output_instruction_list(Instrs, PrintComments, ProfInfo,
|
|
WhileSet0),
|
|
io__write_string("\t}\n").
|
|
|
|
output_instruction(assign(Lval, Rval), _) -->
|
|
io__write_string("\t"),
|
|
output_lval(Lval),
|
|
io__write_string(" = "),
|
|
{ llds__lval_type(Lval, Type) },
|
|
output_rval_as_type(Rval, Type),
|
|
io__write_string(";\n").
|
|
|
|
output_instruction(call(Target, ContLabel, LiveVals, _, _, _), ProfInfo) -->
|
|
{ ProfInfo = CallerLabel - _ },
|
|
output_call(Target, ContLabel, CallerLabel),
|
|
output_gc_livevals(LiveVals).
|
|
|
|
output_instruction(c_code(C_Code_String, _), _) -->
|
|
io__write_string("\t"),
|
|
io__write_string(C_Code_String).
|
|
|
|
output_instruction(mkframe(FrameInfo, FailCont), _) -->
|
|
(
|
|
{ FrameInfo = ordinary_frame(Msg, Num, MaybeStruct) },
|
|
( { MaybeStruct = yes(pragma_c_struct(StructName, _, _)) } ->
|
|
io__write_string("\tMR_mkpragmaframe("""),
|
|
output_c_quoted_string(Msg),
|
|
io__write_string(""", "),
|
|
io__write_int(Num),
|
|
io__write_string(", "),
|
|
io__write_string(StructName),
|
|
io__write_string(", "),
|
|
output_code_addr(FailCont),
|
|
io__write_string(");\n")
|
|
;
|
|
io__write_string("\tMR_mkframe("""),
|
|
output_c_quoted_string(Msg),
|
|
io__write_string(""", "),
|
|
io__write_int(Num),
|
|
io__write_string(", "),
|
|
output_code_addr(FailCont),
|
|
io__write_string(");\n")
|
|
)
|
|
;
|
|
{ FrameInfo = temp_frame(Kind) },
|
|
(
|
|
{ Kind = det_stack_proc },
|
|
io__write_string("\tMR_mkdettempframe("),
|
|
output_code_addr(FailCont),
|
|
io__write_string(");\n")
|
|
;
|
|
{ Kind = nondet_stack_proc },
|
|
io__write_string("\tMR_mktempframe("),
|
|
output_code_addr(FailCont),
|
|
io__write_string(");\n")
|
|
)
|
|
).
|
|
|
|
output_instruction(label(Label), ProfInfo) -->
|
|
output_label_defn(Label),
|
|
maybe_output_update_prof_counter(Label, ProfInfo).
|
|
|
|
output_instruction(goto(CodeAddr), ProfInfo) -->
|
|
{ ProfInfo = CallerLabel - _ },
|
|
io__write_string("\t"),
|
|
output_goto(CodeAddr, CallerLabel).
|
|
|
|
output_instruction(computed_goto(Rval, Labels), _) -->
|
|
io__write_string("\tMR_COMPUTED_GOTO("),
|
|
output_rval_as_type(Rval, unsigned),
|
|
io__write_string(",\n\t\t"),
|
|
output_label_list(Labels),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(if_val(Rval, Target), ProfInfo) -->
|
|
{ ProfInfo = CallerLabel - _ },
|
|
io__write_string("\tif ("),
|
|
output_rval_as_type(Rval, bool),
|
|
io__write_string(") {\n\t\t"),
|
|
output_goto(Target, CallerLabel),
|
|
io__write_string("\t}\n").
|
|
|
|
output_instruction(incr_hp(Lval, MaybeTag, Rval, TypeMsg), ProfInfo) -->
|
|
(
|
|
{ MaybeTag = no },
|
|
io__write_string("\tMR_incr_hp_msg("),
|
|
output_lval_as_word(Lval)
|
|
;
|
|
{ MaybeTag = yes(Tag) },
|
|
io__write_string("\tMR_tag_incr_hp_msg("),
|
|
output_lval_as_word(Lval),
|
|
io__write_string(", "),
|
|
output_tag(Tag)
|
|
),
|
|
io__write_string(", "),
|
|
output_rval_as_type(Rval, word),
|
|
io__write_string(", "),
|
|
{ ProfInfo = CallerLabel - _ },
|
|
output_label(CallerLabel),
|
|
io__write_string(", """),
|
|
output_c_quoted_string(TypeMsg),
|
|
io__write_string(""");\n").
|
|
|
|
output_instruction(mark_hp(Lval), _) -->
|
|
io__write_string("\tMR_mark_hp("),
|
|
output_lval_as_word(Lval),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(restore_hp(Rval), _) -->
|
|
io__write_string("\tMR_restore_hp("),
|
|
output_rval_as_type(Rval, word),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(free_heap(Rval), _) -->
|
|
io__write_string("\tMR_free_heap("),
|
|
output_rval_as_type(Rval, data_ptr),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(store_ticket(Lval), _) -->
|
|
io__write_string("\tMR_store_ticket("),
|
|
output_lval_as_word(Lval),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(reset_ticket(Rval, Reason), _) -->
|
|
io__write_string("\tMR_reset_ticket("),
|
|
output_rval_as_type(Rval, word),
|
|
io__write_string(", "),
|
|
output_reset_trail_reason(Reason),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(discard_ticket, _) -->
|
|
io__write_string("\tMR_discard_ticket();\n").
|
|
|
|
output_instruction(prune_ticket, _) -->
|
|
io__write_string("\tMR_prune_ticket();\n").
|
|
|
|
output_instruction(mark_ticket_stack(Lval), _) -->
|
|
io__write_string("\tMR_mark_ticket_stack("),
|
|
output_lval_as_word(Lval),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(prune_tickets_to(Rval), _) -->
|
|
io__write_string("\tMR_prune_tickets_to("),
|
|
output_rval_as_type(Rval, word),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(incr_sp(N, Msg), _) -->
|
|
io__write_string("\tMR_incr_sp_push_msg("),
|
|
io__write_int(N),
|
|
io__write_string(", """),
|
|
output_c_quoted_string(Msg),
|
|
io__write_string(""");\n").
|
|
|
|
output_instruction(decr_sp(N), _) -->
|
|
io__write_string("\tMR_decr_sp_pop_msg("),
|
|
io__write_int(N),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(pragma_c(Decls, Components, _, _, _, _, _, _), _) -->
|
|
io__write_string("\t{\n"),
|
|
output_pragma_decls(Decls),
|
|
output_pragma_c_components(Components),
|
|
io__write_string("\t}\n").
|
|
|
|
output_instruction(init_sync_term(Lval, N), _) -->
|
|
io__write_string("\tMR_init_sync_term("),
|
|
output_lval_as_word(Lval),
|
|
io__write_string(", "),
|
|
io__write_int(N),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(fork(Child, Parent, Lval), _) -->
|
|
io__write_string("\tMR_fork_new_context("),
|
|
output_label_as_code_addr(Child),
|
|
io__write_string(", "),
|
|
output_label_as_code_addr(Parent),
|
|
io__write_string(", "),
|
|
io__write_int(Lval),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(join_and_terminate(Lval), _) -->
|
|
io__write_string("\tMR_join_and_terminate("),
|
|
output_lval(Lval),
|
|
io__write_string(");\n").
|
|
|
|
output_instruction(join_and_continue(Lval, Label), _) -->
|
|
io__write_string("\tMR_join_and_continue("),
|
|
output_lval(Lval),
|
|
io__write_string(", "),
|
|
output_label_as_code_addr(Label),
|
|
io__write_string(");\n").
|
|
|
|
:- pred output_pragma_c_components(list(pragma_c_component),
|
|
io__state, io__state).
|
|
:- mode output_pragma_c_components(in, di, uo) is det.
|
|
|
|
output_pragma_c_components([]) --> [].
|
|
output_pragma_c_components([C | Cs]) -->
|
|
output_pragma_c_component(C),
|
|
output_pragma_c_components(Cs).
|
|
|
|
:- pred output_pragma_c_component(pragma_c_component, io__state, io__state).
|
|
:- mode output_pragma_c_component(in, di, uo) is det.
|
|
|
|
output_pragma_c_component(pragma_c_inputs(Inputs)) -->
|
|
output_pragma_inputs(Inputs).
|
|
output_pragma_c_component(pragma_c_outputs(Outputs)) -->
|
|
output_pragma_outputs(Outputs).
|
|
output_pragma_c_component(pragma_c_user_code(MaybeContext, C_Code)) -->
|
|
( { C_Code = "" } ->
|
|
[]
|
|
;
|
|
% We should start the C_Code on a new line,
|
|
% just in case it starts with a proprocessor directive.
|
|
( { MaybeContext = yes(Context) } ->
|
|
io__write_string("{\n"),
|
|
output_set_line_num(Context),
|
|
io__write_string(C_Code),
|
|
io__write_string(";}\n"),
|
|
output_reset_line_num
|
|
;
|
|
io__write_string("{\n"),
|
|
io__write_string(C_Code),
|
|
io__write_string(";}\n")
|
|
)
|
|
).
|
|
output_pragma_c_component(pragma_c_raw_code(C_Code, _)) -->
|
|
io__write_string(C_Code).
|
|
output_pragma_c_component(pragma_c_fail_to(Label)) -->
|
|
io__write_string("if (!MR_r1) MR_GOTO_LABEL("),
|
|
output_label(Label),
|
|
io__write_string(");\n").
|
|
output_pragma_c_component(pragma_c_noop) --> [].
|
|
|
|
% Output the local variable declarations at the top of the
|
|
% pragma_foreign code for C.
|
|
:- pred output_pragma_decls(list(pragma_c_decl), io__state, io__state).
|
|
:- mode output_pragma_decls(in, di, uo) is det.
|
|
|
|
output_pragma_decls([]) --> [].
|
|
output_pragma_decls([D|Decls]) -->
|
|
(
|
|
% Apart from special cases, the local variables are MR_Words
|
|
{ D = pragma_c_arg_decl(_Type, TypeString, VarName) },
|
|
io__write_string("\t"),
|
|
io__write_string(TypeString),
|
|
io__write_string("\t"),
|
|
io__write_string(VarName),
|
|
io__write_string(";\n")
|
|
;
|
|
{ D = pragma_c_struct_ptr_decl(StructTag, VarName) },
|
|
io__write_string("\tstruct "),
|
|
io__write_string(StructTag),
|
|
io__write_string("\t*"),
|
|
io__write_string(VarName),
|
|
io__write_string(";\n")
|
|
),
|
|
output_pragma_decls(Decls).
|
|
|
|
% Output declarations for any rvals used to initialize the inputs
|
|
:- pred output_pragma_input_rval_decls(list(pragma_c_input), decl_set, decl_set,
|
|
io__state, io__state).
|
|
:- mode output_pragma_input_rval_decls(in, in, out, di, uo) is det.
|
|
|
|
output_pragma_input_rval_decls([], DeclSet, DeclSet) --> [].
|
|
output_pragma_input_rval_decls([I | Inputs], DeclSet0, DeclSet) -->
|
|
{ I = pragma_c_input(_VarName, _Type, Rval, _) },
|
|
output_rval_decls(Rval, "\t", "\t", 0, _N, DeclSet0, DeclSet1),
|
|
output_pragma_input_rval_decls(Inputs, DeclSet1, DeclSet).
|
|
|
|
% Output the input variable assignments at the top of the
|
|
% pragma foreign_code code for C.
|
|
:- pred output_pragma_inputs(list(pragma_c_input), io__state, io__state).
|
|
:- mode output_pragma_inputs(in, di, uo) is det.
|
|
|
|
output_pragma_inputs([]) --> [].
|
|
output_pragma_inputs([I|Inputs]) -->
|
|
{ I = pragma_c_input(VarName, Type, Rval, MaybeForeignType) },
|
|
io__write_string("\t"),
|
|
( { MaybeForeignType = yes(ForeignType) } ->
|
|
io__write_string("MR_MAYBE_UNBOX_FOREIGN_TYPE("),
|
|
io__write_string(ForeignType),
|
|
io__write_string(", "),
|
|
output_rval(Rval),
|
|
io__write_string(", "),
|
|
io__write_string(VarName),
|
|
io__write_string(")")
|
|
;
|
|
io__write_string(VarName),
|
|
io__write_string(" = "),
|
|
(
|
|
{ Type = term__functor(term__atom("string"), [], _) }
|
|
->
|
|
output_llds_type_cast(string),
|
|
output_rval_as_type(Rval, word)
|
|
;
|
|
{ Type = term__functor(term__atom("float"), [], _) }
|
|
->
|
|
output_rval_as_type(Rval, float)
|
|
;
|
|
% Note that for this cast to be correct the foreign type
|
|
% must be a word sized integer or pointer type.
|
|
( { MaybeForeignType = yes(ForeignTypeStr) } ->
|
|
io__write_string("(" ++ ForeignTypeStr ++ ") ")
|
|
;
|
|
[]
|
|
),
|
|
output_rval_as_type(Rval, word)
|
|
)
|
|
),
|
|
io__write_string(";\n"),
|
|
output_pragma_inputs(Inputs).
|
|
|
|
% Output declarations for any lvals used for the outputs
|
|
:- pred output_pragma_output_lval_decls(list(pragma_c_output),
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_pragma_output_lval_decls(in, in, out, di, uo) is det.
|
|
|
|
output_pragma_output_lval_decls([], DeclSet, DeclSet) --> [].
|
|
output_pragma_output_lval_decls([O | Outputs], DeclSet0, DeclSet) -->
|
|
{ O = pragma_c_output(Lval, _Type, _VarName, _) },
|
|
output_lval_decls(Lval, "\t", "\t", 0, _N, DeclSet0, DeclSet1),
|
|
output_pragma_output_lval_decls(Outputs, DeclSet1, DeclSet).
|
|
|
|
% Output the output variable assignments at the bottom of the
|
|
% pragma foreign code for C
|
|
:- pred output_pragma_outputs(list(pragma_c_output), io__state, io__state).
|
|
:- mode output_pragma_outputs(in, di, uo) is det.
|
|
|
|
output_pragma_outputs([]) --> [].
|
|
output_pragma_outputs([O|Outputs]) -->
|
|
{ O = pragma_c_output(Lval, Type, VarName, MaybeForeignType) },
|
|
io__write_string("\t"),
|
|
( { MaybeForeignType = yes(ForeignType) } ->
|
|
io__write_string("MR_MAYBE_BOX_FOREIGN_TYPE("),
|
|
io__write_string(ForeignType),
|
|
io__write_string(", "),
|
|
io__write_string(VarName),
|
|
io__write_string(", "),
|
|
output_lval_as_word(Lval),
|
|
io__write_string(")")
|
|
;
|
|
output_lval_as_word(Lval),
|
|
io__write_string(" = "),
|
|
(
|
|
{ Type = term__functor(term__atom("string"), [], _) }
|
|
->
|
|
output_llds_type_cast(word),
|
|
io__write_string(VarName)
|
|
;
|
|
{ Type = term__functor(term__atom("float"), [], _) }
|
|
->
|
|
io__write_string("MR_float_to_word("),
|
|
io__write_string(VarName),
|
|
io__write_string(")")
|
|
;
|
|
io__write_string(VarName)
|
|
)
|
|
),
|
|
io__write_string(";\n"),
|
|
output_pragma_outputs(Outputs).
|
|
|
|
:- pred output_reset_trail_reason(reset_trail_reason, io__state, io__state).
|
|
:- mode output_reset_trail_reason(in, di, uo) is det.
|
|
|
|
output_reset_trail_reason(undo) -->
|
|
io__write_string("MR_undo").
|
|
output_reset_trail_reason(commit) -->
|
|
io__write_string("MR_commit").
|
|
output_reset_trail_reason(solve) -->
|
|
io__write_string("MR_solve").
|
|
output_reset_trail_reason(exception) -->
|
|
io__write_string("MR_exception").
|
|
output_reset_trail_reason(retry) -->
|
|
io__write_string("MR_retry").
|
|
output_reset_trail_reason(gc) -->
|
|
io__write_string("MR_gc").
|
|
|
|
:- pred output_livevals(list(lval), io__state, io__state).
|
|
:- mode output_livevals(in, di, uo) is det.
|
|
|
|
output_livevals([]) --> [].
|
|
output_livevals([Lval|Lvals]) -->
|
|
io__write_string(" *\t"),
|
|
output_lval(Lval),
|
|
io__write_string("\n"),
|
|
output_livevals(Lvals).
|
|
|
|
:- pred output_gc_livevals(list(liveinfo), io__state, io__state).
|
|
:- mode output_gc_livevals(in, di, uo) is det.
|
|
|
|
output_gc_livevals(LiveVals) -->
|
|
globals__io_lookup_bool_option(auto_comments, PrintAutoComments),
|
|
( { PrintAutoComments = yes } ->
|
|
io__write_string("/*\n"),
|
|
io__write_string(" * Garbage collection livevals info\n"),
|
|
output_gc_livevals_2(LiveVals),
|
|
io__write_string(" */\n")
|
|
;
|
|
[]
|
|
).
|
|
|
|
:- pred output_gc_livevals_2(list(liveinfo), io__state, io__state).
|
|
:- mode output_gc_livevals_2(in, di, uo) is det.
|
|
|
|
output_gc_livevals_2([]) --> [].
|
|
output_gc_livevals_2([LiveInfo | LiveInfos]) -->
|
|
{ LiveInfo = live_lvalue(Locn, LiveValueType, TypeParams) },
|
|
io__write_string(" *\t"),
|
|
output_layout_locn(Locn),
|
|
io__write_string("\t"),
|
|
output_live_value_type(LiveValueType),
|
|
io__write_string("\t"),
|
|
{ map__to_assoc_list(TypeParams, TypeParamList) },
|
|
output_gc_livevals_params(TypeParamList),
|
|
io__write_string("\n"),
|
|
output_gc_livevals_2(LiveInfos).
|
|
|
|
:- pred output_gc_livevals_params(assoc_list(tvar, set(layout_locn)),
|
|
io__state, io__state).
|
|
:- mode output_gc_livevals_params(in, di, uo) is det.
|
|
|
|
output_gc_livevals_params([]) --> [].
|
|
output_gc_livevals_params([Var - LocnSet | Locns]) -->
|
|
{ term__var_to_int(Var, VarInt) },
|
|
io__write_int(VarInt),
|
|
io__write_string(" - "),
|
|
{ set__to_sorted_list(LocnSet, LocnList) },
|
|
output_layout_locns(LocnList),
|
|
io__write_string(" "),
|
|
output_gc_livevals_params(Locns).
|
|
|
|
:- pred output_layout_locns(list(layout_locn), io__state, io__state).
|
|
:- mode output_layout_locns(in, di, uo) is det.
|
|
|
|
output_layout_locns([]) --> [].
|
|
output_layout_locns([Locn | Locns]) -->
|
|
output_layout_locn(Locn),
|
|
( { Locns = [] } ->
|
|
[]
|
|
;
|
|
io__write_string(" and "),
|
|
output_layout_locns(Locns)
|
|
).
|
|
|
|
:- pred output_layout_locn(layout_locn, io__state, io__state).
|
|
:- mode output_layout_locn(in, di, uo) is det.
|
|
|
|
output_layout_locn(Locn) -->
|
|
(
|
|
{ Locn = direct(Lval) },
|
|
output_lval(Lval)
|
|
;
|
|
{ Locn = indirect(Lval, Offset) },
|
|
io__write_string("offset "),
|
|
io__write_int(Offset),
|
|
io__write_string(" from "),
|
|
output_lval(Lval)
|
|
).
|
|
|
|
:- pred output_live_value_type(live_value_type, io__state, io__state).
|
|
:- mode output_live_value_type(in, di, uo) is det.
|
|
|
|
output_live_value_type(succip) --> io__write_string("type succip").
|
|
output_live_value_type(curfr) --> io__write_string("type curfr").
|
|
output_live_value_type(maxfr) --> io__write_string("type maxfr").
|
|
output_live_value_type(redofr) --> io__write_string("type redofr").
|
|
output_live_value_type(redoip) --> io__write_string("type redoip").
|
|
output_live_value_type(hp) --> io__write_string("type hp").
|
|
output_live_value_type(trail_ptr) --> io__write_string("type trail_ptr").
|
|
output_live_value_type(ticket) --> io__write_string("type ticket").
|
|
output_live_value_type(unwanted) --> io__write_string("unwanted").
|
|
output_live_value_type(var(Var, Name, Type, LldsInst)) -->
|
|
io__write_string("var("),
|
|
{ term__var_to_int(Var, VarInt) },
|
|
io__write_int(VarInt),
|
|
io__write_string(", "),
|
|
io__write_string(Name),
|
|
io__write_string(", "),
|
|
% XXX Fake type varset
|
|
{ varset__init(NewTVarset) },
|
|
mercury_output_term(Type, NewTVarset, no),
|
|
io__write_string(", "),
|
|
(
|
|
{ LldsInst = ground },
|
|
io__write_string("ground")
|
|
;
|
|
{ LldsInst = partial(Inst) },
|
|
% XXX Fake inst varset
|
|
{ varset__init(NewIVarset) },
|
|
mercury_output_inst(Inst, NewIVarset)
|
|
),
|
|
io__write_string(")").
|
|
|
|
:- pred output_temp_decls(int, string, io__state, io__state).
|
|
:- mode output_temp_decls(in, in, di, uo) is det.
|
|
|
|
output_temp_decls(N, Type) -->
|
|
output_temp_decls_2(1, N, Type).
|
|
|
|
:- pred output_temp_decls_2(int, int, string, io__state, io__state).
|
|
:- mode output_temp_decls_2(in, in, in, di, uo) is det.
|
|
|
|
output_temp_decls_2(Next, Max, Type) -->
|
|
( { Next =< Max } ->
|
|
( { Next > 1 } ->
|
|
io__write_string(", ")
|
|
;
|
|
[]
|
|
),
|
|
io__write_string("MR_temp"),
|
|
io__write_string(Type),
|
|
io__write_int(Next),
|
|
{ Next1 = Next + 1 },
|
|
output_temp_decls_2(Next1, Max, Type)
|
|
;
|
|
[]
|
|
).
|
|
|
|
output_rval_decls(lval(Lval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_lval_decls(Lval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_rval_decls(var(_), _, _, _, _, _, _) -->
|
|
{ error("output_rval_decls: unexpected var") }.
|
|
output_rval_decls(mkword(_, Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_rval_decls(const(Const), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
( { Const = code_addr_const(CodeAddress) } ->
|
|
output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent,
|
|
N0, N, DeclSet0, DeclSet)
|
|
; { Const = data_addr_const(DataAddr) } ->
|
|
output_data_addr_decls(DataAddr,
|
|
FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet)
|
|
; { Const = float_const(FloatVal) } ->
|
|
%
|
|
% If floats are boxed, and the static ground terms
|
|
% option is enabled, then for each float constant
|
|
% which we might want to box we declare a static const
|
|
% variable holding that constant.
|
|
%
|
|
globals__io_lookup_bool_option(unboxed_float, UnboxedFloat),
|
|
globals__io_lookup_bool_option(static_ground_terms,
|
|
StaticGroundTerms),
|
|
( { UnboxedFloat = no, StaticGroundTerms = yes } ->
|
|
{ llds_out__float_literal_name(FloatVal, FloatName) },
|
|
{ FloatLabel = float_label(FloatName) },
|
|
( { decl_set_is_member(FloatLabel, DeclSet0) } ->
|
|
{ N = N0 },
|
|
{ DeclSet = DeclSet0 }
|
|
;
|
|
{ decl_set_insert(DeclSet0, FloatLabel,
|
|
DeclSet) },
|
|
{ FloatString = c_util__make_float_literal(
|
|
FloatVal) },
|
|
output_indent(FirstIndent, LaterIndent, N0),
|
|
{ N = N0 + 1 },
|
|
io__write_strings([
|
|
"static const MR_Float ",
|
|
"mercury_float_const_", FloatName,
|
|
" = ", FloatString, ";\n"
|
|
])
|
|
)
|
|
;
|
|
{ N = N0 },
|
|
{ DeclSet = DeclSet0 }
|
|
)
|
|
;
|
|
{ N = N0 },
|
|
{ DeclSet = DeclSet0 }
|
|
).
|
|
output_rval_decls(unop(_, Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_rval_decls(binop(Op, Rval1, Rval2), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval1, FirstIndent, LaterIndent, N0, N1,
|
|
DeclSet0, DeclSet1),
|
|
output_rval_decls(Rval2, FirstIndent, LaterIndent, N1, N2,
|
|
DeclSet1, DeclSet2),
|
|
%
|
|
% If floats are boxed, and the static ground terms
|
|
% option is enabled, then for each float constant
|
|
% which we might want to box we declare a static const
|
|
% variable holding that constant.
|
|
%
|
|
( { c_util__float_op(Op, OpStr) } ->
|
|
globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
|
|
globals__io_lookup_bool_option(static_ground_terms,
|
|
StaticGroundTerms),
|
|
(
|
|
{ UnboxFloat = no, StaticGroundTerms = yes },
|
|
{ llds_out__float_const_binop_expr_name(Op, Rval1, Rval2,
|
|
FloatName) }
|
|
->
|
|
{ FloatLabel = float_label(FloatName) },
|
|
( { decl_set_is_member(FloatLabel, DeclSet2) } ->
|
|
{ N = N2 },
|
|
{ DeclSet = DeclSet2 }
|
|
;
|
|
{ decl_set_insert(DeclSet2, FloatLabel, DeclSet) },
|
|
output_indent(FirstIndent, LaterIndent, N2),
|
|
{ N = N2 + 1 },
|
|
io__write_string("static const "),
|
|
output_llds_type(float),
|
|
io__write_string(" mercury_float_const_"),
|
|
io__write_string(FloatName),
|
|
io__write_string(" = "),
|
|
% note that we just output the expression
|
|
% here, and let the C compiler evaluate it,
|
|
% rather than evaluating it ourselves;
|
|
% this avoids having to deal with some nasty
|
|
% issues regarding floating point accuracy
|
|
% when doing cross-compilation.
|
|
output_rval_as_type(Rval1, float),
|
|
io__write_string(" "),
|
|
io__write_string(OpStr),
|
|
io__write_string(" "),
|
|
output_rval_as_type(Rval2, float),
|
|
io__write_string(";\n")
|
|
)
|
|
;
|
|
{ N = N2 },
|
|
{ DeclSet = DeclSet2 }
|
|
)
|
|
;
|
|
{ N = N2 },
|
|
{ DeclSet = DeclSet2 }
|
|
).
|
|
output_rval_decls(
|
|
create(_Tag, ArgVals, CreateArgTypes, _StatDyn, Label, _, _),
|
|
FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet) -->
|
|
{ CreateLabel = create_label(Label) },
|
|
( { decl_set_is_member(CreateLabel, DeclSet0) } ->
|
|
{ N = N0 },
|
|
{ DeclSet = DeclSet0 }
|
|
;
|
|
{ decl_set_insert(DeclSet0, CreateLabel, DeclSet1) },
|
|
output_cons_arg_decls(ArgVals, FirstIndent, LaterIndent,
|
|
N0, N1, DeclSet1, DeclSet),
|
|
output_const_term_decl(ArgVals, CreateArgTypes, CreateLabel,
|
|
no, yes, yes, yes, FirstIndent, LaterIndent, N1, N)
|
|
).
|
|
output_rval_decls(mem_addr(MemRef), FirstIndent, LaterIndent,
|
|
N0, N, DeclSet0, DeclSet) -->
|
|
output_mem_ref_decls(MemRef, FirstIndent, LaterIndent,
|
|
N0, N, DeclSet0, DeclSet).
|
|
|
|
output_rvals_decls([], _FirstIndent, _LaterIndent, N, N,
|
|
DeclSet, DeclSet) --> [].
|
|
output_rvals_decls([Rval | Rvals], FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N1,
|
|
DeclSet0, DeclSet1),
|
|
output_rvals_decls(Rvals, FirstIndent, LaterIndent, N1, N,
|
|
DeclSet1, DeclSet).
|
|
|
|
:- pred output_mem_ref_decls(mem_ref, string, string, int, int,
|
|
decl_set, decl_set, io__state, io__state).
|
|
:- mode output_mem_ref_decls(in, in, in, in, out, in, out, di, uo) is det.
|
|
|
|
output_mem_ref_decls(stackvar_ref(_), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_mem_ref_decls(framevar_ref(_), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_mem_ref_decls(heap_ref(Rval, _, _), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The following predicates are used to compute the names used for
|
|
% floating point static constants.
|
|
|
|
:- pred llds_out__float_const_expr_name(rval::in, string::out) is semidet.
|
|
|
|
% Given an rval, succeed iff it is a floating point constant expression;
|
|
% if so, return a name for that rval that is suitable for use in a C identifier.
|
|
% Different rvals must be given different names.
|
|
|
|
llds_out__float_const_expr_name(Expr, Name) :-
|
|
( Expr = const(float_const(Float)) ->
|
|
llds_out__float_literal_name(Float, Name)
|
|
; Expr = binop(Op, Arg1, Arg2) ->
|
|
llds_out__float_const_binop_expr_name(Op, Arg1, Arg2, Name)
|
|
;
|
|
fail
|
|
).
|
|
|
|
:- pred llds_out__float_const_binop_expr_name(binary_op::in, rval::in, rval::in,
|
|
string::out) is semidet.
|
|
|
|
% Given a binop rval, succeed iff that rval is a floating point constant
|
|
% expression; if so, return a name for that rval that is suitable for use in
|
|
% a C identifier. Different rvals must be given different names.
|
|
|
|
llds_out__float_const_binop_expr_name(Op, Arg1, Arg2, Name) :-
|
|
llds_out__float_op_name(Op, OpName),
|
|
llds_out__float_const_expr_name(Arg1, Arg1Name),
|
|
llds_out__float_const_expr_name(Arg2, Arg2Name),
|
|
% we use prefix notation (operator, argument, argument)
|
|
% rather than infix, to ensure that different rvals get
|
|
% different names
|
|
string__append_list([OpName, "_", Arg1Name, "_", Arg2Name],
|
|
Name).
|
|
|
|
:- pred llds_out__float_literal_name(float::in, string::out) is det.
|
|
|
|
% Given an rval which is a floating point literal, return
|
|
% a name for that rval that is suitable for use in a C identifier.
|
|
% Different rvals must be given different names.
|
|
|
|
llds_out__float_literal_name(Float, FloatName) :-
|
|
%
|
|
% The name of the variable is based on the
|
|
% value of the float const, with "pt" instead
|
|
% of ".", "plus" instead of "+", and "neg" instead of "-".
|
|
%
|
|
FloatName0 = c_util__make_float_literal(Float),
|
|
string__replace_all(FloatName0, ".", "pt", FloatName1),
|
|
string__replace_all(FloatName1, "+", "plus", FloatName2),
|
|
string__replace_all(FloatName2, "-", "neg", FloatName).
|
|
|
|
:- pred llds_out__float_op_name(binary_op, string).
|
|
:- mode llds_out__float_op_name(in, out) is semidet.
|
|
|
|
% succeed iff the binary operator is an operator whose return
|
|
% type is float; bind the output string to a name for that operator
|
|
% that is suitable for use in a C identifier
|
|
|
|
llds_out__float_op_name(float_plus, "plus").
|
|
llds_out__float_op_name(float_minus, "minus").
|
|
llds_out__float_op_name(float_times, "times").
|
|
llds_out__float_op_name(float_divide, "divide").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% We output constant terms as follows:
|
|
%
|
|
% static const struct <foo>_struct {
|
|
% MR_Word field1; // Def
|
|
% MR_Float field2;
|
|
% MR_Word * field3;
|
|
% ...
|
|
% }
|
|
% <foo> // Decl
|
|
% = { // Init
|
|
% ...
|
|
% };
|
|
%
|
|
% Unless the term contains code addresses, and we don't have
|
|
% static code addresses available, in which case we'll have
|
|
% to initialize them dynamically, so we must omit `const'
|
|
% from the above structure.
|
|
%
|
|
% Also we now conditionally output some parts. The parts that
|
|
% are conditionally output are Def, Decl and Init. It is an
|
|
% error for Init to be yes and Decl to be no.
|
|
|
|
:- pred output_const_term_decl(list(maybe(rval)), create_arg_types, decl_id,
|
|
bool, bool, bool, bool, string, string, int, int, io__state, io__state).
|
|
:- mode output_const_term_decl(in, in, in, in, in, in,
|
|
in, in, in, in, out, di, uo) is det.
|
|
|
|
output_const_term_decl(ArgVals, CreateArgTypes, DeclId, Exported,
|
|
Def, Decl, Init, FirstIndent, LaterIndent, N1, N) -->
|
|
(
|
|
{ Init = yes }, { Decl = no }
|
|
->
|
|
{ error("output_const_term_decl: Inconsistent Decl and Init") }
|
|
;
|
|
[]
|
|
),
|
|
output_indent(FirstIndent, LaterIndent, N1),
|
|
{ N = N1 + 1 },
|
|
(
|
|
{ Decl = yes }
|
|
->
|
|
(
|
|
{ Exported = yes }
|
|
->
|
|
[]
|
|
;
|
|
io__write_string("static ")
|
|
),
|
|
globals__io_get_globals(Globals),
|
|
{ globals__have_static_code_addresses(Globals, StaticCode) },
|
|
(
|
|
% Don't make the structure `const'
|
|
% if the structure will eventually include
|
|
% code addresses but we don't have static code
|
|
% addresses.
|
|
{ StaticCode = no },
|
|
{ DeclId = data_addr(DataAddr) },
|
|
{ data_addr_would_include_code_address(DataAddr)
|
|
= yes }
|
|
->
|
|
[]
|
|
;
|
|
% XXX io__write_string("const ")
|
|
% []
|
|
io__write_string("const ")
|
|
)
|
|
;
|
|
[]
|
|
),
|
|
io__write_string("struct "),
|
|
|
|
output_decl_id(DeclId),
|
|
io__write_string("_struct"),
|
|
(
|
|
{ Def = yes }
|
|
->
|
|
io__write_string(" {\n"),
|
|
output_cons_arg_types(ArgVals, CreateArgTypes, "\t", 1),
|
|
io__write_string("} ")
|
|
;
|
|
[]
|
|
),
|
|
(
|
|
{ Decl = yes }
|
|
->
|
|
io__write_string(" "),
|
|
output_decl_id(DeclId),
|
|
(
|
|
{ Init = yes }
|
|
->
|
|
io__write_string(" = {\n"),
|
|
output_cons_args(ArgVals, CreateArgTypes, "\t"),
|
|
io__write_string(LaterIndent),
|
|
io__write_string("};\n")
|
|
;
|
|
io__write_string(";\n")
|
|
)
|
|
;
|
|
io__write_string(";\n")
|
|
).
|
|
|
|
% Return true if a data structure of the given type will eventually
|
|
% include code addresses. Note that we can't just test the data
|
|
% structure itself, since in the absence of code addresses the earlier
|
|
% passes will have replaced any code addresses with dummy values
|
|
% that will have to be overridden with the real code address at
|
|
% initialization time.
|
|
|
|
:- func data_addr_would_include_code_address(data_addr) = bool.
|
|
|
|
data_addr_would_include_code_address(data_addr(_, DataName)) =
|
|
data_name_would_include_code_address(DataName).
|
|
data_addr_would_include_code_address(rtti_addr(_, RttiName)) =
|
|
rtti_name_would_include_code_addr(RttiName).
|
|
data_addr_would_include_code_address(layout_addr(LayoutName)) =
|
|
layout_name_would_include_code_addr(LayoutName).
|
|
|
|
:- func data_name_would_include_code_address(data_name) = bool.
|
|
|
|
data_name_would_include_code_address(common(_)) = no.
|
|
data_name_would_include_code_address(base_typeclass_info(_, _)) = yes.
|
|
data_name_would_include_code_address(tabling_pointer(_)) = no.
|
|
data_name_would_include_code_address(deep_profiling_procedure_data(_)) = no.
|
|
|
|
:- pred output_decl_id(decl_id, io__state, io__state).
|
|
:- mode output_decl_id(in, di, uo) is det.
|
|
|
|
output_decl_id(create_label(N)) -->
|
|
io__write_string("mercury_const_"),
|
|
io__write_int(N).
|
|
output_decl_id(data_addr(DataAddr)) -->
|
|
output_data_addr(DataAddr).
|
|
output_decl_id(code_addr(_CodeAddress)) -->
|
|
{ error("output_decl_id: code_addr unexpected") }.
|
|
output_decl_id(float_label(_Label)) -->
|
|
{ error("output_decl_id: float_label unexpected") }.
|
|
output_decl_id(pragma_c_struct(_Name)) -->
|
|
{ error("output_decl_id: pragma_c_struct unexpected") }.
|
|
|
|
:- pred output_cons_arg_types(list(maybe(rval))::in, create_arg_types::in,
|
|
string::in, int::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_cons_arg_types(Args, uniform(MaybeType), Indent, ArgNum) -->
|
|
output_uniform_cons_arg_types(Args, MaybeType, Indent, ArgNum).
|
|
output_cons_arg_types(Args, initial(InitialTypes, RestTypes),
|
|
Indent, ArgNum) -->
|
|
output_initial_cons_arg_types(Args, InitialTypes, RestTypes,
|
|
Indent, ArgNum).
|
|
output_cons_arg_types(Args, none, _, _) -->
|
|
{ require(unify(Args, []), "too many args for specified arg types") }.
|
|
|
|
:- pred output_uniform_cons_arg_types(list(maybe(rval))::in,
|
|
maybe(llds_type)::in, string::in, int::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_uniform_cons_arg_types([], _, _, _) --> [].
|
|
output_uniform_cons_arg_types([Arg | Args], MaybeType, Indent, ArgNum) -->
|
|
( { Arg = yes(Rval) } ->
|
|
io__write_string(Indent),
|
|
llds_arg_type(Rval, MaybeType, Type),
|
|
output_llds_type(Type),
|
|
io__write_string(" f"),
|
|
io__write_int(ArgNum),
|
|
io__write_string(";\n"),
|
|
{ ArgNum1 = ArgNum + 1 },
|
|
output_uniform_cons_arg_types(Args, MaybeType, Indent, ArgNum1)
|
|
;
|
|
{ error("output_uniform_cons_arg_types: missing arg") }
|
|
).
|
|
|
|
:- pred output_initial_cons_arg_types(list(maybe(rval))::in,
|
|
initial_arg_types::in, create_arg_types::in, string::in, int::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_initial_cons_arg_types(Args, [], RestTypes, Indent, ArgNum) -->
|
|
output_cons_arg_types(Args, RestTypes, Indent, ArgNum).
|
|
output_initial_cons_arg_types(Args, [N - MaybeType | InitTypes], RestTypes,
|
|
Indent, ArgNum) -->
|
|
output_initial_cons_arg_types_2(Args, N, MaybeType, InitTypes,
|
|
RestTypes, Indent, ArgNum).
|
|
|
|
:- pred output_initial_cons_arg_types_2(list(maybe(rval))::in, int::in,
|
|
maybe(llds_type)::in, initial_arg_types::in, create_arg_types::in,
|
|
string::in, int::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_initial_cons_arg_types_2([], N, _, _, _, _, _) -->
|
|
{ require(unify(N, 0), "not enough args for specified arg types") }.
|
|
output_initial_cons_arg_types_2([Arg | Args], N, MaybeType, InitTypes,
|
|
RestTypes, Indent, ArgNum) -->
|
|
( { N = 0 } ->
|
|
output_initial_cons_arg_types([Arg | Args], InitTypes,
|
|
RestTypes, Indent, ArgNum)
|
|
;
|
|
( { Arg = yes(Rval) } ->
|
|
io__write_string(Indent),
|
|
llds_arg_type(Rval, MaybeType, Type),
|
|
output_llds_type(Type),
|
|
io__write_string(" f"),
|
|
io__write_int(ArgNum),
|
|
io__write_string(";\n"),
|
|
{ ArgNum1 = ArgNum + 1 },
|
|
{ N1 = N - 1 },
|
|
output_initial_cons_arg_types_2(Args, N1, MaybeType,
|
|
InitTypes, RestTypes, Indent, ArgNum1)
|
|
;
|
|
{ error("output_initial_cons_arg_types: missing arg") }
|
|
)
|
|
).
|
|
|
|
% Given an rval, figure out the type it would have as an argument,
|
|
% if it is not explicitly specified.
|
|
|
|
:- pred llds_arg_type(rval::in, maybe(llds_type)::in, llds_type::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
llds_arg_type(Rval, MaybeType, Type) -->
|
|
( { MaybeType = yes(SpecType) } ->
|
|
{ Type = SpecType }
|
|
;
|
|
llds_out__rval_type_as_arg(Rval, Type)
|
|
).
|
|
|
|
% Given an rval, figure out the type it would have as
|
|
% an argument. Normally that's the same as its usual type;
|
|
% the exception is that for boxed floats, the type is data_ptr
|
|
% (i.e. the type of the boxed value) rather than float
|
|
% (the type of the unboxed value).
|
|
|
|
:- pred llds_out__rval_type_as_arg(rval::in, llds_type::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
llds_out__rval_type_as_arg(Rval, ArgType) -->
|
|
{ llds__rval_type(Rval, Type) },
|
|
globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
|
|
( { Type = float, UnboxFloat = no } ->
|
|
{ ArgType = data_ptr }
|
|
;
|
|
{ ArgType = Type }
|
|
).
|
|
|
|
% Same as output_llds_type, but will put parentheses
|
|
% around the llds_type.
|
|
:- pred output_llds_type_cast(llds_type::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_llds_type_cast(LLDSType) -->
|
|
io__write_string("("),
|
|
output_llds_type(LLDSType),
|
|
io__write_string(") ").
|
|
|
|
:- pred output_llds_type(llds_type::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_llds_type(int_least8) --> io__write_string("MR_int_least8_t").
|
|
output_llds_type(uint_least8) --> io__write_string("MR_uint_least8_t").
|
|
output_llds_type(int_least16) --> io__write_string("MR_int_least16_t").
|
|
output_llds_type(uint_least16) --> io__write_string("MR_uint_least16_t").
|
|
output_llds_type(int_least32) --> io__write_string("MR_int_least32_t").
|
|
output_llds_type(uint_least32) --> io__write_string("MR_uint_least32_t").
|
|
output_llds_type(bool) --> io__write_string("MR_Integer").
|
|
output_llds_type(integer) --> io__write_string("MR_Integer").
|
|
output_llds_type(unsigned) --> io__write_string("MR_Unsigned").
|
|
output_llds_type(float) --> io__write_string("MR_Float").
|
|
output_llds_type(word) --> io__write_string("MR_Word").
|
|
output_llds_type(string) --> io__write_string("MR_String").
|
|
output_llds_type(data_ptr) --> io__write_string("MR_Word *").
|
|
output_llds_type(code_ptr) --> io__write_string("MR_Code *").
|
|
|
|
:- pred output_cons_arg_decls(list(maybe(rval))::in, string::in, string::in,
|
|
int::in, int::out, decl_set::in, decl_set::out,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_cons_arg_decls([], _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_cons_arg_decls([Arg | Args], FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
( { Arg = yes(Rval) } ->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N1,
|
|
DeclSet0, DeclSet1)
|
|
;
|
|
{ N1 = N0 },
|
|
{ DeclSet1 = DeclSet0 }
|
|
),
|
|
output_cons_arg_decls(Args, FirstIndent, LaterIndent, N1, N,
|
|
DeclSet1, DeclSet).
|
|
|
|
% Output the arguments, each on its own line prefixing with Indent,
|
|
% and with a cast appropriate to its type if necessary.
|
|
|
|
:- pred output_cons_args(list(maybe(rval))::in, create_arg_types::in,
|
|
string::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_cons_args(Args, uniform(MaybeType), Indent) -->
|
|
output_uniform_cons_args(Args, MaybeType, Indent).
|
|
output_cons_args(Args, initial(InitTypes, RestTypes), Indent) -->
|
|
output_initial_cons_args(Args, InitTypes, RestTypes, Indent).
|
|
output_cons_args(Args, none, _) -->
|
|
{ require(unify(Args, []), "too many args for specified arg types") }.
|
|
|
|
:- pred output_uniform_cons_args(list(maybe(rval))::in, maybe(llds_type)::in,
|
|
string::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_uniform_cons_args([], _, _) --> [].
|
|
output_uniform_cons_args([Arg | Args], MaybeType, Indent) -->
|
|
( { Arg = yes(Rval) } ->
|
|
io__write_string(Indent),
|
|
globals__io_get_globals(Globals),
|
|
(
|
|
%
|
|
% Don't output code_addr_consts if they are not
|
|
% actually const; instead just output `NULL' here in
|
|
% the static initializer. The value will be supplied
|
|
% by the dynamic initialization code.
|
|
%
|
|
{ Rval = const(code_addr_const(_)) },
|
|
{ globals__have_static_code_addresses(Globals,
|
|
StaticCode) },
|
|
{ StaticCode = no }
|
|
->
|
|
io__write_string("NULL")
|
|
;
|
|
( { MaybeType = yes(_) } ->
|
|
output_static_rval(Rval)
|
|
;
|
|
llds_out__rval_type_as_arg(Rval, Type),
|
|
output_rval_as_type(Rval, Type)
|
|
)
|
|
),
|
|
( { Args \= [] } ->
|
|
io__write_string(",\n"),
|
|
output_uniform_cons_args(Args, MaybeType, Indent)
|
|
;
|
|
io__write_string("\n")
|
|
)
|
|
;
|
|
% `Arg = no' means the argument is uninitialized,
|
|
% but that would mean the term isn't ground
|
|
{ error("output_uniform_cons_args: missing argument") }
|
|
).
|
|
|
|
:- pred output_initial_cons_args(list(maybe(rval))::in, initial_arg_types::in,
|
|
create_arg_types::in, string::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_initial_cons_args(Args, [], RestTypes, Indent) -->
|
|
output_cons_args(Args, RestTypes, Indent).
|
|
output_initial_cons_args(Args, [N - MaybeType | InitTypes], RestTypes,
|
|
Indent) -->
|
|
output_initial_cons_args_2(Args, N, MaybeType, InitTypes, RestTypes,
|
|
Indent).
|
|
|
|
:- pred output_initial_cons_args_2(list(maybe(rval))::in, int::in,
|
|
maybe(llds_type)::in, initial_arg_types::in, create_arg_types::in,
|
|
string::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_initial_cons_args_2([], N, _, _, _, _) -->
|
|
{ require(unify(N, 0), "not enough args for specified arg types") }.
|
|
output_initial_cons_args_2([Arg | Args], N, MaybeType, InitTypes, RestTypes,
|
|
Indent) -->
|
|
( { N = 0 } ->
|
|
output_initial_cons_args([Arg | Args], InitTypes, RestTypes,
|
|
Indent)
|
|
;
|
|
( { Arg = yes(Rval) } ->
|
|
{ N1 = N - 1 },
|
|
io__write_string(Indent),
|
|
( { MaybeType = yes(_) } ->
|
|
output_static_rval(Rval)
|
|
;
|
|
llds_out__rval_type_as_arg(Rval, Type),
|
|
output_rval_as_type(Rval, Type)
|
|
),
|
|
( { Args \= [] } ->
|
|
io__write_string(",\n"),
|
|
output_initial_cons_args_2(Args, N1, MaybeType,
|
|
InitTypes, RestTypes, Indent)
|
|
;
|
|
{ require(unify(N1, 0),
|
|
"not enough args for specified arg types") },
|
|
io__write_string("\n")
|
|
)
|
|
;
|
|
{ error("output_initial_cons_arg: missing argument") }
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% output_lval_decls(Lval, ...) outputs the declarations of any
|
|
% static constants, etc. that need to be declared before
|
|
% output_lval(Lval) is called.
|
|
|
|
:- pred output_lval_decls(lval, string, string, int, int, decl_set, decl_set,
|
|
io__state, io__state).
|
|
:- mode output_lval_decls(in, in, in, in, out, in, out, di, uo) is det.
|
|
|
|
output_lval_decls(field(_, Rval, FieldNum), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N1,
|
|
DeclSet0, DeclSet1),
|
|
output_rval_decls(FieldNum, FirstIndent, LaterIndent, N1, N,
|
|
DeclSet1, DeclSet).
|
|
output_lval_decls(reg(_, _), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(stackvar(_), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(framevar(_), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(succip, _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(maxfr, _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(curfr, _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(succfr(Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_lval_decls(prevfr(Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_lval_decls(redofr(Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_lval_decls(redoip(Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_lval_decls(succip(Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
output_lval_decls(hp, _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(sp, _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(lvar(_), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(temp(_, _), _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_lval_decls(mem_ref(Rval), FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet).
|
|
|
|
output_code_addrs_decls([], _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_code_addrs_decls([CodeAddress | CodeAddresses], FirstIndent, LaterIndent,
|
|
N0, N, DeclSet0, DeclSet) -->
|
|
output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent, N0, N1,
|
|
DeclSet0, DeclSet1),
|
|
output_code_addrs_decls(CodeAddresses, FirstIndent, LaterIndent, N1, N,
|
|
DeclSet1, DeclSet).
|
|
|
|
output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
( { decl_set_is_member(code_addr(CodeAddress), DeclSet0) } ->
|
|
{ N = N0 },
|
|
{ DeclSet = DeclSet0 }
|
|
;
|
|
{ decl_set_insert(DeclSet0, code_addr(CodeAddress), DeclSet) },
|
|
need_code_addr_decls(CodeAddress, NeedDecl),
|
|
( { NeedDecl = yes } ->
|
|
output_indent(FirstIndent, LaterIndent, N0),
|
|
{ N = N0 + 1 },
|
|
output_code_addr_decls(CodeAddress)
|
|
;
|
|
{ N = N0 }
|
|
)
|
|
).
|
|
|
|
:- pred need_code_addr_decls(code_addr, bool, io__state, io__state).
|
|
:- mode need_code_addr_decls(in, out, di, uo) is det.
|
|
|
|
need_code_addr_decls(label(Label), Need) -->
|
|
{
|
|
Label = exported(_),
|
|
Need = yes
|
|
;
|
|
Label = local(_),
|
|
Need = yes
|
|
;
|
|
Label = c_local(_),
|
|
Need = no
|
|
;
|
|
Label = local(_, _),
|
|
Need = no
|
|
}.
|
|
need_code_addr_decls(imported(_), yes) --> [].
|
|
need_code_addr_decls(succip, no) --> [].
|
|
need_code_addr_decls(do_succeed(_), no) --> [].
|
|
need_code_addr_decls(do_redo, NeedDecl) -->
|
|
globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
|
|
(
|
|
{ UseMacro = yes },
|
|
{ NeedDecl = no }
|
|
;
|
|
{ UseMacro = no },
|
|
{ NeedDecl = yes }
|
|
).
|
|
need_code_addr_decls(do_fail, NeedDecl) -->
|
|
globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
|
|
(
|
|
{ UseMacro = yes },
|
|
{ NeedDecl = no }
|
|
;
|
|
{ UseMacro = no },
|
|
{ NeedDecl = yes }
|
|
).
|
|
need_code_addr_decls(do_trace_redo_fail_shallow, yes) --> [].
|
|
need_code_addr_decls(do_trace_redo_fail_deep, yes) --> [].
|
|
need_code_addr_decls(do_call_closure, yes) --> [].
|
|
need_code_addr_decls(do_call_class_method, yes) --> [].
|
|
need_code_addr_decls(do_det_aditi_call, yes) --> [].
|
|
need_code_addr_decls(do_semidet_aditi_call, yes) --> [].
|
|
need_code_addr_decls(do_nondet_aditi_call, yes) --> [].
|
|
need_code_addr_decls(do_aditi_insert, yes) --> [].
|
|
need_code_addr_decls(do_aditi_delete, yes) --> [].
|
|
need_code_addr_decls(do_aditi_bulk_insert, yes) --> [].
|
|
need_code_addr_decls(do_aditi_bulk_delete, yes) --> [].
|
|
need_code_addr_decls(do_aditi_bulk_modify, yes) --> [].
|
|
need_code_addr_decls(do_not_reached, yes) --> [].
|
|
|
|
:- pred output_code_addr_decls(code_addr, io__state, io__state).
|
|
:- mode output_code_addr_decls(in, di, uo) is det.
|
|
|
|
output_code_addr_decls(label(Label)) -->
|
|
output_label_as_code_addr_decls(Label).
|
|
output_code_addr_decls(imported(ProcLabel)) -->
|
|
io__write_string("MR_declare_entry("),
|
|
output_proc_label(ProcLabel),
|
|
io__write_string(");\n").
|
|
output_code_addr_decls(succip) --> [].
|
|
output_code_addr_decls(do_succeed(_)) --> [].
|
|
output_code_addr_decls(do_redo) -->
|
|
globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
|
|
(
|
|
{ UseMacro = yes }
|
|
;
|
|
{ UseMacro = no },
|
|
io__write_string("MR_declare_entry("),
|
|
io__write_string("MR_do_redo"),
|
|
io__write_string(");\n")
|
|
).
|
|
output_code_addr_decls(do_fail) -->
|
|
globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
|
|
(
|
|
{ UseMacro = yes }
|
|
;
|
|
{ UseMacro = no },
|
|
io__write_string("MR_declare_entry("),
|
|
io__write_string("MR_do_fail"),
|
|
io__write_string(");\n")
|
|
).
|
|
output_code_addr_decls(do_trace_redo_fail_shallow) -->
|
|
io__write_string("MR_declare_entry(MR_do_trace_redo_fail_shallow);\n").
|
|
output_code_addr_decls(do_trace_redo_fail_deep) -->
|
|
io__write_string("MR_declare_entry(MR_do_trace_redo_fail_deep);\n").
|
|
output_code_addr_decls(do_call_closure) -->
|
|
io__write_string("MR_declare_entry(mercury__do_call_closure);\n").
|
|
output_code_addr_decls(do_call_class_method) -->
|
|
io__write_string("MR_declare_entry(mercury__do_call_class_method);\n").
|
|
% XXX The do_*_aditi_call and do_aditi_* entry point names
|
|
% should start with an `MADITI_' prefix.
|
|
output_code_addr_decls(do_det_aditi_call) -->
|
|
io__write_string("MR_declare_entry(do_det_aditi_call);\n").
|
|
output_code_addr_decls(do_semidet_aditi_call) -->
|
|
io__write_string("MR_declare_entry(do_semidet_aditi_call);\n").
|
|
output_code_addr_decls(do_nondet_aditi_call) -->
|
|
io__write_string("MR_declare_entry(do_nondet_aditi_call);\n").
|
|
output_code_addr_decls(do_aditi_insert) -->
|
|
io__write_string("MR_declare_entry(do_aditi_insert);\n").
|
|
output_code_addr_decls(do_aditi_delete) -->
|
|
io__write_string("MR_declare_entry(do_aditi_delete);\n").
|
|
output_code_addr_decls(do_aditi_bulk_insert) -->
|
|
io__write_string("MR_declare_entry(do_aditi_bulk_insert);\n").
|
|
output_code_addr_decls(do_aditi_bulk_delete) -->
|
|
io__write_string("MR_declare_entry(do_aditi_bulk_delete);\n").
|
|
output_code_addr_decls(do_aditi_bulk_modify) -->
|
|
io__write_string("MR_declare_entry(do_aditi_bulk_modify);\n").
|
|
output_code_addr_decls(do_not_reached) -->
|
|
io__write_string("MR_declare_entry(MR_do_not_reached);\n").
|
|
|
|
:- pred output_label_as_code_addr_decls(label, io__state, io__state).
|
|
:- mode output_label_as_code_addr_decls(in, di, uo) is det.
|
|
|
|
output_label_as_code_addr_decls(exported(ProcLabel)) -->
|
|
io__write_string("MR_declare_entry("),
|
|
output_label(exported(ProcLabel)),
|
|
io__write_string(");\n").
|
|
output_label_as_code_addr_decls(local(ProcLabel)) -->
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
( { SplitFiles = no } ->
|
|
[]
|
|
;
|
|
io__write_string("MR_declare_entry("),
|
|
output_label(local(ProcLabel)),
|
|
io__write_string(");\n")
|
|
).
|
|
output_label_as_code_addr_decls(c_local(_)) --> [].
|
|
output_label_as_code_addr_decls(local(_, _)) --> [].
|
|
|
|
output_data_addr_decls(DataAddr, FirstIndent, LaterIndent, N0, N,
|
|
DeclSet0, DeclSet) -->
|
|
( { decl_set_is_member(data_addr(DataAddr), DeclSet0) } ->
|
|
{ N = N0 },
|
|
{ DeclSet = DeclSet0 }
|
|
;
|
|
{ decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) },
|
|
output_data_addr_decls_2(DataAddr,
|
|
FirstIndent, LaterIndent, N0, N)
|
|
).
|
|
|
|
:- pred output_data_addr_decls_2(data_addr::in, string::in, string::in,
|
|
int::in, int::out, io__state::di, io__state::uo) is det.
|
|
|
|
output_data_addr_decls_2(DataAddr, FirstIndent, LaterIndent, N0, N) -->
|
|
output_indent(FirstIndent, LaterIndent, N0),
|
|
{ N = N0 + 1 },
|
|
(
|
|
{ DataAddr = data_addr(ModuleName, DataVarName) },
|
|
output_data_addr_storage_type_name(ModuleName, DataVarName, no,
|
|
LaterIndent)
|
|
;
|
|
{ DataAddr = rtti_addr(RttiTypector, RttiVarName) },
|
|
output_rtti_addr_storage_type_name(RttiTypector, RttiVarName,
|
|
no)
|
|
;
|
|
{ DataAddr = layout_addr(LayoutName) },
|
|
output_layout_name_storage_type_name(LayoutName, no)
|
|
),
|
|
io__write_string(";\n").
|
|
|
|
output_data_addrs_decls([], _, _, N, N, DeclSet, DeclSet) --> [].
|
|
output_data_addrs_decls([DataAddr | DataAddrs], FirstIndent, LaterIndent,
|
|
N0, N, DeclSet0, DeclSet) -->
|
|
output_data_addr_decls(DataAddr, FirstIndent, LaterIndent, N0, N1,
|
|
DeclSet0, DeclSet1),
|
|
output_data_addrs_decls(DataAddrs, FirstIndent, LaterIndent, N1, N,
|
|
DeclSet1, DeclSet).
|
|
|
|
c_data_linkage_string(Globals, DefaultLinkage, StaticEvenIfSplit, BeingDefined)
|
|
= LinkageStr :-
|
|
globals__lookup_bool_option(Globals, split_c_files, SplitFiles),
|
|
(
|
|
( DefaultLinkage = extern
|
|
; SplitFiles = yes, StaticEvenIfSplit = no
|
|
)
|
|
->
|
|
(
|
|
BeingDefined = yes,
|
|
LinkageStr = ""
|
|
;
|
|
BeingDefined = no,
|
|
LinkageStr = "extern "
|
|
)
|
|
;
|
|
%
|
|
% Previously we used to always write `extern' here, but
|
|
% declaring something `extern' and then later defining it as
|
|
% `static' causes undefined behavior -- on many systems, it
|
|
% works, but on some systems such as RS/6000s running AIX
|
|
% it results in link errors.
|
|
%
|
|
LinkageStr = "static "
|
|
).
|
|
|
|
c_data_const_string(Globals, InclCodeAddr, ConstStr) :-
|
|
(
|
|
InclCodeAddr = yes,
|
|
globals__have_static_code_addresses(Globals, no)
|
|
->
|
|
ConstStr = ""
|
|
;
|
|
ConstStr = "const "
|
|
).
|
|
|
|
% This predicate outputs the storage class, type and name
|
|
% of the variable specified by the first two arguments.
|
|
% The third argument should be true if the variable is being
|
|
% defined, and false if it is only being declared (since the
|
|
% storage class "extern" is needed only on declarations).
|
|
|
|
:- pred output_data_addr_storage_type_name(module_name::in, data_name::in,
|
|
bool::in, string::in, io__state::di, io__state::uo) is det.
|
|
|
|
output_data_addr_storage_type_name(ModuleName, DataVarName, BeingDefined,
|
|
LaterIndent) -->
|
|
( { DataVarName = base_typeclass_info(ClassId, Instance) } ->
|
|
output_base_typeclass_info_storage_type_name(
|
|
ModuleName, ClassId, Instance, no)
|
|
;
|
|
{ data_name_linkage(DataVarName, Linkage) },
|
|
globals__io_get_globals(Globals),
|
|
{ LinkageStr = c_data_linkage_string(Globals, Linkage,
|
|
no, BeingDefined) },
|
|
io__write_string(LinkageStr),
|
|
|
|
{ InclCodeAddr =
|
|
data_name_would_include_code_address(DataVarName) },
|
|
{ c_data_const_string(Globals, InclCodeAddr, ConstStr) },
|
|
io__write_string(ConstStr),
|
|
|
|
io__write_string("struct "),
|
|
output_data_addr(ModuleName, DataVarName),
|
|
io__write_string("_struct\n"),
|
|
io__write_string(LaterIndent),
|
|
io__write_string("\t"),
|
|
output_data_addr(ModuleName, DataVarName)
|
|
).
|
|
|
|
:- pred data_name_linkage(data_name::in, linkage::out) is det.
|
|
|
|
data_name_linkage(common(_), static).
|
|
data_name_linkage(base_typeclass_info(_, _), extern).
|
|
data_name_linkage(tabling_pointer(_), static).
|
|
data_name_linkage(deep_profiling_procedure_data(_), static).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_indent(string, string, int, io__state, io__state).
|
|
:- mode output_indent(in, in, in, di, uo) is det.
|
|
|
|
output_indent(FirstIndent, LaterIndent, N0) -->
|
|
( { N0 > 0 } ->
|
|
io__write_string(LaterIndent)
|
|
;
|
|
io__write_string(FirstIndent)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred maybe_output_update_prof_counter(label,
|
|
pair(label, bintree_set(label)), io__state, io__state).
|
|
:- mode maybe_output_update_prof_counter(in, in, di, uo) is det.
|
|
|
|
maybe_output_update_prof_counter(Label, CallerLabel - ContLabelSet) -->
|
|
(
|
|
{ bintree_set__is_member(Label, ContLabelSet) }
|
|
->
|
|
io__write_string("\tMR_update_prof_current_proc(MR_LABEL("),
|
|
output_label(CallerLabel),
|
|
io__write_string("));\n")
|
|
;
|
|
[]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_goto(code_addr, label, io__state, io__state).
|
|
:- mode output_goto(in, in, di, uo) is det.
|
|
|
|
% Note that we do some optimization here:
|
|
% instead of always outputting `MR_GOTO(<label>)', we
|
|
% output different things for each different kind of label.
|
|
|
|
output_goto(label(Label), CallerLabel) -->
|
|
(
|
|
{ Label = exported(_) },
|
|
io__write_string("MR_tailcall("),
|
|
output_label_as_code_addr(Label),
|
|
io__write_string(",\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n")
|
|
;
|
|
{ Label = local(_) },
|
|
io__write_string("MR_tailcall("),
|
|
output_label_as_code_addr(Label),
|
|
io__write_string(",\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n")
|
|
;
|
|
{ Label = c_local(_) },
|
|
io__write_string("MR_localtailcall("),
|
|
output_label(Label),
|
|
io__write_string(",\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n")
|
|
;
|
|
{ Label = local(_, _) },
|
|
io__write_string("MR_GOTO_LABEL("),
|
|
output_label(Label),
|
|
io__write_string(");\n")
|
|
).
|
|
output_goto(imported(ProcLabel), CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY("),
|
|
output_proc_label(ProcLabel),
|
|
io__write_string("),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(succip, _) -->
|
|
io__write_string("MR_proceed();\n").
|
|
output_goto(do_succeed(Last), _) -->
|
|
(
|
|
{ Last = no },
|
|
io__write_string("MR_succeed();\n")
|
|
;
|
|
{ Last = yes },
|
|
io__write_string("MR_succeed_discard();\n")
|
|
).
|
|
output_goto(do_redo, _) -->
|
|
globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
|
|
(
|
|
{ UseMacro = yes },
|
|
io__write_string("MR_redo();\n")
|
|
;
|
|
{ UseMacro = no },
|
|
io__write_string("MR_GOTO(MR_ENTRY(MR_do_redo));\n")
|
|
).
|
|
output_goto(do_fail, _) -->
|
|
globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
|
|
(
|
|
{ UseMacro = yes },
|
|
io__write_string("MR_fail();\n")
|
|
;
|
|
{ UseMacro = no },
|
|
io__write_string("MR_GOTO(MR_ENTRY(MR_do_fail));\n")
|
|
).
|
|
output_goto(do_trace_redo_fail_shallow, _) -->
|
|
io__write_string("MR_GOTO(MR_ENTRY(MR_do_trace_redo_fail_shallow));\n").
|
|
output_goto(do_trace_redo_fail_deep, _) -->
|
|
io__write_string("MR_GOTO(MR_ENTRY(MR_do_trace_redo_fail_deep));\n").
|
|
output_goto(do_call_closure, CallerLabel) -->
|
|
% see comment in output_call for why we use `noprof_' etc. here
|
|
io__write_string("MR_set_prof_ho_caller_proc("),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n\t\t"),
|
|
io__write_string(
|
|
"MR_noprof_tailcall(MR_ENTRY(mercury__do_call_closure));\n").
|
|
output_goto(do_call_class_method, CallerLabel) -->
|
|
% see comment in output_call for why we use `noprof_' etc. here
|
|
io__write_string("MR_set_prof_ho_caller_proc("),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n\t\t"),
|
|
io__write_string(
|
|
"MR_noprof_tailcall(MR_ENTRY(mercury__do_call_class_method));\n").
|
|
% XXX The do_*_aditi_call and do_aditi_* entry point names
|
|
% should start with an `MADITI_' prefix.
|
|
output_goto(do_det_aditi_call, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_det_aditi_call),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_semidet_aditi_call, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_semidet_aditi_call),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_nondet_aditi_call, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_nondet_aditi_call),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_aditi_insert, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_aditi_insert),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_aditi_delete, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_aditi_delete),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_aditi_bulk_insert, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_aditi_bulk_insert),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_aditi_bulk_delete, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_aditi_bulk_delete),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_aditi_bulk_modify, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(do_aditi_bulk_modify),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
output_goto(do_not_reached, CallerLabel) -->
|
|
io__write_string("MR_tailcall(MR_ENTRY(MR_do_not_reached),\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n").
|
|
|
|
% Note that we also do some optimization here by
|
|
% outputting `localcall' rather than `call' for
|
|
% calls to local labels, or `call_localret' for
|
|
% calls which return to local labels (i.e. most of them).
|
|
|
|
:- pred output_call(code_addr, code_addr, label, io__state, io__state).
|
|
:- mode output_call(in, in, in, di, uo) is det.
|
|
|
|
output_call(Target, Continuation, CallerLabel) -->
|
|
io__write_string("\t"),
|
|
% For profiling, we ignore calls to do_call_closure
|
|
% and do_call_class_method, because in general they
|
|
% lead to cycles in the call graph that screw up the
|
|
% profile. By generating a `noprof_call' rather than
|
|
% a `call', we ensure that time spent inside those
|
|
% routines is credited to the caller, rather than to
|
|
% do_call_closure or do_call_class_method itself.
|
|
% But if we do use a noprof_call, we need to set
|
|
% MR_prof_ho_caller_proc, so that the callee knows
|
|
% which proc it has been called from.
|
|
(
|
|
{ Target = do_call_closure
|
|
; Target = do_call_class_method
|
|
}
|
|
->
|
|
{ ProfileCall = no },
|
|
io__write_string("MR_set_prof_ho_caller_proc("),
|
|
output_label_as_code_addr(CallerLabel),
|
|
io__write_string(");\n\t"),
|
|
io__write_string("MR_noprof_")
|
|
;
|
|
{ ProfileCall = yes },
|
|
io__write_string("MR_")
|
|
),
|
|
(
|
|
{ Target = label(Label) },
|
|
% We really shouldn't be calling internal labels ...
|
|
{ Label = c_local(_) ; Label = local(_, _) }
|
|
->
|
|
io__write_string("localcall("),
|
|
output_label(Label),
|
|
io__write_string(",\n\t\t"),
|
|
output_code_addr(Continuation)
|
|
;
|
|
{ Continuation = label(ContLabel) },
|
|
{ ContLabel = c_local(_) ; ContLabel = local(_, _) }
|
|
->
|
|
io__write_string("call_localret("),
|
|
output_code_addr(Target),
|
|
io__write_string(",\n\t\t"),
|
|
output_label(ContLabel)
|
|
;
|
|
io__write_string("call("),
|
|
output_code_addr(Target),
|
|
io__write_string(",\n\t\t"),
|
|
output_code_addr(Continuation)
|
|
),
|
|
( { ProfileCall = yes } ->
|
|
io__write_string(",\n\t\t"),
|
|
output_label_as_code_addr(CallerLabel)
|
|
;
|
|
[]
|
|
),
|
|
io__write_string(");\n").
|
|
|
|
output_code_addr(label(Label)) -->
|
|
output_label_as_code_addr(Label).
|
|
output_code_addr(imported(ProcLabel)) -->
|
|
io__write_string("MR_ENTRY("),
|
|
output_proc_label(ProcLabel),
|
|
io__write_string(")").
|
|
output_code_addr(succip) -->
|
|
io__write_string("MR_succip").
|
|
output_code_addr(do_succeed(Last)) -->
|
|
(
|
|
{ Last = no },
|
|
io__write_string("MR_ENTRY(MR_do_succeed)")
|
|
;
|
|
{ Last = yes },
|
|
io__write_string("MR_ENTRY(MR_do_last_succeed)")
|
|
).
|
|
output_code_addr(do_redo) -->
|
|
io__write_string("MR_ENTRY(MR_do_redo)").
|
|
output_code_addr(do_fail) -->
|
|
io__write_string("MR_ENTRY(MR_do_fail)").
|
|
output_code_addr(do_trace_redo_fail_shallow) -->
|
|
io__write_string("MR_ENTRY(MR_do_trace_redo_fail_shallow)").
|
|
output_code_addr(do_trace_redo_fail_deep) -->
|
|
io__write_string("MR_ENTRY(MR_do_trace_redo_fail_deep)").
|
|
output_code_addr(do_call_closure) -->
|
|
io__write_string("MR_ENTRY(mercury__do_call_closure)").
|
|
output_code_addr(do_call_class_method) -->
|
|
io__write_string("MR_ENTRY(mercury__do_call_class_method)").
|
|
output_code_addr(do_det_aditi_call) -->
|
|
io__write_string("MR_ENTRY(do_det_aditi_call)").
|
|
output_code_addr(do_semidet_aditi_call) -->
|
|
io__write_string("MR_ENTRY(do_semidet_aditi_call)").
|
|
output_code_addr(do_nondet_aditi_call) -->
|
|
io__write_string("MR_ENTRY(do_nondet_aditi_call)").
|
|
output_code_addr(do_aditi_insert) -->
|
|
io__write_string("MR_ENTRY(do_aditi_insert)").
|
|
output_code_addr(do_aditi_delete) -->
|
|
io__write_string("MR_ENTRY(do_aditi_delete)").
|
|
output_code_addr(do_aditi_bulk_insert) -->
|
|
io__write_string("MR_ENTRY(do_aditi_bulk_insert)").
|
|
output_code_addr(do_aditi_bulk_delete) -->
|
|
io__write_string("MR_ENTRY(do_aditi_bulk_delete)").
|
|
output_code_addr(do_aditi_bulk_modify) -->
|
|
io__write_string("MR_ENTRY(do_aditi_bulk_modify)").
|
|
output_code_addr(do_not_reached) -->
|
|
io__write_string("MR_ENTRY(MR_do_not_reached)").
|
|
|
|
% Output a maybe data address, with a `no' meaning NULL.
|
|
|
|
:- pred output_maybe_data_addr(maybe(data_addr)::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_maybe_data_addr(MaybeDataAddr) -->
|
|
(
|
|
{ MaybeDataAddr = yes(DataAddr) },
|
|
output_data_addr(DataAddr)
|
|
;
|
|
{ MaybeDataAddr = no },
|
|
io__write_string("NULL")
|
|
).
|
|
|
|
% Output a list of maybe data addresses, with a `no' meaning NULL.
|
|
|
|
:- pred output_maybe_data_addrs(list(maybe(data_addr))::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_maybe_data_addrs([]) --> [].
|
|
output_maybe_data_addrs([MaybeDataAddr | MaybeDataAddrs]) -->
|
|
io__write_string("\t"),
|
|
io__write_list([MaybeDataAddr | MaybeDataAddrs], ",\n\t",
|
|
output_maybe_data_addr),
|
|
io__write_string("\n").
|
|
|
|
% Output a list of data addresses.
|
|
|
|
:- pred output_data_addrs(list(data_addr)::in, io__state::di, io__state::uo)
|
|
is det.
|
|
|
|
output_data_addrs([]) --> [].
|
|
output_data_addrs([DataAddr | DataAddrs]) -->
|
|
io__write_string("\t"),
|
|
io__write_list([DataAddr | DataAddrs], ",\n\t",
|
|
output_data_addr),
|
|
io__write_string("\n").
|
|
|
|
% Output a data address.
|
|
|
|
output_data_addr(data_addr(ModuleName, DataName)) -->
|
|
output_data_addr(ModuleName, DataName).
|
|
output_data_addr(rtti_addr(RttiTypeCtor, RttiName)) -->
|
|
output_rtti_addr(RttiTypeCtor, RttiName).
|
|
output_data_addr(layout_addr(LayoutName)) -->
|
|
output_layout_name(LayoutName).
|
|
|
|
mercury_data_prefix = "mercury_data_".
|
|
|
|
:- pred output_data_addr(module_name::in, data_name::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
output_data_addr(ModuleName, VarName) -->
|
|
(
|
|
{ VarName = common(N) },
|
|
{ llds_out__sym_name_mangle(ModuleName, MangledModuleName) },
|
|
io__write_string(mercury_data_prefix),
|
|
io__write_string(MangledModuleName),
|
|
io__write_string("__common_"),
|
|
{ string__int_to_string(N, NStr) },
|
|
io__write_string(NStr)
|
|
;
|
|
% We don't want to include the module name as part
|
|
% of the name if it is a base_typeclass_info, since
|
|
% we _want_ to cause a link error for overlapping
|
|
% instance decls, even if they are in a different
|
|
% module
|
|
{ VarName = base_typeclass_info(ClassId, TypeNames) },
|
|
output_base_typeclass_info_name(ClassId, TypeNames)
|
|
;
|
|
{ VarName = tabling_pointer(ProcLabel) },
|
|
output_tabling_pointer_var_name(ProcLabel)
|
|
;
|
|
{ VarName = deep_profiling_procedure_data(ProcLabel) },
|
|
io__write_string(mercury_data_prefix),
|
|
io__write_string("_deep_profiling_data__"),
|
|
output_proc_label(ProcLabel)
|
|
).
|
|
|
|
:- pred output_label_as_code_addr(label, io__state, io__state).
|
|
:- mode output_label_as_code_addr(in, di, uo) is det.
|
|
|
|
output_label_as_code_addr(exported(ProcLabel)) -->
|
|
io__write_string("MR_ENTRY("),
|
|
output_label(exported(ProcLabel)),
|
|
io__write_string(")").
|
|
output_label_as_code_addr(local(ProcLabel)) -->
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
( { SplitFiles = no } ->
|
|
io__write_string("MR_STATIC("),
|
|
output_label(local(ProcLabel)),
|
|
io__write_string(")")
|
|
;
|
|
io__write_string("MR_ENTRY("),
|
|
output_label(local(ProcLabel)),
|
|
io__write_string(")")
|
|
).
|
|
output_label_as_code_addr(c_local(ProcLabel)) -->
|
|
io__write_string("MR_LABEL("),
|
|
output_label(c_local(ProcLabel)),
|
|
io__write_string(")").
|
|
output_label_as_code_addr(local(N, ProcLabel)) -->
|
|
io__write_string("MR_LABEL("),
|
|
output_label(local(N, ProcLabel)),
|
|
io__write_string(")").
|
|
|
|
:- pred output_label_list(list(label), io__state, io__state).
|
|
:- mode output_label_list(in, di, uo) is det.
|
|
|
|
output_label_list([]) --> [].
|
|
output_label_list([Label | Labels]) -->
|
|
io__write_string("MR_LABEL("),
|
|
output_label(Label),
|
|
io__write_string(")"),
|
|
output_label_list_2(Labels).
|
|
|
|
:- pred output_label_list_2(list(label), io__state, io__state).
|
|
:- mode output_label_list_2(in, di, uo) is det.
|
|
|
|
output_label_list_2([]) --> [].
|
|
output_label_list_2([Label | Labels]) -->
|
|
io__write_string(" MR_AND\n\t\t"),
|
|
io__write_string("MR_LABEL("),
|
|
output_label(Label),
|
|
io__write_string(")"),
|
|
output_label_list_2(Labels).
|
|
|
|
:- pred output_label_defn(label, io__state, io__state).
|
|
:- mode output_label_defn(in, di, uo) is det.
|
|
|
|
output_label_defn(exported(ProcLabel)) -->
|
|
io__write_string("MR_define_entry("),
|
|
output_label(exported(ProcLabel)),
|
|
io__write_string(");\n").
|
|
output_label_defn(local(ProcLabel)) -->
|
|
% The code for procedures local to a Mercury module
|
|
% should normally be visible only within the C file
|
|
% generated for that module. However, if we generate
|
|
% multiple C files, the code in each C file must be
|
|
% visible to the other C files for that Mercury module.
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
( { SplitFiles = no } ->
|
|
io__write_string("MR_define_static("),
|
|
output_label(local(ProcLabel)),
|
|
io__write_string(");\n")
|
|
;
|
|
io__write_string("MR_define_entry("),
|
|
output_label(local(ProcLabel)),
|
|
io__write_string(");\n")
|
|
).
|
|
output_label_defn(c_local(ProcLabel)) -->
|
|
io__write_string("MR_define_local("),
|
|
output_label(c_local(ProcLabel)),
|
|
io__write_string(");\n").
|
|
output_label_defn(local(Num, ProcLabel)) -->
|
|
io__write_string("MR_define_label("),
|
|
output_label(local(Num, ProcLabel)),
|
|
io__write_string(");\n").
|
|
|
|
% Note that the suffixes _l and _iN used to be interpreted by mod2c,
|
|
% which generated different code depending on the suffix.
|
|
% We don't generate the _l suffix anymore, since it interferes
|
|
% with referring to a label both as local(_) and c_local(_).
|
|
% For example, the entry label of a recursive unification predicate
|
|
% is referred to as local(_) in type_info structures and as c_local(_)
|
|
% in the recursive call.
|
|
|
|
output_label(Label) -->
|
|
{ llds_out__get_label(Label, yes, LabelStr) },
|
|
io__write_string(LabelStr).
|
|
|
|
output_proc_label(ProcLabel) -->
|
|
{ llds_out__get_proc_label(ProcLabel, yes, ProcLabelString) },
|
|
io__write_string(ProcLabelString).
|
|
|
|
llds_out__get_label(exported(ProcLabel), AddPrefix, ProcLabelStr) :-
|
|
llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr).
|
|
llds_out__get_label(local(ProcLabel), AddPrefix, ProcLabelStr) :-
|
|
llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr).
|
|
llds_out__get_label(c_local(ProcLabel), AddPrefix, ProcLabelStr) :-
|
|
llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr).
|
|
llds_out__get_label(local(Num, ProcLabel), AddPrefix, LabelStr) :-
|
|
llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr),
|
|
string__int_to_string(Num, NumStr),
|
|
string__append("_i", NumStr, NumSuffix),
|
|
string__append(ProcLabelStr, NumSuffix, LabelStr).
|
|
|
|
%
|
|
% Warning: any changes to the name mangling algorithm here will also
|
|
% require changes to extras/dynamic_linking/name_mangle.m,
|
|
% profiler/demangle.m and util/mdemangle.c.
|
|
%
|
|
llds_out__get_proc_label(proc(DefiningModule, PredOrFunc, PredModule,
|
|
PredName, Arity, ModeNum0), AddPrefix, ProcLabelString) :-
|
|
get_label_name(DefiningModule, PredOrFunc, PredModule,
|
|
PredName, Arity, AddPrefix, LabelName),
|
|
( PredOrFunc = function ->
|
|
OrigArity = Arity - 1
|
|
;
|
|
OrigArity = Arity
|
|
),
|
|
string__int_to_string(OrigArity, ArityString),
|
|
proc_id_to_int(ModeNum0, ModeInt),
|
|
string__int_to_string(ModeInt, ModeNumString),
|
|
string__append_list([LabelName, "_", ArityString, "_", ModeNumString],
|
|
ProcLabelString).
|
|
|
|
% For a special proc, output a label of the form:
|
|
% mercury____<PredName>___<TypeModule>__<TypeName>_<TypeArity>_<Mode>
|
|
llds_out__get_proc_label(special_proc(Module, PredName, TypeModule,
|
|
TypeName, TypeArity, ModeNum0), AddPrefix, ProcLabelString) :-
|
|
% figure out the LabelName
|
|
DummyArity = -1, % not used by get_label_name.
|
|
get_label_name(unqualified(""), predicate, unqualified(""),
|
|
PredName, DummyArity, AddPrefix, LabelName),
|
|
|
|
% figure out the ModeNumString
|
|
string__int_to_string(TypeArity, TypeArityString),
|
|
proc_id_to_int(ModeNum0, ModeInt),
|
|
string__int_to_string(ModeInt, ModeNumString),
|
|
|
|
% mangle all the relevent names
|
|
llds_out__sym_name_mangle(Module, MangledModule),
|
|
llds_out__sym_name_mangle(TypeModule, MangledTypeModule),
|
|
llds_out__name_mangle(TypeName, MangledTypeName),
|
|
|
|
% Module-qualify the type name.
|
|
% To handle locally produced unification preds for imported types,
|
|
% we need to qualify it with both the module name of the
|
|
% type, and also (if it is different) the module name of the
|
|
% current module.
|
|
llds_out__qualify_name(MangledTypeModule, MangledTypeName,
|
|
QualifiedMangledTypeName),
|
|
llds_out__maybe_qualify_name(MangledModule, QualifiedMangledTypeName,
|
|
FullyQualifiedMangledTypeName),
|
|
|
|
% join it all together
|
|
string__append_list( [LabelName, "_", FullyQualifiedMangledTypeName,
|
|
"_", TypeArityString, "_", ModeNumString],
|
|
ProcLabelString).
|
|
|
|
% get a label name, given the defining module, predicate or
|
|
% function indicator, declaring module, predicate name, arity,
|
|
% and whether or not to add a prefix.
|
|
|
|
:- pred get_label_name(module_name, pred_or_func, module_name, string, arity,
|
|
bool, string).
|
|
:- mode get_label_name(in, in, in, in, in, in, out) is det.
|
|
|
|
%
|
|
% Warning: any changes to the name mangling algorithm here will also
|
|
% require changes to extras/dynamic_linking/name_mangle.m,
|
|
% profiler/demangle.m and util/mdemangle.c.
|
|
%
|
|
get_label_name(DefiningModule, PredOrFunc, DeclaringModule,
|
|
Name0, Arity, AddPrefix, LabelName) :-
|
|
llds_out__sym_name_mangle(DeclaringModule, DeclaringModuleName),
|
|
llds_out__sym_name_mangle(DefiningModule, DefiningModuleName),
|
|
(
|
|
(
|
|
mercury_private_builtin_module(DeclaringModule)
|
|
;
|
|
mercury_public_builtin_module(DeclaringModule)
|
|
;
|
|
Name0 = "main",
|
|
Arity = 2
|
|
;
|
|
string__prefix(Name0, "__")
|
|
)
|
|
% The conditions above define which labels are printed without
|
|
% module qualification. XXX Changes to runtime/* are necessary
|
|
% to allow `builtin' or `private_builtin' labels to be
|
|
% qualified.
|
|
->
|
|
LabelName0 = Name0
|
|
;
|
|
llds_out__qualify_name(DeclaringModuleName, Name0,
|
|
LabelName0)
|
|
),
|
|
(
|
|
% if this is a specialized version of a predicate
|
|
% defined in some other module, then it needs both
|
|
% module prefixes
|
|
DefiningModule \= DeclaringModule
|
|
->
|
|
string__append_list([DefiningModuleName, "__", LabelName0],
|
|
LabelName1)
|
|
;
|
|
LabelName1 = LabelName0
|
|
),
|
|
llds_out__name_mangle(LabelName1, LabelName2),
|
|
(
|
|
PredOrFunc = function,
|
|
string__append("fn__", LabelName2, LabelName3)
|
|
;
|
|
PredOrFunc = predicate,
|
|
LabelName3 = LabelName2
|
|
),
|
|
(
|
|
AddPrefix = yes
|
|
->
|
|
get_label_prefix(Prefix),
|
|
string__append(Prefix, LabelName3, LabelName)
|
|
;
|
|
LabelName = LabelName3
|
|
).
|
|
|
|
% To ensure that Mercury labels don't clash with C symbols, we
|
|
% prefix them with `mercury__'.
|
|
|
|
:- pred get_label_prefix(string).
|
|
:- mode get_label_prefix(out) is det.
|
|
|
|
get_label_prefix("mercury__").
|
|
|
|
:- pred output_reg(reg_type, int, io__state, io__state).
|
|
:- mode output_reg(in, in, di, uo) is det.
|
|
|
|
output_reg(r, N) -->
|
|
{ llds_out__reg_to_string(r, N, RegName) },
|
|
io__write_string(RegName).
|
|
output_reg(f, _) -->
|
|
{ error("Floating point registers not implemented") }.
|
|
|
|
:- pred output_tag(tag, io__state, io__state).
|
|
:- mode output_tag(in, di, uo) is det.
|
|
|
|
output_tag(Tag) -->
|
|
io__write_string("MR_mktag("),
|
|
io__write_int(Tag),
|
|
io__write_string(")").
|
|
|
|
% output an rval, converted to the specified type
|
|
%
|
|
:- pred output_rval_as_type(rval, llds_type, io__state, io__state).
|
|
:- mode output_rval_as_type(in, in, di, uo) is det.
|
|
|
|
output_rval_as_type(Rval, DesiredType) -->
|
|
{ llds__rval_type(Rval, ActualType) },
|
|
( { types_match(DesiredType, ActualType) } ->
|
|
% no casting needed
|
|
output_rval(Rval)
|
|
;
|
|
% We need to convert to the right type first.
|
|
% Convertions to/from float must be treated specially;
|
|
% for the others, we can just use a cast.
|
|
( { DesiredType = float } ->
|
|
io__write_string("MR_word_to_float("),
|
|
output_rval(Rval),
|
|
io__write_string(")")
|
|
; { ActualType = float } ->
|
|
( { DesiredType = word } ->
|
|
output_float_rval_as_word(Rval)
|
|
; { DesiredType = data_ptr } ->
|
|
output_float_rval_as_data_ptr(Rval)
|
|
;
|
|
{ error("output_rval_as_type: type error") }
|
|
)
|
|
;
|
|
% cast value to desired type
|
|
output_llds_type_cast(DesiredType),
|
|
output_rval(Rval)
|
|
)
|
|
).
|
|
|
|
% types_match(DesiredType, ActualType) is true iff
|
|
% a value of type ActualType can be used as a value of
|
|
% type DesiredType without casting.
|
|
%
|
|
:- pred types_match(llds_type, llds_type).
|
|
:- mode types_match(in, in) is semidet.
|
|
|
|
types_match(Type, Type).
|
|
types_match(word, unsigned).
|
|
types_match(word, integer).
|
|
types_match(word, bool).
|
|
types_match(bool, integer).
|
|
types_match(bool, unsigned).
|
|
types_match(bool, word).
|
|
types_match(integer, bool).
|
|
|
|
% output a float rval, converted to type `MR_Word *'
|
|
%
|
|
:- pred output_float_rval_as_data_ptr(rval, io__state, io__state).
|
|
:- mode output_float_rval_as_data_ptr(in, di, uo) is det.
|
|
|
|
output_float_rval_as_data_ptr(Rval) -->
|
|
%
|
|
% for float constant expressions, if we're using boxed
|
|
% boxed floats and --static-ground-terms is enabled,
|
|
% we just refer to the static const which we declared
|
|
% earlier
|
|
%
|
|
globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
|
|
globals__io_lookup_bool_option(static_ground_terms, StaticGroundTerms),
|
|
(
|
|
{ UnboxFloat = no, StaticGroundTerms = yes },
|
|
{ llds_out__float_const_expr_name(Rval, FloatName) }
|
|
->
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("&mercury_float_const_"),
|
|
io__write_string(FloatName)
|
|
;
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("MR_float_to_word("),
|
|
output_rval(Rval),
|
|
io__write_string(")")
|
|
).
|
|
|
|
% output a float rval, converted to type `MR_Word'
|
|
%
|
|
:- pred output_float_rval_as_word(rval, io__state, io__state).
|
|
:- mode output_float_rval_as_word(in, di, uo) is det.
|
|
|
|
output_float_rval_as_word(Rval) -->
|
|
%
|
|
% for float constant expressions, if we're using boxed
|
|
% boxed floats and --static-ground-terms is enabled,
|
|
% we just refer to the static const which we declared
|
|
% earlier
|
|
%
|
|
globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
|
|
globals__io_lookup_bool_option(static_ground_terms, StaticGroundTerms),
|
|
(
|
|
{ UnboxFloat = no, StaticGroundTerms = yes },
|
|
{ llds_out__float_const_expr_name(Rval, FloatName) }
|
|
->
|
|
output_llds_type_cast(word),
|
|
io__write_string("&mercury_float_const_"),
|
|
io__write_string(FloatName)
|
|
;
|
|
io__write_string("MR_float_to_word("),
|
|
output_rval(Rval),
|
|
io__write_string(")")
|
|
).
|
|
|
|
output_rval(const(Const)) -->
|
|
output_rval_const(Const).
|
|
output_rval(unop(UnaryOp, Exprn)) -->
|
|
output_unary_op(UnaryOp),
|
|
io__write_string("("),
|
|
{ llds__unop_arg_type(UnaryOp, ArgType) },
|
|
output_rval_as_type(Exprn, ArgType),
|
|
io__write_string(")").
|
|
output_rval(binop(Op, X, Y)) -->
|
|
(
|
|
{ Op = array_index(_Type) }
|
|
->
|
|
io__write_string("("),
|
|
output_rval_as_type(X, data_ptr),
|
|
io__write_string(")["),
|
|
output_rval_as_type(Y, integer),
|
|
io__write_string("]")
|
|
;
|
|
{ c_util__string_compare_op(Op, OpStr) }
|
|
->
|
|
io__write_string("(strcmp((char *)"),
|
|
output_rval_as_type(X, word),
|
|
io__write_string(", (char *)"),
|
|
output_rval_as_type(Y, word),
|
|
io__write_string(")"),
|
|
io__write_string(" "),
|
|
io__write_string(OpStr),
|
|
io__write_string(" "),
|
|
io__write_string("0)")
|
|
;
|
|
( { c_util__float_compare_op(Op, OpStr1) } ->
|
|
{ OpStr = OpStr1 }
|
|
; { c_util__float_op(Op, OpStr2) } ->
|
|
{ OpStr = OpStr2 }
|
|
;
|
|
{ fail }
|
|
)
|
|
->
|
|
io__write_string("("),
|
|
output_rval_as_type(X, float),
|
|
io__write_string(" "),
|
|
io__write_string(OpStr),
|
|
io__write_string(" "),
|
|
output_rval_as_type(Y, float),
|
|
io__write_string(")")
|
|
;
|
|
/****
|
|
XXX broken for C == minint
|
|
(since `NewC is 0 - C' overflows)
|
|
{ Op = (+) },
|
|
{ Y = const(int_const(C)) },
|
|
{ C < 0 }
|
|
->
|
|
{ NewOp = (-) },
|
|
{ NewC is 0 - C },
|
|
{ NewY = const(int_const(NewC)) },
|
|
io__write_string("("),
|
|
output_rval(X),
|
|
io__write_string(" "),
|
|
output_binary_op(NewOp),
|
|
io__write_string(" "),
|
|
output_rval(NewY),
|
|
io__write_string(")")
|
|
;
|
|
******/
|
|
% special-case equality ops to avoid some unnecessary
|
|
% casts -- there's no difference between signed and
|
|
% unsigned equality, so if both args are unsigned, we
|
|
% don't need to cast them to (Integer)
|
|
{ Op = eq ; Op = ne },
|
|
{ llds__rval_type(X, XType) },
|
|
{ XType = word ; XType = unsigned },
|
|
{ llds__rval_type(Y, YType) },
|
|
{ YType = word ; YType = unsigned }
|
|
->
|
|
io__write_string("("),
|
|
output_rval(X),
|
|
io__write_string(" "),
|
|
output_binary_op(Op),
|
|
io__write_string(" "),
|
|
output_rval(Y),
|
|
io__write_string(")")
|
|
;
|
|
{ c_util__unsigned_compare_op(Op, OpStr) }
|
|
->
|
|
io__write_string("("),
|
|
output_rval_as_type(X, unsigned),
|
|
io__write_string(" "),
|
|
io__write_string(OpStr),
|
|
io__write_string(" "),
|
|
output_rval_as_type(Y, unsigned),
|
|
io__write_string(")")
|
|
;
|
|
io__write_string("("),
|
|
output_rval_as_type(X, integer),
|
|
io__write_string(" "),
|
|
output_binary_op(Op),
|
|
io__write_string(" "),
|
|
output_rval_as_type(Y, integer),
|
|
io__write_string(")")
|
|
).
|
|
output_rval(mkword(Tag, Exprn)) -->
|
|
io__write_string("MR_mkword("),
|
|
output_tag(Tag),
|
|
io__write_string(", "),
|
|
output_rval_as_type(Exprn, data_ptr),
|
|
io__write_string(")").
|
|
output_rval(lval(Lval)) -->
|
|
% if a field is used as an rval, then we need to use
|
|
% the MR_const_field() macro, not the MR_field() macro,
|
|
% to avoid warnings about discarding const,
|
|
% and similarly for MR_mask_field.
|
|
( { Lval = field(MaybeTag, Rval, FieldNum) } ->
|
|
( { MaybeTag = yes(Tag) } ->
|
|
io__write_string("MR_const_field("),
|
|
output_tag(Tag),
|
|
io__write_string(", ")
|
|
;
|
|
io__write_string("MR_const_mask_field(")
|
|
),
|
|
output_rval(Rval),
|
|
io__write_string(", "),
|
|
output_rval(FieldNum),
|
|
io__write_string(")")
|
|
;
|
|
output_lval(Lval)
|
|
).
|
|
output_rval(create(Tag, _Args, _ArgTypes, _StatDyn, CellNum, _Msg, _Reuse)) -->
|
|
% emit a reference to the static constant which we
|
|
% declared in output_rval_decls.
|
|
io__write_string("MR_mkword(MR_mktag("),
|
|
io__write_int(Tag),
|
|
io__write_string("), "),
|
|
io__write_string("&mercury_const_"),
|
|
io__write_int(CellNum),
|
|
io__write_string(")").
|
|
output_rval(var(_)) -->
|
|
{ error("Cannot output a var(_) expression in code") }.
|
|
output_rval(mem_addr(MemRef)) -->
|
|
(
|
|
{ MemRef = stackvar_ref(N) },
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("&MR_stackvar("),
|
|
io__write_int(N),
|
|
io__write_string(")")
|
|
;
|
|
{ MemRef = framevar_ref(N) },
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("&MR_framevar("),
|
|
io__write_int(N),
|
|
io__write_string(")")
|
|
;
|
|
{ MemRef = heap_ref(Rval, Tag, FieldNum) },
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("&MR_field("),
|
|
output_tag(Tag),
|
|
io__write_string(", "),
|
|
output_rval(Rval),
|
|
io__write_string(", "),
|
|
io__write_int(FieldNum),
|
|
io__write_string(")")
|
|
).
|
|
|
|
:- pred output_unary_op(unary_op, io__state, io__state).
|
|
:- mode output_unary_op(in, di, uo) is det.
|
|
|
|
output_unary_op(Op) -->
|
|
{ c_util__unary_prefix_op(Op, OpString) },
|
|
io__write_string(OpString).
|
|
|
|
:- pred output_rval_const(rval_const, io__state, io__state).
|
|
:- mode output_rval_const(in, di, uo) is det.
|
|
|
|
output_rval_const(int_const(N)) -->
|
|
% we need to cast to (Integer) to ensure
|
|
% things like 1 << 32 work when `Integer' is 64 bits
|
|
% but `int' is 32 bits.
|
|
output_llds_type_cast(integer),
|
|
io__write_int(N).
|
|
output_rval_const(float_const(FloatVal)) -->
|
|
% the cast to (Float) here lets the C compiler
|
|
% do arithmetic in `float' rather than `double'
|
|
% if `Float' is `float' not `double'.
|
|
output_llds_type_cast(float),
|
|
c_util__output_float_literal(FloatVal).
|
|
output_rval_const(string_const(String)) -->
|
|
io__write_string("MR_string_const("""),
|
|
output_c_quoted_string(String),
|
|
{ string__length(String, StringLength) },
|
|
io__write_string(""", "),
|
|
io__write_int(StringLength),
|
|
io__write_string(")").
|
|
output_rval_const(multi_string_const(Length, String)) -->
|
|
io__write_string("MR_string_const("""),
|
|
output_c_quoted_multi_string(Length, String),
|
|
io__write_string(""", "),
|
|
io__write_int(Length),
|
|
io__write_string(")").
|
|
output_rval_const(true) -->
|
|
io__write_string("MR_TRUE").
|
|
output_rval_const(false) -->
|
|
io__write_string("MR_FALSE").
|
|
output_rval_const(code_addr_const(CodeAddress)) -->
|
|
output_code_addr(CodeAddress).
|
|
output_rval_const(data_addr_const(DataAddr)) -->
|
|
% data addresses are all assumed to be of type `MR_Word *';
|
|
% we need to cast them here to avoid type errors
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("&"),
|
|
output_data_addr(DataAddr).
|
|
output_rval_const(label_entry(Label)) -->
|
|
io__write_string("MR_ENTRY("),
|
|
output_label(Label),
|
|
io__write_string(")").
|
|
|
|
% Output an rval as an initializer in a static struct.
|
|
% Make sure it has the C type the corresponding field would have.
|
|
% This is the "really" natural type of the rval, free of the
|
|
% Mercury abstract engine's need to shoehorn things into MR_Words.
|
|
|
|
:- pred output_static_rval(rval, io__state, io__state).
|
|
:- mode output_static_rval(in, di, uo) is det.
|
|
|
|
output_static_rval(const(Const)) -->
|
|
output_rval_static_const(Const).
|
|
output_static_rval(unop(_, _)) -->
|
|
{ error("Cannot output a unop(_, _) in a static initializer") }.
|
|
output_static_rval(binop(_, _, _)) -->
|
|
{ error("Cannot output a binop(_, _, _) in a static initializer") }.
|
|
output_static_rval(mkword(Tag, Exprn)) -->
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("MR_mkword("),
|
|
output_tag(Tag),
|
|
io__write_string(", "),
|
|
output_static_rval(Exprn),
|
|
io__write_string(")").
|
|
output_static_rval(lval(_)) -->
|
|
{ error("Cannot output an lval(_) in a static initializer") }.
|
|
output_static_rval(
|
|
create(Tag, _Args, _ArgTypes, _StatDyn, CellNum, _Msg, _Reuse))
|
|
-->
|
|
% emit a reference to the static constant which we
|
|
% declared in output_rval_decls.
|
|
io__write_string("MR_mkword(MR_mktag("),
|
|
io__write_int(Tag),
|
|
io__write_string("), "),
|
|
io__write_string("&mercury_const_"),
|
|
io__write_int(CellNum),
|
|
io__write_string(")").
|
|
output_static_rval(var(_)) -->
|
|
{ error("Cannot output a var(_) in a static initializer") }.
|
|
output_static_rval(mem_addr(_)) -->
|
|
{ error("Cannot output a mem_ref(_) in a static initializer") }.
|
|
|
|
:- pred output_rval_static_const(rval_const, io__state, io__state).
|
|
:- mode output_rval_static_const(in, di, uo) is det.
|
|
|
|
output_rval_static_const(int_const(N)) -->
|
|
io__write_int(N).
|
|
output_rval_static_const(float_const(FloatVal)) -->
|
|
c_util__output_float_literal(FloatVal).
|
|
output_rval_static_const(string_const(String)) -->
|
|
io__write_string("MR_string_const("""),
|
|
output_c_quoted_string(String),
|
|
{ string__length(String, StringLength) },
|
|
io__write_string(""", "),
|
|
io__write_int(StringLength),
|
|
io__write_string(")").
|
|
output_rval_static_const(multi_string_const(Length, String)) -->
|
|
io__write_string("MR_string_const("""),
|
|
output_c_quoted_multi_string(Length, String),
|
|
io__write_string(""", "),
|
|
io__write_int(Length),
|
|
io__write_string(")").
|
|
output_rval_static_const(true) -->
|
|
io__write_string("MR_TRUE").
|
|
output_rval_static_const(false) -->
|
|
io__write_string("MR_FALSE").
|
|
output_rval_static_const(code_addr_const(CodeAddress)) -->
|
|
output_code_addr(CodeAddress).
|
|
output_rval_static_const(data_addr_const(DataAddr)) -->
|
|
output_llds_type_cast(data_ptr),
|
|
io__write_string("&"),
|
|
output_data_addr(DataAddr).
|
|
output_rval_static_const(label_entry(Label)) -->
|
|
io__write_string("MR_ENTRY("),
|
|
output_label(Label),
|
|
io__write_string(")").
|
|
|
|
:- pred output_lval_as_word(lval, io__state, io__state).
|
|
:- mode output_lval_as_word(in, di, uo) is det.
|
|
|
|
output_lval_as_word(Lval) -->
|
|
{ llds__lval_type(Lval, ActualType) },
|
|
( { types_match(word, ActualType) } ->
|
|
output_lval(Lval)
|
|
; { ActualType = float } ->
|
|
% sanity check -- if this happens, the llds is ill-typed
|
|
{ error("output_lval_as_word: got float") }
|
|
;
|
|
io__write_string("MR_LVALUE_CAST(MR_Word,"),
|
|
output_lval(Lval),
|
|
io__write_string(")")
|
|
).
|
|
|
|
:- pred output_lval(lval, io__state, io__state).
|
|
:- mode output_lval(in, di, uo) is det.
|
|
|
|
output_lval(reg(Type, Num)) -->
|
|
output_reg(Type, Num).
|
|
output_lval(stackvar(N)) -->
|
|
{ (N < 0) ->
|
|
error("stack var out of range")
|
|
;
|
|
true
|
|
},
|
|
io__write_string("MR_stackvar("),
|
|
io__write_int(N),
|
|
io__write_string(")").
|
|
output_lval(framevar(N)) -->
|
|
{ (N =< 0) ->
|
|
error("frame var out of range")
|
|
;
|
|
true
|
|
},
|
|
io__write_string("MR_framevar("),
|
|
io__write_int(N),
|
|
io__write_string(")").
|
|
output_lval(succip) -->
|
|
io__write_string("MR_succip").
|
|
output_lval(sp) -->
|
|
io__write_string("MR_sp").
|
|
output_lval(hp) -->
|
|
io__write_string("MR_hp").
|
|
output_lval(maxfr) -->
|
|
io__write_string("MR_maxfr").
|
|
output_lval(curfr) -->
|
|
io__write_string("MR_curfr").
|
|
output_lval(succfr(Rval)) -->
|
|
io__write_string("MR_succfr_slot("),
|
|
output_rval(Rval),
|
|
io__write_string(")").
|
|
output_lval(prevfr(Rval)) -->
|
|
io__write_string("MR_prevfr_slot("),
|
|
output_rval(Rval),
|
|
io__write_string(")").
|
|
output_lval(redofr(Rval)) -->
|
|
io__write_string("MR_redofr_slot("),
|
|
output_rval(Rval),
|
|
io__write_string(")").
|
|
output_lval(redoip(Rval)) -->
|
|
io__write_string("MR_redoip_slot("),
|
|
output_rval(Rval),
|
|
io__write_string(")").
|
|
output_lval(succip(Rval)) -->
|
|
io__write_string("MR_succip_slot("),
|
|
output_rval(Rval),
|
|
io__write_string(")").
|
|
output_lval(field(MaybeTag, Rval, FieldNum)) -->
|
|
( { MaybeTag = yes(Tag) } ->
|
|
io__write_string("MR_field("),
|
|
output_tag(Tag),
|
|
io__write_string(", ")
|
|
;
|
|
io__write_string("MR_mask_field(")
|
|
),
|
|
output_rval(Rval),
|
|
io__write_string(", "),
|
|
output_rval(FieldNum),
|
|
io__write_string(")").
|
|
output_lval(lvar(_)) -->
|
|
{ error("Illegal to output an lvar") }.
|
|
output_lval(temp(Type, Num)) -->
|
|
(
|
|
{ Type = r },
|
|
io__write_string("MR_tempr"),
|
|
io__write_int(Num)
|
|
;
|
|
{ Type = f },
|
|
io__write_string("MR_tempf"),
|
|
io__write_int(Num)
|
|
).
|
|
output_lval(mem_ref(Rval)) -->
|
|
io__write_string("XXX("),
|
|
output_rval(Rval),
|
|
io__write_string(")").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_set_line_num(prog_context, io__state, io__state).
|
|
:- mode output_set_line_num(in, di, uo) is det.
|
|
|
|
output_set_line_num(Context) -->
|
|
{ term__context_file(Context, File) },
|
|
{ term__context_line(Context, Line) },
|
|
c_util__set_line_num(File, Line).
|
|
|
|
:- pred output_reset_line_num(io__state, io__state).
|
|
:- mode output_reset_line_num(di, uo) is det.
|
|
|
|
output_reset_line_num -->
|
|
c_util__reset_line_num.
|
|
|
|
output_c_quoted_string(S) -->
|
|
c_util__output_quoted_string(S).
|
|
|
|
output_c_quoted_multi_string(Len, S) -->
|
|
c_util__output_quoted_multi_string(Len, S).
|
|
|
|
llds_out__quote_c_string(String, QuotedString) :-
|
|
c_util__quote_string(String, QuotedString).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_binary_op(binary_op, io__state, io__state).
|
|
:- mode output_binary_op(in, di, uo) is det.
|
|
|
|
output_binary_op(Op) -->
|
|
( { c_util__binary_infix_op(Op, String) } ->
|
|
io__write_string(String)
|
|
;
|
|
{ error("llds_out.m: invalid binary operator") }
|
|
).
|
|
|
|
llds_out__binary_op_to_string(Op, Name) :-
|
|
( c_util__binary_infix_op(Op, Name0) ->
|
|
Name = Name0
|
|
;
|
|
% The following is just for debugging purposes -
|
|
% string operators are not output as `str_eq', etc.
|
|
functor(Op, Name, _)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
llds_out__lval_to_string(framevar(N), Description) :-
|
|
string__int_to_string(N, N_String),
|
|
string__append("MR_framevar(", N_String, Tmp),
|
|
string__append(Tmp, ")", Description).
|
|
llds_out__lval_to_string(stackvar(N), Description) :-
|
|
string__int_to_string(N, N_String),
|
|
string__append("MR_stackvar(", N_String, Tmp),
|
|
string__append(Tmp, ")", Description).
|
|
llds_out__lval_to_string(reg(RegType, RegNum), Description) :-
|
|
llds_out__reg_to_string(RegType, RegNum, Reg_String),
|
|
string__append("reg(", Reg_String, Tmp),
|
|
string__append(Tmp, ")", Description).
|
|
|
|
llds_out__reg_to_string(r, N, Description) :-
|
|
( N > 32 ->
|
|
Template = "MR_r(%d)"
|
|
;
|
|
Template = "MR_r%d"
|
|
),
|
|
string__format(Template, [i(N)], Description).
|
|
llds_out__reg_to_string(f, N, Description) :-
|
|
string__int_to_string(N, N_String),
|
|
string__append("MR_f(", N_String, Tmp),
|
|
string__append(Tmp, ")", Description).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% Warning: any changes to the name mangling algorithm here will also
|
|
% require changes to extras/dynamic_linking/name_mangle.m,
|
|
% profiler/demangle.m and util/mdemangle.c.
|
|
%
|
|
|
|
llds_out__sym_name_mangle(unqualified(Name), MangledName) :-
|
|
llds_out__name_mangle(Name, MangledName).
|
|
llds_out__sym_name_mangle(qualified(ModuleName, PlainName), MangledName) :-
|
|
llds_out__sym_name_mangle(ModuleName, MangledModuleName),
|
|
llds_out__name_mangle(PlainName, MangledPlainName),
|
|
llds_out__qualify_name(MangledModuleName, MangledPlainName,
|
|
MangledName).
|
|
|
|
% Convert a Mercury predicate name into something that can form
|
|
% part of a C identifier. This predicate is necessary because
|
|
% quoted names such as 'name with embedded spaces' are valid
|
|
% predicate names in Mercury.
|
|
|
|
llds_out__name_mangle(Name, MangledName) :-
|
|
(
|
|
string__is_alnum_or_underscore(Name)
|
|
->
|
|
% any names that start with `f_' are changed so that
|
|
% they start with `f__', so that we can use names starting
|
|
% with `f_' (followed by anything except an underscore)
|
|
% without fear of name collisions
|
|
(
|
|
string__append("f_", Suffix, Name)
|
|
->
|
|
string__append("f__", Suffix, MangledName)
|
|
;
|
|
MangledName = Name
|
|
)
|
|
;
|
|
llds_out__convert_to_valid_c_identifier(Name, MangledName)
|
|
).
|
|
|
|
:- pred llds_out__convert_to_valid_c_identifier(string, string).
|
|
:- mode llds_out__convert_to_valid_c_identifier(in, out) is det.
|
|
|
|
llds_out__convert_to_valid_c_identifier(String, Name) :-
|
|
(
|
|
llds_out__name_conversion_table(String, Name0)
|
|
->
|
|
Name = Name0
|
|
;
|
|
llds_out__convert_to_valid_c_identifier_2(String, Name0),
|
|
string__append("f", Name0, Name)
|
|
).
|
|
|
|
llds_out__qualify_name(Module0, Name0, Name) :-
|
|
string__append_list([Module0, "__", Name0], Name).
|
|
|
|
% Produces a string of the form Module__Name, unless Module__
|
|
% is already a prefix of Name.
|
|
|
|
:- pred llds_out__maybe_qualify_name(string, string, string).
|
|
:- mode llds_out__maybe_qualify_name(in, in, out) is det.
|
|
|
|
llds_out__maybe_qualify_name(Module0, Name0, Name) :-
|
|
string__append(Module0, "__", UnderscoresModule),
|
|
( string__append(UnderscoresModule, _, Name0) ->
|
|
Name = Name0
|
|
;
|
|
string__append(UnderscoresModule, Name0, Name)
|
|
).
|
|
|
|
% A table used to convert Mercury functors into
|
|
% C identifiers. Feel free to add any new translations you want.
|
|
% The C identifiers should start with "f_",
|
|
% to avoid introducing name clashes.
|
|
% If the functor name is not found in the table, then
|
|
% we use a fall-back method which produces ugly names.
|
|
|
|
:- pred llds_out__name_conversion_table(string, string).
|
|
:- mode llds_out__name_conversion_table(in, out) is semidet.
|
|
|
|
llds_out__name_conversion_table("\\=", "f_not_equal").
|
|
llds_out__name_conversion_table(">=", "f_greater_or_equal").
|
|
llds_out__name_conversion_table("=<", "f_less_or_equal").
|
|
llds_out__name_conversion_table("=", "f_equal").
|
|
llds_out__name_conversion_table("<", "f_less_than").
|
|
llds_out__name_conversion_table(">", "f_greater_than").
|
|
llds_out__name_conversion_table("-", "f_minus").
|
|
llds_out__name_conversion_table("+", "f_plus").
|
|
llds_out__name_conversion_table("*", "f_times").
|
|
llds_out__name_conversion_table("/", "f_slash").
|
|
llds_out__name_conversion_table(",", "f_comma").
|
|
llds_out__name_conversion_table(";", "f_semicolon").
|
|
llds_out__name_conversion_table("!", "f_cut").
|
|
llds_out__name_conversion_table("{}", "f_tuple").
|
|
llds_out__name_conversion_table("[|]", "f_cons").
|
|
llds_out__name_conversion_table("[]", "f_nil").
|
|
|
|
% This is the fall-back method.
|
|
% Given a string, produce a C identifier
|
|
% for that string by concatenating the decimal
|
|
% expansions of the character codes in the string,
|
|
% separated by undellines.
|
|
% The C identifier will start with "f_"; this predicate
|
|
% constructs everything except the initial "f".
|
|
%
|
|
% For example, given the input "\n\t" we return "_10_8".
|
|
|
|
:- pred llds_out__convert_to_valid_c_identifier_2(string, string).
|
|
:- mode llds_out__convert_to_valid_c_identifier_2(in, out) is det.
|
|
|
|
llds_out__convert_to_valid_c_identifier_2(String, Name) :-
|
|
(
|
|
string__first_char(String, Char, Rest)
|
|
->
|
|
% XXX This will cause ABI incompatibilities between
|
|
% compilers which are built in grades that have
|
|
% different character representations.
|
|
char__to_int(Char, Code),
|
|
string__int_to_string(Code, CodeString),
|
|
string__append("_", CodeString, ThisCharString),
|
|
llds_out__convert_to_valid_c_identifier_2(Rest, Name0),
|
|
string__append(ThisCharString, Name0, Name)
|
|
;
|
|
% String is the empty string
|
|
Name = String
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
llds_out__make_base_typeclass_info_name(class_id(ClassSym, ClassArity),
|
|
TypeNames, Str) :-
|
|
llds_out__sym_name_mangle(ClassSym, MangledClassString),
|
|
string__int_to_string(ClassArity, ArityString),
|
|
llds_out__name_mangle(TypeNames, MangledTypeNames),
|
|
string__append_list(["base_typeclass_info_", MangledClassString,
|
|
"__arity", ArityString, "__", MangledTypeNames], Str).
|
|
|
|
output_base_typeclass_info_name(ClassId, TypeNames) -->
|
|
{ llds_out__make_base_typeclass_info_name(ClassId, TypeNames, Str) },
|
|
io__write_string(mercury_data_prefix),
|
|
io__write_string("__"),
|
|
io__write_string(Str).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred gather_c_file_labels(list(comp_gen_c_module)::in, list(label)::out)
|
|
is det.
|
|
|
|
gather_c_file_labels(Modules, Labels) :-
|
|
gather_labels_from_c_modules(Modules, [], Labels1),
|
|
list__reverse(Labels1, Labels).
|
|
|
|
:- pred gather_c_module_labels(list(c_procedure)::in, list(label)::out) is det.
|
|
|
|
gather_c_module_labels(Procs, Labels) :-
|
|
gather_labels_from_c_procs(Procs, [], Labels1),
|
|
list__reverse(Labels1, Labels).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred gather_labels_from_c_modules(list(comp_gen_c_module)::in,
|
|
list(label)::in, list(label)::out) is det.
|
|
|
|
gather_labels_from_c_modules([], Labels, Labels).
|
|
gather_labels_from_c_modules([Module | Modules], Labels0, Labels) :-
|
|
gather_labels_from_c_module(Module, Labels0, Labels1),
|
|
gather_labels_from_c_modules(Modules, Labels1, Labels).
|
|
|
|
:- pred gather_labels_from_c_module(comp_gen_c_module::in,
|
|
list(label)::in, list(label)::out) is det.
|
|
|
|
gather_labels_from_c_module(comp_gen_c_module(_, Procs), Labels0, Labels) :-
|
|
gather_labels_from_c_procs(Procs, Labels0, Labels).
|
|
|
|
:- pred gather_labels_from_c_procs(list(c_procedure)::in,
|
|
list(label)::in, list(label)::out) is det.
|
|
|
|
gather_labels_from_c_procs([], Labels, Labels).
|
|
gather_labels_from_c_procs([c_procedure(_, _, _, Instrs, _, _, _) | Procs],
|
|
Labels0, Labels) :-
|
|
gather_labels_from_instrs(Instrs, Labels0, Labels1),
|
|
gather_labels_from_c_procs(Procs, Labels1, Labels).
|
|
|
|
:- pred gather_labels_from_instrs(list(instruction)::in,
|
|
list(label)::in, list(label)::out) is det.
|
|
|
|
gather_labels_from_instrs([], Labels, Labels).
|
|
gather_labels_from_instrs([Instr | Instrs], Labels0, Labels) :-
|
|
( Instr = label(Label) - _ ->
|
|
Labels1 = [Label | Labels0]
|
|
;
|
|
Labels1 = Labels0
|
|
),
|
|
gather_labels_from_instrs(Instrs, Labels1, Labels).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Currently the `.rlo' files are stored as static data in the
|
|
% executable. It may be better to store them in separate files
|
|
% in a known location and load them at runtime.
|
|
:- pred output_rl_file(module_name, maybe(rl_file), io__state, io__state).
|
|
:- mode output_rl_file(in, in, di, uo) is det.
|
|
|
|
output_rl_file(ModuleName, MaybeRLFile) -->
|
|
globals__io_lookup_bool_option(aditi, Aditi),
|
|
( { Aditi = no } ->
|
|
[]
|
|
;
|
|
io__write_string("\n\n/* Aditi-RL code for this module. */\n"),
|
|
{ llds_out__make_rl_data_name(ModuleName, RLDataConstName) },
|
|
io__write_string("const char "),
|
|
io__write_string(RLDataConstName),
|
|
io__write_string("[] = {"),
|
|
(
|
|
{ MaybeRLFile = yes(RLFile) },
|
|
rl_file__write_binary(output_rl_byte, RLFile, Length),
|
|
io__write_string("0};\n")
|
|
;
|
|
{ MaybeRLFile = no },
|
|
io__write_string("};\n"),
|
|
{ Length = 0 }
|
|
),
|
|
|
|
% Store the length of the data in
|
|
% mercury__aditi_rl_data__<module>__length.
|
|
|
|
{ string__append(RLDataConstName, "__length",
|
|
RLDataConstLength) },
|
|
io__write_string("const int "),
|
|
io__write_string(RLDataConstLength),
|
|
io__write_string(" = "),
|
|
io__write_int(Length),
|
|
io__write_string(";\n\n")
|
|
).
|
|
|
|
:- pred output_rl_byte(int, io__state, io__state).
|
|
:- mode output_rl_byte(in, di, uo) is det.
|
|
|
|
output_rl_byte(Byte) -->
|
|
io__write_int(Byte),
|
|
io__write_string(", ").
|
|
|
|
%-----------------------------------------------------------------------------%
|