mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 14:57:03 +00:00
9e31ef9baa
Estimated hours taken: 1.5
Split llds into two parts. llds.m defines the data types, while llds_out.m
has the predicates for printing the code.
Removed the call_closure instruction. Instead, we use calls to the
system-defined addresses do_call_{det,semidet,nondet}_closure. This is
how call_closure was implemented already. The advantage of the new
implementation is that it allows jump optimization of what used to be
call_closures, without new code in jumpopt.
347 lines
10 KiB
Mathematica
347 lines
10 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1995 University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This module defines predicates to produce the functions which are
|
|
% exported to C via a pragma(export, ...) declaration.
|
|
|
|
% XXX We don't handle floats or strings properly.
|
|
|
|
% Main authors: dgj.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module export.
|
|
|
|
:- interface.
|
|
|
|
:- import_module hlds_module.
|
|
:- import_module io, list, string, term.
|
|
|
|
% From the module_info, get a list of functions, each of which allows
|
|
% a call to be made to a Mercury procedure from C
|
|
:- pred export__get_pragma_exported_procs(module_info, list(string)).
|
|
:- mode export__get_pragma_exported_procs(in, out) is det.
|
|
|
|
% Produce a header file containing prototypes for the exported C
|
|
% functions
|
|
:- pred export__produce_header_file(module_info, string, io__state, io__state).
|
|
:- mode export__produce_header_file(in, in, di, uo) is det.
|
|
|
|
% Convert the term, which represents a type, to a string corresponding
|
|
% to its C type. (Defaults to Word).
|
|
:- pred export__term_to_type_string(term, string).
|
|
:- mode export__term_to_type_string(in, out) is det.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module code_gen, code_util, hlds_pred, llds, llds_out.
|
|
:- import_module library, map, int, std_util, assoc_list.
|
|
|
|
export__get_pragma_exported_procs(Module, ExportedProcsCode) :-
|
|
module_info_get_pragma_exported_procs(Module, ExportedProcs),
|
|
module_info_get_predicate_table(Module, PredicateTable),
|
|
predicate_table_get_preds(PredicateTable, Preds),
|
|
export__to_c(Preds, ExportedProcs, Module, ExportedProcsCode).
|
|
|
|
% For each exported procedure, produce a C function.
|
|
% The code we generate is in the form
|
|
%
|
|
% void
|
|
% <function name>(Word Mercury__Argument1, Word *Mercury__Argument2...)
|
|
% /* Word for input, Word* for output */
|
|
% {
|
|
% /* restore Mercury's registers that were saved as */
|
|
% /* we entered C from Mercury (the process must */
|
|
% /* always start in Mercury so that we can */
|
|
% /* init_engine() etc.) */
|
|
% restore_registers();
|
|
% <copy input arguments from Mercury__Arguments into registers>
|
|
% /* save the registers which may be clobbered */
|
|
% /* by the C function call call_engine(). */
|
|
% save_transient_registers();
|
|
% {
|
|
% Declare_entry(<label of called proc>);
|
|
% call_engine(ENTRY(<label of called proc>);
|
|
% }
|
|
% /* restore the registers which we saved before */
|
|
% /* the C function call */
|
|
% restore_transient_registers();
|
|
% <copy output args from registers into *Mercury__Arguments>
|
|
% #ifndef CONSERVATIVE_GC
|
|
% /* save the registers before returning to C. */
|
|
% /* However, the only register of importance that */
|
|
% /* may have changed during the execution of the */
|
|
% /* Mercury code is the heap pointer. If we are */
|
|
% /* using the convervative garbage collector, the */
|
|
% /* heap pointer is not important, so we don't */
|
|
% /* bother at all. */
|
|
% save_registers();
|
|
% #endif
|
|
% }
|
|
:- pred export__to_c(pred_table, list(pragma_exported_proc), module_info,
|
|
list(string)).
|
|
:- mode export__to_c(in, in, in, out) is det.
|
|
|
|
export__to_c(_Preds, [], _Module, []).
|
|
export__to_c(Preds, [E|ExportedProcs], Module, ExportedProcsCode) :-
|
|
E = pragma_exported_proc(PredId, ProcId, C_Function),
|
|
map__lookup(Preds, PredId, PredInfo),
|
|
pred_info_procedures(PredInfo, ProcTable),
|
|
map__lookup(ProcTable, ProcId, ProcInfo),
|
|
proc_info_arg_info(ProcInfo, ArgInfos),
|
|
proc_info_headvars(ProcInfo, HeadVars),
|
|
proc_info_vartypes(ProcInfo, VarTypes),
|
|
assoc_list__from_corresponding_lists(HeadVars, ArgInfos, HeadArgInfos),
|
|
|
|
get_argument_declarations(HeadArgInfos, VarTypes, ArgDecls),
|
|
|
|
% work out which arguments are input, and which are output,
|
|
% and copy to/from the mercury registers.
|
|
get_input_args(ArgInfos, 0, InputArgs),
|
|
copy_output_args(ArgInfos, 0, OutputArgs),
|
|
|
|
code_util__make_proc_label(Module, PredId, ProcId, ProcLabel),
|
|
get_proc_label(ProcLabel, ProcLabelString),
|
|
|
|
string__append_list([ "\nvoid\n",
|
|
C_Function,
|
|
"(",
|
|
ArgDecls,
|
|
")\n{\n",
|
|
"\trestore_registers();\n",
|
|
InputArgs,
|
|
"\tsave_transient_registers();\n",
|
|
"\t{\n\tDeclare_entry(",
|
|
ProcLabelString,
|
|
");\n",
|
|
"\tcall_engine(ENTRY(",
|
|
ProcLabelString,
|
|
"));\n\t}\n",
|
|
"\trestore_transient_registers();\n",
|
|
OutputArgs,
|
|
"#ifndef CONSERVATIVE_GC\n",
|
|
"\tsave_registers();\n",
|
|
"#endif\n",
|
|
"}\n\n"],
|
|
Code),
|
|
|
|
export__to_c(Preds, ExportedProcs, Module, TheRest),
|
|
ExportedProcsCode = [Code|TheRest].
|
|
|
|
:- pred get_argument_declarations(assoc_list(var, arg_info), map(var, type),
|
|
string).
|
|
:- mode get_argument_declarations(in, in, out) is det.
|
|
|
|
get_argument_declarations([], _, "void").
|
|
get_argument_declarations([X|Xs], VarTypes, Result) :-
|
|
get_argument_declarations_2([X|Xs], VarTypes, 0, Result).
|
|
|
|
:- pred get_argument_declarations_2(assoc_list(var, arg_info), map(var, type),
|
|
int, string).
|
|
:- mode get_argument_declarations_2(in, in, in, out) is det.
|
|
|
|
get_argument_declarations_2([], _, _, "").
|
|
get_argument_declarations_2([V|Vs], VarTypes, Num0, Result) :-
|
|
V = Var - ArgInfo,
|
|
ArgInfo = arg_info(_Loc, Mode),
|
|
Num is Num0 + 1,
|
|
string__int_to_string(Num, NumString),
|
|
string__append("Mercury__argument", NumString, ArgName),
|
|
map__lookup(VarTypes, Var, Type),
|
|
export__term_to_type_string(Type, TypeString0),
|
|
(
|
|
Mode = top_out
|
|
->
|
|
% output variables are passed as pointers
|
|
string__append(TypeString0, " *", TypeString)
|
|
;
|
|
string__append(TypeString0, " ", TypeString)
|
|
),
|
|
(
|
|
Vs = []
|
|
->
|
|
string__append(TypeString, ArgName, Result)
|
|
;
|
|
get_argument_declarations_2(Vs, VarTypes, Num, TheRest),
|
|
string__append_list([TypeString, ArgName, ", ", TheRest],
|
|
Result)
|
|
).
|
|
|
|
:- pred get_input_args(list(arg_info), int, string).
|
|
:- mode get_input_args(in, in, out) is det.
|
|
|
|
% XXX We don't handle floats and strings properly.
|
|
|
|
get_input_args([], _, "").
|
|
get_input_args([A|ArgInfos], Num0, Result) :-
|
|
A = arg_info(Register, Mode),
|
|
Num is Num0 + 1,
|
|
(
|
|
Mode = top_in,
|
|
|
|
string__int_to_string(Register, RegString),
|
|
string__int_to_string(Num, NumString),
|
|
string__append("Mercury__argument", NumString, ArgName),
|
|
|
|
(
|
|
% XXX We should handle floats
|
|
% XXX This magic number can't be good
|
|
Register > 32
|
|
->
|
|
string__append_list(["r(", RegString, ")"], RegName)
|
|
;
|
|
string__append("r", RegString, RegName)
|
|
),
|
|
string__append_list([ "\t",
|
|
RegName,
|
|
" = ",
|
|
ArgName,
|
|
";\n"
|
|
],
|
|
InputArg)
|
|
;
|
|
Mode = top_out,
|
|
InputArg = ""
|
|
;
|
|
Mode = top_unused,
|
|
InputArg = ""
|
|
),
|
|
get_input_args(ArgInfos, Num, TheRest),
|
|
string__append(InputArg, TheRest, Result).
|
|
|
|
:- pred copy_output_args(list(arg_info), int, string).
|
|
:- mode copy_output_args(in, in, out) is det.
|
|
|
|
% XXX We don't handle floats and strings properly.
|
|
|
|
copy_output_args([], _, "").
|
|
copy_output_args([A|ArgInfos], Num0, Result) :-
|
|
A = arg_info(Register, Mode),
|
|
Num is Num0 + 1,
|
|
(
|
|
Mode = top_in,
|
|
OutputArg = ""
|
|
;
|
|
Mode = top_out,
|
|
|
|
string__int_to_string(Num, NumString),
|
|
string__append("Mercury__argument", NumString, ArgName),
|
|
string__int_to_string(Register, RegString),
|
|
|
|
(
|
|
% XXX We should handle floats
|
|
% XXX This magic number can't be good
|
|
Register > 32
|
|
->
|
|
string__append_list(["r(", RegString, ")"], RegName)
|
|
;
|
|
string__append("r", RegString, RegName)
|
|
),
|
|
string__append_list([
|
|
"\t*",
|
|
ArgName,
|
|
" = ",
|
|
RegName,
|
|
";\n"
|
|
],
|
|
OutputArg)
|
|
;
|
|
Mode = top_unused,
|
|
OutputArg = ""
|
|
),
|
|
copy_output_args(ArgInfos, Num, TheRest),
|
|
string__append(OutputArg, TheRest, Result).
|
|
|
|
export__produce_header_file(Module, ModuleName) -->
|
|
{ module_info_get_pragma_exported_procs(Module, ExportedProcs) },
|
|
(
|
|
{ ExportedProcs = [_|_] }
|
|
->
|
|
{ module_info_get_predicate_table(Module, PredicateTable) },
|
|
{ predicate_table_get_preds(PredicateTable, Preds) },
|
|
{ string__append(ModuleName, ".h", FileName) },
|
|
io__tell(FileName, Result),
|
|
(
|
|
{ Result = ok }
|
|
->
|
|
{ library__version(Version) },
|
|
io__write_strings(
|
|
["/*\n** Automatically generated from `",
|
|
ModuleName,
|
|
".m' by the\n** Mercury compiler, version ",
|
|
Version,
|
|
". Do not edit.\n*/\n"]),
|
|
io__write_string("#include ""imp.h""\n\n"),
|
|
{ string__to_upper(ModuleName, UpperModuleName) },
|
|
{ string__append(UpperModuleName, "_H", UpperFileName) },
|
|
io__write_strings([
|
|
"#ifndef ",
|
|
UpperFileName,
|
|
"\n",
|
|
"#define ",
|
|
UpperFileName,
|
|
"\n"
|
|
]),
|
|
export__produce_header_file_2(Preds, ExportedProcs,
|
|
Module),
|
|
io__write_string("#endif\n"),
|
|
io__told
|
|
;
|
|
io__progname_base("export.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 export__produce_header_file_2(pred_table, list(pragma_exported_proc),
|
|
module_info, io__state, io__state).
|
|
:- mode export__produce_header_file_2(in, in, in, di, uo) is det.
|
|
export__produce_header_file_2(_Preds, [], _Module) --> [].
|
|
export__produce_header_file_2(Preds, [E|ExportedProcs], Module) -->
|
|
{ E = pragma_exported_proc(PredId, ProcId, C_Function) },
|
|
{ map__lookup(Preds, PredId, PredInfo) },
|
|
{ pred_info_procedures(PredInfo, ProcTable) },
|
|
{ map__lookup(ProcTable, ProcId, ProcInfo) },
|
|
{ proc_info_arg_info(ProcInfo, ArgInfos) },
|
|
|
|
{ proc_info_headvars(ProcInfo, HeadVars) },
|
|
{ proc_info_vartypes(ProcInfo, VarTypes) },
|
|
{ assoc_list__from_corresponding_lists(HeadVars, ArgInfos,
|
|
HeadArgInfos) },
|
|
|
|
{ get_argument_declarations(HeadArgInfos, VarTypes, ArgDecls) },
|
|
|
|
% output the function header
|
|
io__write_string("void\n"),
|
|
io__write_string(C_Function),
|
|
io__write_string("("),
|
|
io__write_string(ArgDecls),
|
|
io__write_string(");\n"),
|
|
|
|
export__produce_header_file_2(Preds, ExportedProcs, Module).
|
|
|
|
% Convert a term representation of a variable type to a string which
|
|
% represents the C type of the variable
|
|
% Apart from special cases, local variables become Words
|
|
export__term_to_type_string(Type, Result) :-
|
|
( Type = term__functor(term__atom("int"), [], _) ->
|
|
Result = "Integer"
|
|
; Type = term__functor(term__atom("float"), [], _) ->
|
|
Result = "Float"
|
|
; Type = term__functor(term__atom("string"), [], _) ->
|
|
Result = "String"
|
|
; Type = term__functor(term__atom("character"), [], _) ->
|
|
Result = "Char"
|
|
;
|
|
Result = "Word"
|
|
).
|