mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 05:12:33 +00:00
f519e26173
Add the new builtin types: int64 and uint64.
Support for these new types will need to be bootstrapped over several changes.
This is the first such change and does the following:
- Extends the compiler to recognise 'int64' and 'uint64' as builtin types.
- Extends the set of builtin arithmetic, bitwise and relational operators
to cover the new types.
- Adds the new internal option '--unboxed-int64s' to the compiler; this will be
used to control whether 64-bit integer types are boxed or not.
- Extends all of the code generators to handle the new types.
- Extends the runtimes to support the new types.
- Adds new modules to the standard library intend to contain basic operations
on the new types. (These are currently empty and not documented.)
There are bunch of limitations marks with "XXX INT64"; these will be lifted in
part 2 of this change. Also, 64-bit integer types are currently always boxed,
again this limitation will be lifted in later changes.
compiler/options.m:
Add the new option --unboxed-int64s.
compiler/prog_type.m:
compiler/prog_data.m:
compiler/builtin_lib_types.m:
Recognise int64 and uint64 as builtin types.
compiler/builtin_ops.m:
Add builtin operations for the new types.
compiler/hlds_data.m:
Add new tag types for the new types.
compiler/ctgc.selector.m:
compiler/dead_proc_elim.m:
compiler/export.m:
compiler/foreign.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_code_util.m:
compiler/hlds_dependency_graph.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/implementation_defined_literals.m:
compiler/inst_check.m:
compiler/mercury_to_mercury.m:
compiler/mode_util.m:
compiler/module_qual.qualify_items.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/parse_tree_to_term.m:
compiler/parse_type_name.m:
compiler/polymorphism.m:
compiler/prog_out.m:
compiler/prog_util.m:
compiler/rbmm.execution_path.m:
compiler/rtti.m:
compiler/table_gen.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/unify_gen.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to the above changes to the parse tree and HLDS.
compiler/c_util.m:
Support writing out constants of the new types.
compiler/llds.m:
Add a representation for constants of the new types to the LLDS.
compiler/stack_layout.m:
Add a new field to the stack layout params that records whether
64-bit integers are boxed or not.
compiler/call_gen.:m
compiler/code_info.m:
compiler/disj_gen.m:
compiler/dupproc.m:
compiler/exprn_aux.m:
compiler/global_data.m:
compiler/jumpopt.m:
compiler/llds_out_data.m:
compiler/llds_out_instr.m:
compiler/lookup_switch.m:
compiler/mercury_compile_llds_back_end.m:
compiler/prog_rep.m:
compiler/prog_rep_tables.m:
compiler/var_locn.m b/compiler/var_locn.m:
Support the new types in the LLDS code generator.
compiler/mlds.m:
Support constants of the new types in the MLDS.
compiler/ml_call_gen.m:
compiler/ml_code_util.m:
compiler/ml_global_data.m:
compiler/ml_rename_classes.m:
compiler/ml_top_gen.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds_to_target_util.m:
compiler/rtti_to_mlds.m:
Conform to the above changes to the MLDS.
compiler/mlds_to_c.m:
compiler/mlds_to_cs.m:
compiler/mlds_to_java.m:
Generate the appropriate target code for constants of the new types
and operations involving them.
compiler/bytecode.m:
compiler/bytecode_gen.m:
Handle the new types in the bytecode generator; we just abort if we
encounter them for now.
compiler/elds.m:
compiler/elds_to_erlang.m:
compiler/erl_call_gen.m:
compiler/erl_code_util.m:
compiler/erl_unify_gen.m:
Handle the new types in the Erlang code generator.
library/private_builtin.m:
Add placeholders for the builtin unify and compare operations for
the new types. Since the bootstrapping compiler will not recognise
the new types we give them polymorphic arguments. These can be
replaced after this change has bootstrapped.
Update the Java list of TypeCtorRep constants here.
library/int64.m:
library/uint64.m:
New modules that will eventually contain builtin operations on the new
types.
library/library.m:
library/MODULES_UNDOC:
Do not include the above modules in the library documentation for now.
library/construct.m:
library/erlang_rtti_implementation.m:
library/rtti_implementation.m:
library/table_statistics.m:
deep_profiler/program_representation_utils.m:
mdbcomp/program_representation.m:
Handle the new types.
configure.ac:
runtime/mercury_conf.h.in:
Define the macro MR_BOXED_INT64S. For now it is always defined, support for
unboxed 64-bit integers will be enabled in a later change.
runtime/mercury_dotnet.cs.in:
java/runtime/TypeCtorRep.java:
runtime/mercury_type_info.h:
Update the list of type_ctor reps.
runtime/mercury.h:
runtime/mercury_int.[ch]:
Add macros for int64 / uint64 -> MR_Word conversion, boxing and
unboxing.
Add functions for hashing 64-bit integer types suitable for use
with the tabling mechanism.
runtime/mercury_tabling.[ch]:
Add additional HashTableSlot structs for 64-bit integer types.
Omit the '%' character from the conversion specifiers we pass via
the 'key_format' argument to the macros that generate the table lookup
function. This is so we can use the C99 exact size integer conversion
specifiers (e.g. PRIu64 etc.) directly here.
runtime/mercury_hash_lookup_or_add_body.h:
Add the '%' character that was omitted above to the call to debug_key_msg.
runtime/mercury_memory.h:
Add new builtin allocation sites for boxed 64-bit integer types.
runtime/mercury_builtin_types.[ch]:
runtime/mercury_builitn_types_proc_layouts.h:
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_table_type_body.h:
runtime/mercury_tabling_macros.h:
runtime/mercury_tabling_preds.h:
runtime/mercury_term_size.c:
runtime/mercury_unify_compare_body.h:
Add the new builtin types and handle them throughout the runtime.
runtime/Mmakefile:
Add mercury_int.c to the list of .c files.
doc/reference_manual.texi:
Add the new types to the list of reserved type names.
Add the mapping from the new types to their target language types.
These are commented out for now.
1045 lines
38 KiB
Mathematica
1045 lines
38 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2012 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.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: bytecode_gen.m.
|
|
% Author: zs.
|
|
%
|
|
% This module generates bytecode, which is intended to be used by a
|
|
% (not yet implemented) bytecode interpreter/debugger.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module bytecode_backend.bytecode_gen.
|
|
:- interface.
|
|
|
|
:- import_module bytecode_backend.bytecode.
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred gen_module(module_info::in, list(byte_code)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% We make use of some stuff from the LLDS back-end, in particular the stuff
|
|
% relating to the argument passing convention in arg_info.m and call_gen.m.
|
|
% The intent here is to use the same argument passing convention as for
|
|
% the LLDS, to allow interoperability between code compiled to bytecode
|
|
% and code compiled to machine code.
|
|
%
|
|
% XXX It might be nice to move the argument passing related stuff
|
|
% in call_gen.m that we use here into arg_info.m, and to then rework
|
|
% arg_info.m so that it didn't depend on the LLDS.
|
|
|
|
:- import_module backend_libs.
|
|
:- import_module backend_libs.builtin_ops.
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.arg_info.
|
|
:- import_module hlds.code_model.
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_code_util.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_llds.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.vartypes.
|
|
:- import_module ll_backend.
|
|
:- import_module ll_backend.call_gen. % XXX for arg passing convention
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module cord.
|
|
:- import_module counter.
|
|
:- import_module deconstruct.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
gen_module(ModuleInfo, Code, !IO) :-
|
|
module_info_get_valid_pred_ids(ModuleInfo, PredIds),
|
|
gen_preds(ModuleInfo, PredIds, CodeTree, !IO),
|
|
Code = cord.list(CodeTree).
|
|
|
|
:- pred gen_preds(module_info::in, list(pred_id)::in, cord(byte_code)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
gen_preds(_ModuleInfo, [], empty, !IO).
|
|
gen_preds(ModuleInfo, [PredId | PredIds], Code, !IO) :-
|
|
module_info_get_preds(ModuleInfo, PredTable),
|
|
map.lookup(PredTable, PredId, PredInfo),
|
|
ProcIds = pred_info_non_imported_procids(PredInfo),
|
|
(
|
|
ProcIds = [],
|
|
PredCode = empty
|
|
;
|
|
ProcIds = [_ | _],
|
|
gen_pred(PredId, ProcIds, PredInfo, ModuleInfo, ProcsCode, !IO),
|
|
PredName = predicate_name(ModuleInfo, PredId),
|
|
list.length(ProcIds, ProcsCount),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
get_is_func(PredInfo, IsFunc),
|
|
EnterCode = cord.singleton(byte_enter_pred(PredName, Arity, IsFunc,
|
|
ProcsCount)),
|
|
EndofCode = cord.singleton(byte_endof_pred),
|
|
PredCode = EnterCode ++ ProcsCode ++ EndofCode
|
|
),
|
|
gen_preds(ModuleInfo, PredIds, OtherCode, !IO),
|
|
Code = PredCode ++ OtherCode.
|
|
|
|
:- pred gen_pred(pred_id::in, list(proc_id)::in, pred_info::in,
|
|
module_info::in, cord(byte_code)::out, io::di, io::uo) is det.
|
|
|
|
gen_pred(_PredId, [], _PredInfo, _ModuleInfo, empty, !IO).
|
|
gen_pred(PredId, [ProcId | ProcIds], PredInfo, ModuleInfo, Code, !IO) :-
|
|
write_proc_progress_message("% Generating bytecode for ",
|
|
PredId, ProcId, ModuleInfo, !IO),
|
|
gen_proc(ProcId, PredInfo, ModuleInfo, ProcCode),
|
|
gen_pred(PredId, ProcIds, PredInfo, ModuleInfo, ProcsCode, !IO),
|
|
Code = ProcCode ++ ProcsCode.
|
|
|
|
:- pred gen_proc(proc_id::in, pred_info::in,
|
|
module_info::in, cord(byte_code)::out) is det.
|
|
|
|
gen_proc(ProcId, PredInfo, ModuleInfo, Code) :-
|
|
pred_info_get_proc_table(PredInfo, ProcTable),
|
|
map.lookup(ProcTable, ProcId, ProcInfo),
|
|
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
proc_info_get_varset(ProcInfo, VarSet),
|
|
proc_info_interface_determinism(ProcInfo, Detism),
|
|
determinism_to_code_model(Detism, CodeModel),
|
|
|
|
goal_util.goal_vars(Goal, GoalVars),
|
|
proc_info_get_headvars(ProcInfo, ArgVars),
|
|
set_of_var.insert_list(ArgVars, GoalVars, Vars),
|
|
set_of_var.to_sorted_list(Vars, VarList),
|
|
map.init(VarMap0),
|
|
create_varmap(VarList, VarSet, VarTypes, 0, VarMap0, VarMap, VarInfos),
|
|
|
|
init_byte_info(ModuleInfo, VarMap, VarTypes, ByteInfo0),
|
|
get_next_label(ZeroLabel, ByteInfo0, ByteInfo1),
|
|
|
|
proc_info_arg_info(ProcInfo, ArgInfo),
|
|
assoc_list.from_corresponding_lists(ArgVars, ArgInfo, Args),
|
|
|
|
call_gen.input_arg_locs(Args, InputArgs),
|
|
gen_pickups(InputArgs, ByteInfo, PickupCode),
|
|
|
|
call_gen.output_arg_locs(Args, OutputArgs),
|
|
gen_places(OutputArgs, ByteInfo, PlaceCode),
|
|
|
|
% If semideterministic, reserve temp slot 0 for the return value
|
|
(
|
|
CodeModel = model_semi,
|
|
get_next_temp(_FrameTemp, ByteInfo1, ByteInfo2)
|
|
;
|
|
( CodeModel = model_det
|
|
; CodeModel = model_non
|
|
),
|
|
ByteInfo2 = ByteInfo1
|
|
),
|
|
|
|
gen_goal(Goal, ByteInfo2, ByteInfo3, GoalCode),
|
|
get_next_label(EndLabel, ByteInfo3, ByteInfo),
|
|
get_counts(ByteInfo, LabelCount, TempCount),
|
|
|
|
ZeroLabelCode = cord.singleton(byte_label(ZeroLabel)),
|
|
BodyCode0 = PickupCode ++ ZeroLabelCode ++ GoalCode ++ PlaceCode,
|
|
BodyInstrs = cord.list(BodyCode0),
|
|
( if list.member(byte_not_supported, BodyInstrs) then
|
|
BodyCode = cord.singleton(byte_not_supported)
|
|
else
|
|
BodyCode = BodyCode0
|
|
),
|
|
proc_id_to_int(ProcId, ProcInt),
|
|
EnterCode = cord.singleton(byte_enter_proc(ProcInt, Detism, LabelCount,
|
|
EndLabel, TempCount, VarInfos)),
|
|
(
|
|
CodeModel = model_semi,
|
|
EndofCode = cord.from_list([byte_semidet_succeed, byte_label(EndLabel),
|
|
byte_endof_proc])
|
|
;
|
|
( CodeModel = model_det
|
|
; CodeModel = model_non
|
|
),
|
|
EndofCode = cord.from_list([byte_label(EndLabel), byte_endof_proc])
|
|
),
|
|
Code = EnterCode ++ BodyCode ++ EndofCode.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred gen_goal(hlds_goal::in, byte_info::in, byte_info::out,
|
|
cord(byte_code)::out) is det.
|
|
|
|
gen_goal(hlds_goal(GoalExpr, GoalInfo), !ByteInfo, Code) :-
|
|
gen_goal_expr(GoalExpr, GoalInfo, !ByteInfo, GoalCode),
|
|
Context = goal_info_get_context(GoalInfo),
|
|
term.context_line(Context, Line),
|
|
Code = cord.singleton(byte_context(Line)) ++ GoalCode.
|
|
|
|
:- pred gen_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
|
|
byte_info::in, byte_info::out, cord(byte_code)::out) is det.
|
|
|
|
gen_goal_expr(GoalExpr, GoalInfo, !ByteInfo, Code) :-
|
|
(
|
|
GoalExpr = generic_call(GenericCallType,
|
|
ArgVars, ArgModes, _, Detism),
|
|
(
|
|
GenericCallType = higher_order(PredVar, _, _, _),
|
|
gen_higher_order_call(PredVar, ArgVars, ArgModes, Detism,
|
|
!.ByteInfo, Code)
|
|
;
|
|
( GenericCallType = class_method(_, _, _, _)
|
|
; GenericCallType = cast(_)
|
|
; GenericCallType = event_call(_)
|
|
),
|
|
% XXX
|
|
% string.append_list([
|
|
% "bytecode for ", GenericCallFunctor, " calls"], Msg),
|
|
% sorry($module, $pred, Msg)
|
|
functor(GenericCallType, canonicalize, _GenericCallFunctor, _),
|
|
Code = cord.singleton(byte_not_supported)
|
|
)
|
|
;
|
|
GoalExpr = plain_call(PredId, ProcId, ArgVars, BuiltinState, _, _),
|
|
(
|
|
BuiltinState = not_builtin,
|
|
Detism = goal_info_get_determinism(GoalInfo),
|
|
gen_call(PredId, ProcId, ArgVars, Detism, !.ByteInfo, Code)
|
|
;
|
|
BuiltinState = inline_builtin,
|
|
gen_builtin(PredId, ProcId, ArgVars, !.ByteInfo, Code)
|
|
)
|
|
;
|
|
GoalExpr = unify(_Var, _RHS, _Mode, Unification, _),
|
|
gen_unify(Unification, !.ByteInfo, Code)
|
|
;
|
|
GoalExpr = negation(Goal),
|
|
gen_goal(Goal, !ByteInfo, SomeCode),
|
|
get_next_label(EndLabel, !ByteInfo),
|
|
get_next_temp(FrameTemp, !ByteInfo),
|
|
EnterCode = cord.singleton(byte_enter_negation(FrameTemp, EndLabel)),
|
|
EndofCode = cord.from_list([byte_endof_negation_goal(FrameTemp),
|
|
byte_label(EndLabel), byte_endof_negation]),
|
|
Code = EnterCode ++ SomeCode ++ EndofCode
|
|
;
|
|
GoalExpr = scope(_, InnerGoal),
|
|
gen_goal(InnerGoal, !ByteInfo, InnerCode),
|
|
OuterDetism = goal_info_get_determinism(GoalInfo),
|
|
InnerGoal = hlds_goal(_, InnerGoalInfo),
|
|
InnerDetism = goal_info_get_determinism(InnerGoalInfo),
|
|
determinism_to_code_model(OuterDetism, OuterCodeModel),
|
|
determinism_to_code_model(InnerDetism, InnerCodeModel),
|
|
( if InnerCodeModel = OuterCodeModel then
|
|
Code = InnerCode
|
|
else
|
|
get_next_temp(Temp, !ByteInfo),
|
|
EnterCode = cord.singleton(byte_enter_commit(Temp)),
|
|
EndofCode = cord.singleton(byte_endof_commit(Temp)),
|
|
Code = EnterCode ++ InnerCode ++ EndofCode
|
|
)
|
|
;
|
|
GoalExpr = conj(plain_conj, GoalList),
|
|
gen_conj(GoalList, !ByteInfo, Code)
|
|
;
|
|
GoalExpr = conj(parallel_conj, _GoalList),
|
|
sorry($module, $pred, "bytecode_gen of parallel conjunction")
|
|
;
|
|
GoalExpr = disj(GoalList),
|
|
(
|
|
GoalList = [],
|
|
Code = cord.singleton(byte_fail)
|
|
;
|
|
GoalList = [_ | _],
|
|
get_next_label(EndLabel, !ByteInfo),
|
|
gen_disj(GoalList, EndLabel, !ByteInfo, DisjCode),
|
|
EnterCode = cord.singleton(byte_enter_disjunction(EndLabel)),
|
|
EndofCode = cord.from_list([byte_endof_disjunction,
|
|
byte_label(EndLabel)]),
|
|
Code = EnterCode ++ DisjCode ++ EndofCode
|
|
)
|
|
;
|
|
GoalExpr = switch(Var, _, CasesList),
|
|
get_next_label(EndLabel, !ByteInfo),
|
|
gen_switch(CasesList, Var, EndLabel, !ByteInfo, SwitchCode),
|
|
map_var(!.ByteInfo, Var, ByteVar),
|
|
EnterCode = cord.singleton(byte_enter_switch(ByteVar, EndLabel)),
|
|
EndofCode = cord.from_list([byte_endof_switch, byte_label(EndLabel)]),
|
|
Code = EnterCode ++ SwitchCode ++ EndofCode
|
|
;
|
|
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
|
|
get_next_label(EndLabel, !ByteInfo),
|
|
get_next_label(ElseLabel, !ByteInfo),
|
|
get_next_temp(FrameTemp, !ByteInfo),
|
|
gen_goal(Cond, !ByteInfo, CondCode),
|
|
gen_goal(Then, !ByteInfo, ThenCode),
|
|
gen_goal(Else, !ByteInfo, ElseCode),
|
|
EnterIfCode = cord.singleton(
|
|
byte_enter_if(ElseLabel, EndLabel, FrameTemp)),
|
|
EnterThenCode = cord.singleton(byte_enter_then(FrameTemp)),
|
|
EndofThenCode = cord.from_list([byte_endof_then(EndLabel),
|
|
byte_label(ElseLabel), byte_enter_else(FrameTemp)]),
|
|
EndofIfCode = cord.from_list([byte_endof_if, byte_label(EndLabel)]),
|
|
Code = EnterIfCode ++ CondCode ++ EnterThenCode ++ ThenCode ++
|
|
EndofThenCode ++ ElseCode ++ EndofIfCode
|
|
;
|
|
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
|
|
Code = cord.singleton(byte_not_supported)
|
|
;
|
|
GoalExpr = shorthand(_),
|
|
% These should have been expanded out by now.
|
|
unexpected($module, $pred, "shorthand")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred gen_places(list(pair(prog_var, arg_loc))::in,
|
|
byte_info::in, cord(byte_code)::out) is det.
|
|
|
|
gen_places([], _, empty).
|
|
gen_places([Var - Loc | OutputArgs], ByteInfo, Code) :-
|
|
gen_places(OutputArgs, ByteInfo, OtherCode),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
(
|
|
Loc = reg(reg_r, RegNum)
|
|
;
|
|
Loc = reg(reg_f, _),
|
|
sorry($module, $pred, "floating point register")
|
|
),
|
|
Code = cord.singleton(byte_place_arg(byte_reg_r, RegNum, ByteVar)) ++
|
|
OtherCode.
|
|
|
|
:- pred gen_pickups(list(pair(prog_var, arg_loc))::in,
|
|
byte_info::in, cord(byte_code)::out) is det.
|
|
|
|
gen_pickups([], _, empty).
|
|
gen_pickups([Var - Loc | OutputArgs], ByteInfo, Code) :-
|
|
gen_pickups(OutputArgs, ByteInfo, OtherCode),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
(
|
|
Loc = reg(reg_r, RegNum)
|
|
;
|
|
Loc = reg(reg_f, _),
|
|
sorry($module, $pred, "floating point register")
|
|
),
|
|
Code = cord.singleton(byte_pickup_arg(byte_reg_r, RegNum, ByteVar)) ++
|
|
OtherCode.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate bytecode for a higher order call.
|
|
%
|
|
:- pred gen_higher_order_call(prog_var::in, list(prog_var)::in,
|
|
list(mer_mode)::in, determinism::in, byte_info::in, cord(byte_code)::out)
|
|
is det.
|
|
|
|
gen_higher_order_call(PredVar, ArgVars, ArgModes, Detism, ByteInfo, Code) :-
|
|
determinism_to_code_model(Detism, CodeModel),
|
|
get_module_info(ByteInfo, ModuleInfo),
|
|
list.map(get_var_type(ByteInfo), ArgVars, ArgTypes),
|
|
make_standard_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo,
|
|
ArgInfo),
|
|
assoc_list.from_corresponding_lists(ArgVars, ArgInfo, ArgVarsInfos),
|
|
|
|
arg_info.partition_args(ArgVarsInfos, InVars, OutVars),
|
|
list.length(InVars, NInVars),
|
|
list.length(OutVars, NOutVars),
|
|
|
|
call_gen.input_arg_locs(ArgVarsInfos, InputArgs),
|
|
gen_places(InputArgs, ByteInfo, PlaceArgs),
|
|
|
|
call_gen.output_arg_locs(ArgVarsInfos, OutputArgs),
|
|
gen_pickups(OutputArgs, ByteInfo, PickupArgs),
|
|
|
|
map_var(ByteInfo, PredVar, BytePredVar),
|
|
Call = cord.singleton(byte_higher_order_call(BytePredVar,
|
|
NInVars, NOutVars, Detism)),
|
|
(
|
|
CodeModel = model_semi,
|
|
Check = cord.singleton(byte_semidet_success_check)
|
|
;
|
|
( CodeModel = model_det
|
|
; CodeModel = model_non
|
|
),
|
|
Check = empty
|
|
),
|
|
Code = PlaceArgs ++ Call ++ Check ++ PickupArgs.
|
|
|
|
% Generate bytecode for an ordinary call.
|
|
%
|
|
:- pred gen_call(pred_id::in, proc_id::in, list(prog_var)::in,
|
|
determinism::in, byte_info::in, cord(byte_code)::out) is det.
|
|
|
|
gen_call(PredId, ProcId, ArgVars, Detism, ByteInfo, Code) :-
|
|
get_module_info(ByteInfo, ModuleInfo),
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
|
|
proc_info_arg_info(ProcInfo, ArgInfo),
|
|
assoc_list.from_corresponding_lists(ArgVars, ArgInfo, ArgVarsInfos),
|
|
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
get_is_func(PredInfo, IsFunc),
|
|
|
|
call_gen.input_arg_locs(ArgVarsInfos, InputArgs),
|
|
gen_places(InputArgs, ByteInfo, PlaceArgs),
|
|
|
|
call_gen.output_arg_locs(ArgVarsInfos, OutputArgs),
|
|
gen_pickups(OutputArgs, ByteInfo, PickupArgs),
|
|
|
|
predicate_id(ModuleInfo, PredId, ModuleName, PredName, Arity),
|
|
proc_id_to_int(ProcId, ProcInt),
|
|
Call = cord.singleton(
|
|
byte_call(ModuleName, PredName, Arity, IsFunc, ProcInt)),
|
|
determinism_to_code_model(Detism, CodeModel),
|
|
(
|
|
CodeModel = model_semi,
|
|
Check = cord.singleton(byte_semidet_success_check)
|
|
;
|
|
( CodeModel = model_det
|
|
; CodeModel = model_non
|
|
),
|
|
Check = empty
|
|
),
|
|
Code = PlaceArgs ++ Call ++ Check ++ PickupArgs.
|
|
|
|
% Generate bytecode for a call to a builtin.
|
|
%
|
|
:- pred gen_builtin(pred_id::in, proc_id::in, list(prog_var)::in,
|
|
byte_info::in, cord(byte_code)::out) is det.
|
|
|
|
gen_builtin(PredId, ProcId, Args, ByteInfo, Code) :-
|
|
get_module_info(ByteInfo, ModuleInfo),
|
|
ModuleName = predicate_module(ModuleInfo, PredId),
|
|
PredName = predicate_name(ModuleInfo, PredId),
|
|
builtin_ops.translate_builtin(ModuleName, PredName, ProcId, Args,
|
|
SimpleCode),
|
|
(
|
|
SimpleCode = test(Test),
|
|
map_test(ByteInfo, Test, Code)
|
|
;
|
|
SimpleCode = assign(Var, Expr),
|
|
map_assign(ByteInfo, Var, Expr, Code)
|
|
;
|
|
SimpleCode = ref_assign(_Var, _Expr),
|
|
unexpected($module, $pred, "ref_assign")
|
|
;
|
|
SimpleCode = noop(_DefinedVars),
|
|
Code = empty
|
|
).
|
|
|
|
:- pred map_test(byte_info::in, simple_expr(prog_var)::in(simple_test_expr),
|
|
cord(byte_code)::out) is det.
|
|
|
|
map_test(ByteInfo, TestExpr, Code) :-
|
|
(
|
|
TestExpr = binary(Binop, X, Y),
|
|
map_arg(ByteInfo, X, ByteX),
|
|
map_arg(ByteInfo, Y, ByteY),
|
|
Code = cord.singleton(byte_builtin_bintest(Binop, ByteX, ByteY))
|
|
;
|
|
TestExpr = unary(Unop, X),
|
|
map_arg(ByteInfo, X, ByteX),
|
|
Code = cord.singleton(byte_builtin_untest(Unop, ByteX))
|
|
).
|
|
|
|
:- pred map_assign(byte_info::in, prog_var::in,
|
|
simple_expr(prog_var)::in(simple_assign_expr), cord(byte_code)::out)
|
|
is det.
|
|
|
|
map_assign(ByteInfo, Var, Expr, Code) :-
|
|
(
|
|
Expr = binary(Binop, X, Y),
|
|
map_arg(ByteInfo, X, ByteX),
|
|
map_arg(ByteInfo, Y, ByteY),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
Code = cord.singleton(byte_builtin_binop(Binop, ByteX, ByteY, ByteVar))
|
|
;
|
|
Expr = unary(Unop, X),
|
|
map_arg(ByteInfo, X, ByteX),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
Code = cord.singleton(byte_builtin_unop(Unop, ByteX, ByteVar))
|
|
;
|
|
Expr = leaf(X),
|
|
map_var(ByteInfo, X, ByteX),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
Code = cord.singleton(byte_assign(ByteVar, ByteX))
|
|
).
|
|
|
|
:- pred map_arg(byte_info::in, simple_expr(prog_var)::in(simple_arg_expr),
|
|
byte_arg::out) is det.
|
|
|
|
map_arg(ByteInfo, Expr, ByteArg) :-
|
|
(
|
|
Expr = leaf(Var),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
ByteArg = byte_arg_var(ByteVar)
|
|
;
|
|
Expr = int_const(IntVal),
|
|
ByteArg = byte_arg_int_const(IntVal)
|
|
;
|
|
Expr = float_const(FloatVal),
|
|
ByteArg = byte_arg_float_const(FloatVal)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate bytecode for a unification.
|
|
%
|
|
:- pred gen_unify(unification::in, byte_info::in, cord(byte_code)::out) is det.
|
|
|
|
gen_unify(Unification, ByteInfo, Code) :-
|
|
(
|
|
Unification = construct(Var, ConsId, Args, UniModes, _, _, _),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
map_vars(ByteInfo, Args, ByteArgs),
|
|
map_cons_id(ByteInfo, ConsId, ByteConsId),
|
|
( if ByteConsId = byte_pred_const(_, _, _, _, _) then
|
|
Code = cord.singleton(
|
|
byte_construct(ByteVar, ByteConsId, ByteArgs))
|
|
else
|
|
% Don't call map_arg_dirs until after
|
|
% the pred_const test fails, since the arg-modes on
|
|
% unifications that create closures aren't like other arg-modes.
|
|
map_arg_dirs(UniModes, Args, ByteInfo, Dirs),
|
|
( if all_dirs_same(Dirs, to_var) then
|
|
Code = cord.singleton(
|
|
byte_construct(ByteVar, ByteConsId, ByteArgs))
|
|
else
|
|
assoc_list.from_corresponding_lists(ByteArgs, Dirs, Pairs),
|
|
Code = cord.singleton(
|
|
byte_complex_construct(ByteVar, ByteConsId, Pairs))
|
|
)
|
|
)
|
|
;
|
|
Unification = deconstruct(Var, ConsId, Args, UniModes, _, _),
|
|
map_var(ByteInfo, Var, ByteVar),
|
|
map_vars(ByteInfo, Args, ByteArgs),
|
|
map_cons_id(ByteInfo, ConsId, ByteConsId),
|
|
map_arg_dirs(UniModes, Args, ByteInfo, Dirs),
|
|
( if all_dirs_same(Dirs, to_arg) then
|
|
Code = cord.singleton(
|
|
byte_deconstruct(ByteVar, ByteConsId, ByteArgs))
|
|
else
|
|
assoc_list.from_corresponding_lists(ByteArgs, Dirs, Pairs),
|
|
Code = cord.singleton(
|
|
byte_complex_deconstruct(ByteVar, ByteConsId, Pairs))
|
|
)
|
|
;
|
|
Unification = assign(Target, Source),
|
|
map_var(ByteInfo, Target, ByteTarget),
|
|
map_var(ByteInfo, Source, ByteSource),
|
|
Code = cord.singleton(byte_assign(ByteTarget, ByteSource))
|
|
;
|
|
Unification = simple_test(Var1, Var2),
|
|
map_var(ByteInfo, Var1, ByteVar1),
|
|
map_var(ByteInfo, Var2, ByteVar2),
|
|
get_var_type(ByteInfo, Var1, Var1Type),
|
|
get_var_type(ByteInfo, Var2, Var2Type),
|
|
type_to_ctor_det(Var1Type, TypeCtor1),
|
|
type_to_ctor_det(Var2Type, TypeCtor2),
|
|
( if TypeCtor2 = TypeCtor1 then
|
|
TypeCtor = TypeCtor1
|
|
else
|
|
unexpected($module, $pred,
|
|
"simple_test between different types")
|
|
),
|
|
|
|
ByteInfo = byte_info(_, _, ModuleInfo, _, _),
|
|
TypeCategory = classify_type_ctor(ModuleInfo, TypeCtor),
|
|
(
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_int)),
|
|
TestId = int_test
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_uint)),
|
|
sorry($module, $pred, "uint")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_int8)),
|
|
sorry($module, $pred, "int8")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_uint8)),
|
|
sorry($module, $pred, "uint8")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_int16)),
|
|
sorry($module, $pred, "int16")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_uint16)),
|
|
sorry($module, $pred, "uint16")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_int32)),
|
|
sorry($module, $pred, "int32")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_uint32)),
|
|
sorry($module, $pred, "uint32")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_int64)),
|
|
sorry($module, $pred, "int64")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_int(int_type_uint64)),
|
|
sorry($module, $pred, "uint64")
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_char),
|
|
TestId = char_test
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_string),
|
|
TestId = string_test
|
|
;
|
|
TypeCategory = ctor_cat_builtin(cat_builtin_float),
|
|
TestId = float_test
|
|
;
|
|
TypeCategory = ctor_cat_builtin_dummy,
|
|
TestId = dummy_test
|
|
;
|
|
TypeCategory = ctor_cat_enum(cat_enum_mercury),
|
|
TestId = enum_test
|
|
;
|
|
TypeCategory = ctor_cat_enum(cat_enum_foreign),
|
|
sorry($module, $pred, "foreign enums with bytecode backend")
|
|
;
|
|
TypeCategory = ctor_cat_higher_order,
|
|
unexpected($module, $pred, "higher_order_type")
|
|
;
|
|
TypeCategory = ctor_cat_tuple,
|
|
unexpected($module, $pred, "tuple_type")
|
|
;
|
|
TypeCategory = ctor_cat_user(_),
|
|
unexpected($module, $pred, "user_ctor_type")
|
|
;
|
|
TypeCategory = ctor_cat_variable,
|
|
unexpected($module, $pred, "variable_type")
|
|
;
|
|
TypeCategory = ctor_cat_void,
|
|
unexpected($module, $pred, "void_type")
|
|
;
|
|
TypeCategory = ctor_cat_system(_),
|
|
unexpected($module, $pred, "system type")
|
|
),
|
|
Code = cord.singleton(byte_test(ByteVar1, ByteVar2, TestId))
|
|
;
|
|
Unification = complicated_unify(_,_,_),
|
|
unexpected($module, $pred, "complicated unify")
|
|
).
|
|
|
|
:- pred map_arg_dirs(list(unify_mode)::in, list(prog_var)::in,
|
|
byte_info::in, list(byte_dir)::out) is det.
|
|
|
|
map_arg_dirs([], [], _, []).
|
|
map_arg_dirs([], [_|_], _, _) :-
|
|
unexpected($module, $pred, "length mismatch").
|
|
map_arg_dirs([_|_], [], _, _) :-
|
|
unexpected($module, $pred, "length mismatch").
|
|
map_arg_dirs([UnifyMode | UnifyModes], [Arg | Args], ByteInfo, [Dir | Dirs]) :-
|
|
get_module_info(ByteInfo, ModuleInfo),
|
|
get_var_type(ByteInfo, Arg, Type),
|
|
UnifyMode = unify_modes_lhs_rhs(VarFromToInsts, ArgFromToInsts),
|
|
from_to_insts_to_top_functor_mode(ModuleInfo, VarFromToInsts, Type,
|
|
VarTopFunctorMode),
|
|
from_to_insts_to_top_functor_mode(ModuleInfo, ArgFromToInsts, Type,
|
|
ArgTopFunctorMode),
|
|
( if
|
|
VarTopFunctorMode = top_in,
|
|
ArgTopFunctorMode = top_out
|
|
then
|
|
Dir = to_arg
|
|
else if
|
|
VarTopFunctorMode = top_out,
|
|
ArgTopFunctorMode = top_in
|
|
then
|
|
Dir = to_var
|
|
else if
|
|
VarTopFunctorMode = top_unused,
|
|
ArgTopFunctorMode = top_unused
|
|
then
|
|
Dir = to_none
|
|
else
|
|
unexpected($module, $pred,
|
|
"invalid mode for (de)construct unification")
|
|
),
|
|
map_arg_dirs(UnifyModes, Args, ByteInfo, Dirs).
|
|
|
|
:- pred all_dirs_same(list(byte_dir)::in, byte_dir::in) is semidet.
|
|
|
|
all_dirs_same([], _).
|
|
all_dirs_same([Dir | Dirs], Dir) :-
|
|
all_dirs_same(Dirs, Dir).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate bytecode for a conjunction.
|
|
%
|
|
:- pred gen_conj(list(hlds_goal)::in, byte_info::in, byte_info::out,
|
|
cord(byte_code)::out) is det.
|
|
|
|
gen_conj([], !ByteInfo, empty).
|
|
gen_conj([Goal | Goals], !ByteInfo, Code) :-
|
|
gen_goal(Goal, !ByteInfo, ThisCode),
|
|
gen_conj(Goals, !ByteInfo, OtherCode),
|
|
Code = ThisCode ++ OtherCode.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate bytecode for each disjunct of a disjunction.
|
|
%
|
|
:- pred gen_disj(list(hlds_goal)::in, int::in,
|
|
byte_info::in, byte_info::out, cord(byte_code)::out) is det.
|
|
|
|
gen_disj([], _, _, _, _) :-
|
|
unexpected($module, $pred, "empty disjunction").
|
|
gen_disj([Disjunct | Disjuncts], EndLabel, !ByteInfo, Code) :-
|
|
gen_goal(Disjunct, !ByteInfo, ThisCode),
|
|
(
|
|
Disjuncts = [],
|
|
EnterCode = cord.singleton(byte_enter_disjunct(-1)),
|
|
EndofCode = cord.singleton(byte_endof_disjunct(EndLabel)),
|
|
Code = EnterCode ++ ThisCode ++ EndofCode
|
|
;
|
|
Disjuncts = [_ | _],
|
|
gen_disj(Disjuncts, EndLabel, !ByteInfo, OtherCode),
|
|
get_next_label(NextLabel, !ByteInfo),
|
|
EnterCode = cord.singleton(byte_enter_disjunct(NextLabel)),
|
|
EndofCode = cord.from_list([byte_endof_disjunct(EndLabel),
|
|
byte_label(NextLabel)]),
|
|
Code = EnterCode ++ ThisCode ++ EndofCode ++ OtherCode
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate bytecode for each arm of a switch.
|
|
%
|
|
:- pred gen_switch(list(case)::in, prog_var::in, int::in,
|
|
byte_info::in, byte_info::out, cord(byte_code)::out) is det.
|
|
|
|
gen_switch([], _, _, !ByteInfo, empty).
|
|
gen_switch([Case | Cases], Var, EndLabel, !ByteInfo, Code) :-
|
|
Case = case(MainConsId, OtherConsIds, Goal),
|
|
map_cons_id(!.ByteInfo, MainConsId, ByteMainConsId),
|
|
list.map(map_cons_id(!.ByteInfo), OtherConsIds, ByteOtherConsIds),
|
|
gen_goal(Goal, !ByteInfo, GoalCode),
|
|
gen_switch(Cases, Var, EndLabel, !ByteInfo, CasesCode),
|
|
get_next_label(NextLabel, !ByteInfo),
|
|
EnterCode = cord.singleton(byte_enter_switch_arm(ByteMainConsId,
|
|
ByteOtherConsIds, NextLabel)),
|
|
EndofCode = cord.from_list([byte_endof_switch_arm(EndLabel),
|
|
byte_label(NextLabel)]),
|
|
Code = EnterCode ++ GoalCode ++ EndofCode ++ CasesCode.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred map_cons_id(byte_info::in, cons_id::in, byte_cons_id::out) is det.
|
|
|
|
map_cons_id(ByteInfo, ConsId, ByteConsId) :-
|
|
get_module_info(ByteInfo, ModuleInfo),
|
|
(
|
|
ConsId = cons(Functor, Arity, _TypeCtor),
|
|
(
|
|
Functor = qualified(ModuleName, FunctorName)
|
|
;
|
|
Functor = unqualified(_),
|
|
unexpected($module, $pred, "unqualified cons")
|
|
),
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
map_cons_tag(ConsTag, ByteConsTag),
|
|
ByteConsId = byte_cons(ModuleName, FunctorName, Arity, ByteConsTag)
|
|
;
|
|
ConsId = tuple_cons(Arity),
|
|
ModuleName = unqualified("builtin"),
|
|
FunctorName = "{}",
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
map_cons_tag(ConsTag, ByteConsTag),
|
|
% XXX We should have a byte_tuple_cons separate from byte_cons.
|
|
ByteConsId = byte_cons(ModuleName, FunctorName, Arity, ByteConsTag)
|
|
;
|
|
ConsId = closure_cons(ShroudedPredProcId, _EvalMethod),
|
|
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
predicate_id(ModuleInfo, PredId, ModuleName, PredName, Arity),
|
|
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
get_is_func(PredInfo, IsFunc),
|
|
|
|
proc_id_to_int(ProcId, ProcInt),
|
|
ByteConsId = byte_pred_const(ModuleName, PredName, Arity, IsFunc,
|
|
ProcInt)
|
|
;
|
|
ConsId = int_const(IntVal),
|
|
ByteConsId = byte_int_const(IntVal)
|
|
;
|
|
ConsId = uint_const(_),
|
|
unexpected($file, $pred, "uint")
|
|
;
|
|
ConsId = int8_const(_),
|
|
unexpected($file, $pred, "int8")
|
|
;
|
|
ConsId = uint8_const(_),
|
|
unexpected($file, $pred, "uint8")
|
|
;
|
|
ConsId = int16_const(_),
|
|
unexpected($file, $pred, "int16")
|
|
;
|
|
ConsId = uint16_const(_),
|
|
unexpected($file, $pred, "uint16")
|
|
;
|
|
ConsId = int32_const(_),
|
|
unexpected($file, $pred, "int32")
|
|
;
|
|
ConsId = uint32_const(_),
|
|
unexpected($file, $pred, "uint32")
|
|
;
|
|
ConsId = int64_const(_),
|
|
unexpected($file, $pred, "int64")
|
|
;
|
|
ConsId = uint64_const(_),
|
|
unexpected($file, $pred, "uint64")
|
|
;
|
|
ConsId = float_const(FloatVal),
|
|
ByteConsId = byte_float_const(FloatVal)
|
|
;
|
|
ConsId = char_const(CharVal),
|
|
ByteConsId = byte_char_const(CharVal)
|
|
;
|
|
ConsId = string_const(StringVal),
|
|
ByteConsId = byte_string_const(StringVal)
|
|
;
|
|
ConsId = impl_defined_const(_),
|
|
unexpected($module, $pred, "impl_defined_const")
|
|
;
|
|
ConsId = type_ctor_info_const(ModuleName, TypeName, TypeArity),
|
|
ByteConsId = byte_type_ctor_info_const(ModuleName, TypeName, TypeArity)
|
|
;
|
|
ConsId = base_typeclass_info_const(ModuleName, ClassId, _, Instance),
|
|
ByteConsId = byte_base_typeclass_info_const(ModuleName, ClassId,
|
|
Instance)
|
|
;
|
|
ConsId = type_info_cell_constructor(_),
|
|
ByteConsId = byte_type_info_cell_constructor
|
|
;
|
|
ConsId = typeclass_info_cell_constructor,
|
|
ByteConsId = byte_typeclass_info_cell_constructor
|
|
;
|
|
ConsId = type_info_const(_),
|
|
sorry($module, $pred, "bytecode doesn't implement type_info_const")
|
|
;
|
|
ConsId = typeclass_info_const(_),
|
|
sorry($module, $pred,
|
|
"bytecode doesn't implement typeclass_info_const")
|
|
;
|
|
ConsId = ground_term_const(_, _),
|
|
sorry($module, $pred, "bytecode doesn't implement ground_term_const")
|
|
;
|
|
ConsId = tabling_info_const(_),
|
|
sorry($module, $pred, "bytecode cannot implement tabling")
|
|
;
|
|
ConsId = table_io_entry_desc(_),
|
|
sorry($module, $pred, "bytecode cannot implement table io entry desc")
|
|
;
|
|
ConsId = deep_profiling_proc_layout(_),
|
|
sorry($module, $pred, "bytecode cannot implement deep profiling")
|
|
).
|
|
|
|
:- pred map_cons_tag(cons_tag::in, byte_cons_tag::out) is det.
|
|
|
|
map_cons_tag(no_tag, byte_no_tag).
|
|
% `single_functor' is just an optimized version of `unshared_tag(0)'
|
|
% this optimization is not important for the bytecode
|
|
map_cons_tag(single_functor_tag, byte_unshared_tag(0)).
|
|
map_cons_tag(unshared_tag(Primary), byte_unshared_tag(Primary)).
|
|
map_cons_tag(direct_arg_tag(_), _) :-
|
|
sorry($module, $pred, "bytecode with direct_arg_tag").
|
|
map_cons_tag(shared_remote_tag(Primary, Secondary),
|
|
byte_shared_remote_tag(Primary, Secondary)).
|
|
map_cons_tag(shared_local_tag(Primary, Secondary),
|
|
byte_shared_local_tag(Primary, Secondary)).
|
|
map_cons_tag(string_tag(_), _) :-
|
|
unexpected($module, $pred, "string_tag cons tag " ++
|
|
"for non-string_constant cons id").
|
|
map_cons_tag(int_tag(IntTagType), ByteConsTag) :-
|
|
(
|
|
IntTagType = int_tag_int(IntVal),
|
|
ByteConsTag = byte_enum_tag(IntVal)
|
|
;
|
|
( IntTagType = int_tag_uint(_)
|
|
; IntTagType = int_tag_int8(_)
|
|
; IntTagType = int_tag_uint8(_)
|
|
; IntTagType = int_tag_int16(_)
|
|
; IntTagType = int_tag_uint16(_)
|
|
; IntTagType = int_tag_int32(_)
|
|
; IntTagType = int_tag_uint32(_)
|
|
; IntTagType = int_tag_int64(_)
|
|
; IntTagType = int_tag_uint64(_)
|
|
),
|
|
sorry($module, $pred, "bytecode with uint or fixed size int")
|
|
).
|
|
map_cons_tag(foreign_tag(_, _), _) :-
|
|
sorry($module, $pred, "bytecode with foreign tags").
|
|
map_cons_tag(float_tag(_), _) :-
|
|
unexpected($module, $pred, "float_tag cons tag " ++
|
|
"for non-float_constant cons id").
|
|
map_cons_tag(closure_tag(_, _, _), _) :-
|
|
unexpected($module, $pred, "closure_tag cons tag " ++
|
|
"for non-closure_cons cons id").
|
|
map_cons_tag(type_ctor_info_tag(_, _, _), _) :-
|
|
unexpected($module, $pred, "type_ctor_info_tag cons tag " ++
|
|
"for non-type_ctor_info_constant cons id").
|
|
map_cons_tag(base_typeclass_info_tag(_, _, _), _) :-
|
|
unexpected($module, $pred, "base_typeclass_info_tag cons tag " ++
|
|
"for non-base_typeclass_info_constant cons id").
|
|
map_cons_tag(type_info_const_tag(_), _) :-
|
|
unexpected($module, $pred, "type_info_const cons tag " ++
|
|
"for non-type_info_const cons id").
|
|
map_cons_tag(typeclass_info_const_tag(_), _) :-
|
|
unexpected($module, $pred, "typeclass_info_const cons tag " ++
|
|
"for non-typeclass_info_const cons id").
|
|
map_cons_tag(ground_term_const_tag(_, _), _) :-
|
|
unexpected($module, $pred, "ground_term_const cons tag " ++
|
|
"for non-ground_term_const cons id").
|
|
map_cons_tag(tabling_info_tag(_, _), _) :-
|
|
unexpected($module, $pred, "tabling_info_tag cons tag " ++
|
|
"for non-tabling_info_constant cons id").
|
|
map_cons_tag(deep_profiling_proc_layout_tag(_, _), _) :-
|
|
unexpected($module, $pred, "deep_profiling_proc_layout_tag cons tag " ++
|
|
"for non-deep_profiling_proc_static cons id").
|
|
map_cons_tag(table_io_entry_tag(_, _), _) :-
|
|
unexpected($module, $pred, "table_io_entry_tag cons tag " ++
|
|
"for non-table_io_entry_desc cons id").
|
|
map_cons_tag(reserved_address_tag(_), _) :-
|
|
% These should only be generated if the --num-reserved-addresses
|
|
% or --num-reserved-objects options are used.
|
|
sorry($module, $pred, "bytecode with --num-reserved-addresses " ++
|
|
"or --num-reserved-objects").
|
|
map_cons_tag(shared_with_reserved_addresses_tag(_, _), _) :-
|
|
% These should only be generated if the --num-reserved-addresses
|
|
% or --num-reserved-objects options are used.
|
|
sorry($module, $pred, "bytecode with --num-reserved-addresses " ++
|
|
"or --num-reserved-objects").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred create_varmap(list(prog_var)::in, prog_varset::in,
|
|
vartypes::in, int::in, map(prog_var, byte_var)::in,
|
|
map(prog_var, byte_var)::out, list(byte_var_info)::out) is det.
|
|
|
|
create_varmap([], _, _, _, !VarMap, []).
|
|
create_varmap([Var | VarList], VarSet, VarTypes, N0, !VarMap, VarInfos) :-
|
|
map.det_insert(Var, N0, !VarMap),
|
|
N1 = N0 + 1,
|
|
varset.lookup_name(VarSet, Var, VarName),
|
|
lookup_var_type(VarTypes, Var, VarType),
|
|
create_varmap(VarList, VarSet, VarTypes, N1, !VarMap, VarInfosTail),
|
|
VarInfos = [var_info(VarName, VarType) | VarInfosTail].
|
|
|
|
%---------------------------------------------------------------------------%(
|
|
|
|
:- type byte_info
|
|
---> byte_info(
|
|
byteinfo_varmap :: map(prog_var, byte_var),
|
|
byteinfo_vartypes :: vartypes,
|
|
byteinfo_moduleinfo :: module_info,
|
|
byteinfo_label_counter :: counter,
|
|
byteinfo_temp_counter :: counter
|
|
).
|
|
|
|
:- pred init_byte_info(module_info::in, map(prog_var, byte_var)::in,
|
|
vartypes::in, byte_info::out) is det.
|
|
|
|
init_byte_info(ModuleInfo, VarMap, VarTypes, ByteInfo) :-
|
|
ByteInfo = byte_info(VarMap, VarTypes, ModuleInfo,
|
|
counter.init(0), counter.init(0)).
|
|
|
|
:- pred get_module_info(byte_info::in, module_info::out) is det.
|
|
|
|
get_module_info(ByteInfo, ByteInfo ^ byteinfo_moduleinfo).
|
|
|
|
:- pred map_vars(byte_info::in,
|
|
list(prog_var)::in, list(byte_var)::out) is det.
|
|
|
|
map_vars(ByteInfo, Vars, ByteVars) :-
|
|
map_vars_2(ByteInfo ^ byteinfo_varmap, Vars, ByteVars).
|
|
|
|
:- pred map_vars_2(map(prog_var, byte_var)::in,
|
|
list(prog_var)::in, list(byte_var)::out) is det.
|
|
|
|
map_vars_2(_VarMap, [], []).
|
|
map_vars_2(VarMap, [Var | Vars], [ByteVar | ByteVars]) :-
|
|
map.lookup(VarMap, Var, ByteVar),
|
|
map_vars_2(VarMap, Vars, ByteVars).
|
|
|
|
:- pred map_var(byte_info::in, prog_var::in,
|
|
byte_var::out) is det.
|
|
|
|
map_var(ByteInfo, Var, ByteVar) :-
|
|
map.lookup(ByteInfo ^ byteinfo_varmap, Var, ByteVar).
|
|
|
|
:- pred get_var_type(byte_info::in, prog_var::in,
|
|
mer_type::out) is det.
|
|
|
|
get_var_type(ByteInfo, Var, Type) :-
|
|
lookup_var_type(ByteInfo ^ byteinfo_vartypes, Var, Type).
|
|
|
|
:- pred get_next_label(int::out, byte_info::in, byte_info::out)
|
|
is det.
|
|
|
|
get_next_label(Label, !ByteInfo) :-
|
|
LabelCounter0 = !.ByteInfo ^ byteinfo_label_counter,
|
|
counter.allocate(Label, LabelCounter0, LabelCounter),
|
|
!ByteInfo ^ byteinfo_label_counter := LabelCounter.
|
|
|
|
:- pred get_next_temp(int::out, byte_info::in, byte_info::out)
|
|
is det.
|
|
|
|
get_next_temp(Temp, !ByteInfo) :-
|
|
TempCounter0 = !.ByteInfo ^ byteinfo_temp_counter,
|
|
counter.allocate(Temp, TempCounter0, TempCounter),
|
|
!ByteInfo ^ byteinfo_temp_counter := TempCounter.
|
|
|
|
:- pred get_counts(byte_info::in, int::out, int::out) is det.
|
|
|
|
get_counts(ByteInfo0, Label, Temp) :-
|
|
LabelCounter0 = ByteInfo0 ^ byteinfo_label_counter,
|
|
counter.allocate(Label, LabelCounter0, _LabelCounter),
|
|
TempCounter0 = ByteInfo0 ^ byteinfo_temp_counter,
|
|
counter.allocate(Temp, TempCounter0, _TempCounter).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred get_is_func(pred_info::in, byte_is_func::out) is det.
|
|
|
|
get_is_func(PredInfo, IsFunc) :-
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
IsFunc = 0
|
|
;
|
|
PredOrFunc = pf_function,
|
|
IsFunc = 1
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module bytecode_backend.bytecode_gen.
|
|
%---------------------------------------------------------------------------%
|