[m-rev.] for review: float registers
Peter Wang
novalazy at gmail.com
Fri Sep 9 15:33:34 AEST 2011
Branches: main
Add float registers to the Mercury abstract machine, implemented as simply an
array of MR_Float in the Mercury engine structure.
Float registers are only useful if a Mercury `float' is wider than a word
(i.e. when using double precision floats on 32-bit platforms) so we let them
exist only then. In other cases floats may simply be passed via the regular
registers, as before.
Currently, higher order calls still require the use of the regular registers
for all arguments. As all exported procedures are potentially the target of
higher order calls, exported procedures must use only the regular registers for
argument passing. This can lead to more (un)boxing than if floats were simply
always boxed. Until this is solved, float registers must be enabled explicitly
with the developer only option `--use-float-registers'.
The other aspect of this change is using two consecutive stack slots to hold a
single double variable. Without that, the benefit of passing unboxed floats
via dedicated float registers would be largely eroded.
compiler/options.m:
Add developer option `--use-float-registers'.
compiler/handle_options.m:
Disable `--use-float-registers' if floats are not wider than words.
compiler/make_hlds_passes.m:
If `--use-float-registers' is in effect, enable a previous change that
allows float constructor arguments to be stored unboxed in structures.
compiler/hlds_llds.m:
Move `reg_type' here from llds.m and `reg_f' option.
Add stack slot width to `stack_slot' type.
Add register type and stack slot width to `abs_locn' type.
Remember next available float register in `abs_follow_vars'.
compiler/hlds_pred.m:
Add register type to `arg_loc' type.
compiler/llds.m:
Add a new kind of lval: double-width stack slots.
These are used to hold double-precision floating point values only.
Record setting of `--use-float-registers' in exprn_opts.
Conform to addition of float registers and double stack slots.
compiler/code_info.m:
Make predicates take the register type as an argument,
where it can no longer be assumed.
Remember whether float registers are being used.
Remember max float register for calls to MR_trace.
Count double width stack slots as two slots.
compiler/arg_info.m:
Allocate float registers for procedure arguments when appropriate.
Delete unused predicates.
compiler/var_locn.m:
Make predicates working with registers either take the register type as
an argument, or handle both register types at once.
Select float registers for variables when appropriate.
compiler/call_gen.m:
Explicitly use regular registers for all higher-order calls,
which was implicit before.
compiler/pragma_c_gen.m:
Use float registers, when available, at the interface between Mercury
code and C foreign_procs.
compiler/export.m:
Whether a float rval needs to be boxed/unboxed when assigned to/from a
register depends on the register type.
compiler/fact_table.m:
Use float registers for arguments to predicates defined by fact tables.
compiler/stack_alloc.m:
Allocate two consecutive stack slots for float variables when
appropriate.
compiler/stack_layout.m:
Represent double-width stack slots in procedure layout structures.
Conform to changes.
compiler/store_alloc.m:
Allocate float registers (if they exist) for float variables.
compiler/use_local_vars.m:
Substitute float abstract machine registers with MR_Float local
variables.
compiler/llds_out_data.m:
compiler/llds_out_instr.m:
Output float registers and double stack slots.
compiler/code_util.m:
compiler/follow_vars.m:
Count float registers separately from regular registers.
compiler/layout.m:
compiler/layout_out.m:
compiler/trace_gen.m:
Remember the max used float register for calls to MR_trace().
compiler/builtin_lib_types.m:
Fix incorrect definition of float_type_ctor.
compiler/bytecode_gen.m:
compiler/continuation_info.m:
compiler/disj_gen.m:
compiler/dupelim.m:
compiler/exprn_aux.m:
compiler/global_data.m:
compiler/hlds_out_goal.m:
compiler/jumpopt.m:
compiler/llds_to_x86_64.m:
compiler/lookup_switch.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/par_conj_gen.m:
compiler/proc_gen.m:
compiler/string_switch.m:
compiler/tag_switch.m:
compiler/tupling.m:
compiler/x86_64_regs.m:
Conform to changes.
runtime/mercury_engine.h:
Add an array of fake float "registers" to the Mercury engine structure,
when MR_Float is wider than MR_Word.
runtime/mercury_regs.h:
Document float registers in the Mercury abstract machine.
Add macros to access float registers in the Mercury engine.
runtime/mercury_stack_layout.h:
Add new MR_LongLval cases to represent double-width stack slots.
MR_LONG_LVAL_TAGBITS had to be increased to accomodate the new cases,
which increases the number of integers in [0, 2^MR_LONG_LVAL_TAGBITS)
equal to 0 modulo 4. These are the new MR_LONG_LVAL_TYPE_CONS_n cases.
Add max float register field to MR_ExecTrace.
runtime/mercury_layout_util.c:
runtime/mercury_layout_util.h:
Extend MR_copy_regs_to_saved_regs and MR_copy_saved_regs_to_regs
for float registers.
Understand how to look up new kinds of MR_LongLval: MR_LONG_LVAL_TYPE_F
(previously unused), MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR,
MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR.
Conform to the new MR_LONG_LVAL_TYPE_CONS_n cases.
runtime/mercury_float.h:
Delete redundant #ifdef.
runtime/mercury_accurate_gc.c:
runtime/mercury_agc_debug.c:
Conform to changes (untested).
trace/mercury_trace.c:
trace/mercury_trace.h:
trace/mercury_trace_declarative.c:
trace/mercury_trace_external.c:
trace/mercury_trace_internal.c:
trace/mercury_trace_spy.c:
trace/mercury_trace_vars.c:
trace/mercury_trace_vars.h:
Handle float registers in the trace subsystem. This is mostly a matter
of saving/restoring them as with regular registers.
diff --git a/compiler/arg_info.m b/compiler/arg_info.m
index 574645b..0c06ac2 100644
--- a/compiler/arg_info.m
+++ b/compiler/arg_info.m
@@ -27,6 +27,7 @@
:- interface.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.prog_data.
@@ -45,14 +46,14 @@
% Annotate a single procedure with information
% about its argument passing interface.
%
-:- pred generate_proc_arg_info(list(mer_type)::in, module_info::in,
- proc_info::in, proc_info::out) is det.
+:- pred generate_proc_arg_info(import_status::in, list(mer_type)::in,
+ module_info::in, proc_info::in, proc_info::out) is det.
% Given the list of types and modes of the arguments of a procedure
% and its code model, return its argument passing interface.
%
:- pred make_arg_infos(list(mer_type)::in, list(mer_mode)::in, code_model::in,
- module_info::in, list(arg_info)::out) is det.
+ module_info::in, reg_type::in, list(arg_info)::out) is det.
% Divide the given list of arguments into those treated as inputs
% by the calling convention and those treated as outputs.
@@ -61,11 +62,6 @@
list(prog_var)::in, list(mer_mode)::in, list(mer_type)::in,
list(prog_var)::out, list(prog_var)::out) is det.
- % Return the arg_infos for the two input arguments of a unification
- % of the specified code model.
- %
-:- pred unify_arg_info(code_model::in, list(arg_info)::out) is det.
-
% Divide the given list of arguments and the arg_infos into three lists:
% the inputs, the outputs, and the unused arguments, in that order.
%
@@ -114,7 +110,12 @@
:- implementation.
:- import_module check_hlds.mode_util.
+:- import_module hlds.hlds_pred.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module parse_tree.builtin_lib_types.
+:- import_module bool.
:- import_module map.
:- import_module pair.
:- import_module require.
@@ -149,10 +150,12 @@ generate_proc_list_arg_info(PredId, [ProcId | ProcIds], !ModuleInfo) :-
module_info_get_preds(!.ModuleInfo, PredTable0),
map.lookup(PredTable0, PredId, PredInfo0),
pred_info_get_procedures(PredInfo0, ProcTable0),
+ pred_info_get_import_status(PredInfo0, Status),
pred_info_get_arg_types(PredInfo0, ArgTypes),
map.lookup(ProcTable0, ProcId, ProcInfo0),
- generate_proc_arg_info(ArgTypes, !.ModuleInfo, ProcInfo0, ProcInfo),
+ generate_proc_arg_info(Status, ArgTypes, !.ModuleInfo,
+ ProcInfo0, ProcInfo),
map.det_update(ProcId, ProcInfo, ProcTable0, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
@@ -160,12 +163,42 @@ generate_proc_list_arg_info(PredId, [ProcId | ProcIds], !ModuleInfo) :-
module_info_set_preds(PredTable, !ModuleInfo),
generate_proc_list_arg_info(PredId, ProcIds, !ModuleInfo).
-generate_proc_arg_info(ArgTypes, ModuleInfo, !ProcInfo) :-
+generate_proc_arg_info(Status, ArgTypes, ModuleInfo, !ProcInfo) :-
proc_info_get_argmodes(!.ProcInfo, ArgModes),
+ proc_info_get_is_address_taken(!.ProcInfo, AddressTaken),
CodeModel = proc_info_interface_code_model(!.ProcInfo),
- make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo),
+ (
+ % If the procedure may be invoked via a higher order call, we cannot
+ % use the float registers. In the future we will want to introduce
+ % wrappers, as in MLDS grades, which unbox their arguments and call
+ % the underlying procedure which does use float registers.
+ (
+ Status \= status_local
+ ;
+ AddressTaken = address_is_taken
+ )
+ ->
+ FloatRegType = reg_r
+ ;
+ reg_type_for_float(ModuleInfo, FloatRegType)
+ ),
+ make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, FloatRegType,
+ ArgInfo),
proc_info_set_arg_info(ArgInfo, !ProcInfo).
+:- pred reg_type_for_float(module_info::in, reg_type::out) is det.
+
+reg_type_for_float(ModuleInfo, FloatRegType) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, use_float_registers, UseFloatRegs),
+ (
+ UseFloatRegs = yes,
+ FloatRegType = reg_f
+ ;
+ UseFloatRegs = no,
+ FloatRegType = reg_r
+ ).
+
%---------------------------------------------------------------------------%
% This is the useful part of the code ;-).
@@ -176,56 +209,80 @@ generate_proc_arg_info(ArgTypes, ModuleInfo, !ProcInfo) :-
% runtime and the library that also rely on it.
%
% We assume all input arguments always go in sequentially numbered
- % registers starting at register number 1. We also assume that all output
- % arguments go in sequentially numbered registers starting at register
- % number 1, except for model_semi procedures, where the first register is
- % reserved for the result and hence the output arguments start at register
- % number 2.
+ % registers starting at registers r1 and f1. We also assume that all output
+ % arguments go in sequentially numbered registers starting at r1 and f1,
+ % except for model_semi procedures, where r1 is reserved for the result and
+ % hence the output arguments start at registers r2 and f1.
%
- % We allocate unused args as if they were outputs. The calling convention
- % requires that we allocate them a register, and the choice should not
- % matter since unused args should be rare. However, we do have to make
- % sure that all the predicates in this module implement this decision
- % consistently. (No code outside this module should know about the outcome
- % of this decision.)
+ % We allocate unused args as if they were regular (non-floating point)
+ % outputs. The calling convention requires that we allocate them a
+ % register, and the choice should not matter since unused args should be
+ % rare. However, we do have to make sure that all the predicates in this
+ % module implement this decision consistently. (No code outside this module
+ % should know about the outcome of this decision.)
%
-make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo) :-
+make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, FloatRegType,
+ ArgInfo) :-
(
CodeModel = model_semi,
- StartReg = 2
+ FirstOutRegR = 2
;
( CodeModel = model_det
; CodeModel = model_non
),
- StartReg = 1
+ FirstOutRegR = 1
),
- make_arg_infos_list(ArgModes, ArgTypes, 1, StartReg, ModuleInfo, ArgInfo).
+ FirstInRegR = 1,
+ FirstInRegF = 1,
+ FirstOutRegF = 1,
+ make_arg_infos_list(ArgModes, ArgTypes, FirstInRegR, FirstInRegF,
+ FirstOutRegR, FirstOutRegF, ModuleInfo, FloatRegType, ArgInfo).
:- pred make_arg_infos_list(list(mer_mode)::in, list(mer_type)::in,
- int::in, int::in, module_info::in, list(arg_info)::out) is det.
+ int::in, int::in, int::in, int::in, module_info::in, reg_type::in,
+ list(arg_info)::out) is det.
-make_arg_infos_list([], [], _, _, _, []).
-make_arg_infos_list([Mode | Modes], [Type | Types], !.InReg, !.OutReg,
- ModuleInfo, [ArgInfo | ArgInfos]) :-
+make_arg_infos_list([], [], _, _, _, _, _, _, []).
+make_arg_infos_list([Mode | Modes], [Type | Types],
+ !.InRegR, !.InRegF, !.OutRegR, !.OutRegF,
+ ModuleInfo, FloatRegType, [ArgInfo | ArgInfos]) :-
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
+ ( Type = float_type ->
+ RegType = FloatRegType
+ ;
+ RegType = reg_r
+ ),
(
ArgMode = top_in,
- ArgReg = !.InReg,
- !:InReg = !.InReg + 1
+ get_arg_loc(RegType, ArgLoc, !InRegR, !InRegF)
;
( ArgMode = top_out
; ArgMode = top_unused
),
- ArgReg = !.OutReg,
- !:OutReg = !.OutReg + 1
+ get_arg_loc(RegType, ArgLoc, !OutRegR, !OutRegF)
),
- ArgInfo = arg_info(ArgReg, ArgMode),
- make_arg_infos_list(Modes, Types, !.InReg, !.OutReg, ModuleInfo, ArgInfos).
-make_arg_infos_list([], [_|_], _, _, _, _) :-
+ ArgInfo = arg_info(ArgLoc, ArgMode),
+ make_arg_infos_list(Modes, Types, !.InRegR, !.InRegF, !.OutRegR, !.OutRegF,
+ ModuleInfo, FloatRegType, ArgInfos).
+make_arg_infos_list([], [_|_], _, _, _, _, _, _, _) :-
unexpected($module, $pred, "length mismatch").
-make_arg_infos_list([_|_], [], _, _, _, _) :-
+make_arg_infos_list([_|_], [], _, _, _, _, _, _, _) :-
unexpected($module, $pred, "length mismatch").
+:- pred get_arg_loc(reg_type::in, arg_loc::out, int::in, int::out,
+ int::in, int::out) is det.
+
+get_arg_loc(RegType, ArgLoc, !RegR, !RegF) :-
+ (
+ RegType = reg_r,
+ ArgLoc = reg(reg_r, !.RegR),
+ !:RegR = !.RegR + 1
+ ;
+ RegType = reg_f,
+ ArgLoc = reg(reg_f, !.RegF),
+ !:RegF = !.RegF + 1
+ ).
+
%---------------------------------------------------------------------------%
compute_in_and_out_vars(ModuleInfo, Vars, Modes, Types,
@@ -261,15 +318,6 @@ compute_in_and_out_vars_2(ModuleInfo, [Var | Vars],
%---------------------------------------------------------------------------%
-unify_arg_info(model_det,
- [arg_info(1, top_in), arg_info(2, top_in)]).
-unify_arg_info(model_semi,
- [arg_info(1, top_in), arg_info(2, top_in)]).
-unify_arg_info(model_non, _) :-
- unexpected($module, $pred, "nondet unify!").
-
-%---------------------------------------------------------------------------%
-
partition_args(Args, Ins, Outs) :-
partition_args(Args, Ins, Outs0, Unuseds),
list.append(Outs0, Unuseds, Outs).
@@ -291,22 +339,6 @@ partition_args([Var - ArgInfo | Rest], !:Ins, !:Outs, !:Unuseds) :-
%---------------------------------------------------------------------------%
-:- pred input_args(list(arg_info)::in, list(arg_loc)::out) is det.
-
-input_args([], []).
-input_args([arg_info(Loc, Mode) | Args], !:Locs) :-
- input_args(Args, !:Locs),
- (
- Mode = top_in,
- !:Locs = [Loc | !.Locs]
- ;
- Mode = top_out
- ;
- Mode = top_unused
- ).
-
-%---------------------------------------------------------------------------%
-
partition_proc_args(ProcInfo, ModuleInfo, Inputs, Outputs, Unuseds) :-
proc_info_get_headvars(ProcInfo, Vars),
proc_info_get_argmodes(ProcInfo, Modes),
diff --git a/compiler/builtin_lib_types.m b/compiler/builtin_lib_types.m
index 8e3ff75..0d4f468 100644
--- a/compiler/builtin_lib_types.m
+++ b/compiler/builtin_lib_types.m
@@ -213,7 +213,7 @@ future_type(ValueType) = defined_type(Name, [ValueType], kind_star) :-
int_type_ctor = type_ctor(Name, 0) :-
Name = unqualified("int").
float_type_ctor = type_ctor(Name, 0) :-
- Name = unqualified("int").
+ Name = unqualified("float").
char_type_ctor = type_ctor(Name, 0) :-
Name = unqualified("character").
string_type_ctor = type_ctor(Name, 0) :-
diff --git a/compiler/bytecode_gen.m b/compiler/bytecode_gen.m
index bd02f08..168de21 100644
--- a/compiler/bytecode_gen.m
+++ b/compiler/bytecode_gen.m
@@ -55,6 +55,7 @@
:- 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 ll_backend.
@@ -329,7 +330,14 @@ gen_places([], _, empty).
gen_places([Var - Loc | OutputArgs], ByteInfo, Code) :-
gen_places(OutputArgs, ByteInfo, OtherCode),
map_var(ByteInfo, Var, ByteVar),
- Code = singleton(byte_place_arg(byte_reg_r, Loc, ByteVar)) ++ OtherCode.
+ (
+ Loc = reg(reg_r, RegNum)
+ ;
+ Loc = reg(reg_f, _),
+ sorry($module, $pred, "floating point register")
+ ),
+ Code = singleton(byte_place_arg(byte_reg_r, RegNum, ByteVar)) ++
+ OtherCode.
:- pred gen_pickups(list(pair(prog_var, arg_loc))::in,
byte_info::in, byte_tree::out) is det.
@@ -338,7 +346,14 @@ gen_pickups([], _, empty).
gen_pickups([Var - Loc | OutputArgs], ByteInfo, Code) :-
gen_pickups(OutputArgs, ByteInfo, OtherCode),
map_var(ByteInfo, Var, ByteVar),
- Code = singleton(byte_pickup_arg(byte_reg_r, Loc, ByteVar)) ++ OtherCode.
+ (
+ Loc = reg(reg_r, RegNum)
+ ;
+ Loc = reg(reg_f, _),
+ sorry($module, $pred, "floating point register")
+ ),
+ Code = singleton(byte_pickup_arg(byte_reg_r, RegNum, ByteVar)) ++
+ OtherCode.
%---------------------------------------------------------------------------%
@@ -351,7 +366,10 @@ 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_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfo),
+ % Higher order calls use regular registers for all arguments.
+ FloatRegType = reg_r,
+ make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, FloatRegType,
+ ArgInfo),
assoc_list.from_corresponding_lists(ArgVars, ArgInfo, ArgVarsInfos),
arg_info.partition_args(ArgVarsInfos, InVars, OutVars),
diff --git a/compiler/call_gen.m b/compiler/call_gen.m
index d5de3aa..bdcdd5b 100644
--- a/compiler/call_gen.m
+++ b/compiler/call_gen.m
@@ -212,9 +212,9 @@ generate_main_generic_call(_OuterCodeModel, GenericCall, Args, Modes, Det,
FirstOutput = 1
),
- give_vars_consecutive_arg_infos(InVars, FirstImmInput, top_in,
+ give_vars_consecutive_arg_infos(InVars, reg_r, FirstImmInput, top_in,
InVarArgInfos),
- give_vars_consecutive_arg_infos(OutVars, FirstOutput, top_out,
+ give_vars_consecutive_arg_infos(OutVars, reg_r, FirstOutput, top_out,
OutArgsInfos),
ArgInfos = SpecifierArgInfos ++ InVarArgInfos ++ OutArgsInfos,
@@ -349,7 +349,8 @@ generic_call_info(Globals, GenericCall, NumInputArgs, CodeAddr,
SpecifierArgInfos, FirstImmediateInputReg, HoCallVariant) :-
(
GenericCall = higher_order(PredVar, _, _, _),
- SpecifierArgInfos = [PredVar - arg_info(1, top_in)],
+ Reg = reg(reg_r, 1),
+ SpecifierArgInfos = [PredVar - arg_info(Reg, top_in)],
globals.lookup_int_option(Globals,
max_specialized_do_call_closure, MaxSpec),
(
@@ -366,7 +367,8 @@ generic_call_info(Globals, GenericCall, NumInputArgs, CodeAddr,
)
;
GenericCall = class_method(TCVar, _, _, _),
- SpecifierArgInfos = [TCVar - arg_info(1, top_in)],
+ Reg = reg(reg_r, 1),
+ SpecifierArgInfos = [TCVar - arg_info(Reg, top_in)],
globals.lookup_int_option(Globals,
max_specialized_do_call_class_method, MaxSpec),
(
@@ -771,15 +773,15 @@ generate_call_vn_livevals(InputArgLocs, OutputArgs, Code, !CI) :-
%---------------------------------------------------------------------------%
-:- pred give_vars_consecutive_arg_infos(list(prog_var)::in, int::in,
- arg_mode::in, assoc_list(prog_var, arg_info)::out) is det.
+:- pred give_vars_consecutive_arg_infos(list(prog_var)::in,
+ reg_type::in, int::in, arg_mode::in, assoc_list(prog_var, arg_info)::out)
+ is det.
-give_vars_consecutive_arg_infos([], _N, _M, []).
-give_vars_consecutive_arg_infos([Var | Vars], N0, ArgMode,
+give_vars_consecutive_arg_infos([], _RegType, _N, _M, []).
+give_vars_consecutive_arg_infos([Var | Vars], RegType, N, ArgMode,
[Var - ArgInfo | ArgInfos]) :-
- ArgInfo = arg_info(N0, ArgMode),
- N1 = N0 + 1,
- give_vars_consecutive_arg_infos(Vars, N1, ArgMode, ArgInfos).
+ ArgInfo = arg_info(reg(RegType, N), ArgMode),
+ give_vars_consecutive_arg_infos(Vars, RegType, N + 1, ArgMode, ArgInfos).
%---------------------------------------------------------------------------%
:- end_module call_gen.
diff --git a/compiler/code_info.m b/compiler/code_info.m
index f1129e4..b7e25a2 100644
--- a/compiler/code_info.m
+++ b/compiler/code_info.m
@@ -208,9 +208,9 @@
:- pred get_closure_layouts(code_info::in, list(closure_proc_id_data)::out)
is det.
-:- pred get_max_reg_in_use_at_trace(code_info::in, int::out) is det.
+:- pred get_max_reg_in_use_at_trace(code_info::in, int::out, int::out) is det.
-:- pred set_max_reg_in_use_at_trace(int::in,
+:- pred set_max_reg_in_use_at_trace(int::in, int::in,
code_info::in, code_info::out) is det.
% Get the flag which is true iff the procedure has so far
@@ -459,13 +459,14 @@
% Closure layout structures generated by this procedure.
cip_closure_layouts :: list(closure_proc_id_data),
- % At each call to MR_trace, we compute the highest rN register
- % number that contains a useful value. This slot contains the
+ % At each call to MR_trace, we compute the highest rN and fN
+ % registers that contain useful values. These slot contain the
% maximum of these highest values. Therefore at all calls to
% MR_trace in the procedure, we need only save the registers
% whose numbers are equal to or smaller than this field.
% This slot contains -1 if tracing is not enabled.
- cip_max_reg_used :: int,
+ cip_max_reg_r_used :: int,
+ cip_max_reg_f_used :: int,
% True iff the procedure has created one or more temporary
% nondet frames.
@@ -500,6 +501,14 @@ code_info_init(SaveSuccip, Globals, PredId, ProcId, PredInfo, ProcInfo,
proc_info_get_vartypes(ProcInfo, VarTypes),
proc_info_get_stack_slots(ProcInfo, StackSlots),
ExprnOpts = init_exprn_opts(Globals),
+ globals.lookup_bool_option(Globals, use_float_registers, UseFloatRegs),
+ (
+ UseFloatRegs = yes,
+ FloatRegType = reg_f
+ ;
+ UseFloatRegs = no,
+ FloatRegType = reg_r
+ ),
globals.get_trace_level(Globals, TraceLevel),
(
eff_trace_level_is_none(ModuleInfo, PredInfo, ProcInfo, TraceLevel)
@@ -512,8 +521,8 @@ code_info_init(SaveSuccip, Globals, PredId, ProcId, PredInfo, ProcInfo,
MaybeFailVars = no,
EffLiveness = Liveness
),
- init_var_locn_state(ArgList, EffLiveness, VarSet, VarTypes, StackSlots,
- FollowVars, VarLocnInfo),
+ init_var_locn_state(ArgList, EffLiveness, VarSet, VarTypes, FloatRegType,
+ StackSlots, FollowVars, VarLocnInfo),
stack.init(ResumePoints),
globals.lookup_bool_option(Globals, allow_hijacks, AllowHijack),
(
@@ -600,6 +609,7 @@ code_info_init(SaveSuccip, Globals, PredId, ProcId, PredInfo, ProcInfo,
counter.init(1),
[],
-1,
+ -1,
no,
StaticCellInfo,
set_tree234.init,
@@ -648,6 +658,14 @@ init_exprn_opts(Globals) = ExprnOpts :-
OptUBF = no,
UBF = do_not_have_unboxed_floats
),
+ globals.lookup_bool_option(Globals, use_float_registers, OptFloatRegs),
+ (
+ OptFloatRegs = yes,
+ UseFloatRegs = use_float_registers
+ ;
+ OptFloatRegs = no,
+ UseFloatRegs = do_not_use_float_registers
+ ),
globals.lookup_bool_option(Globals, static_ground_floats, OptSGFloat),
(
OptSGFloat = yes,
@@ -665,7 +683,8 @@ init_exprn_opts(Globals) = ExprnOpts :-
OptStaticCodeAddr = no,
StaticCodeAddrs = do_not_have_static_code_addresses
),
- ExprnOpts = exprn_opts(NLG, ASM, UBF, SGCell, SGFloat, StaticCodeAddrs).
+ ExprnOpts = exprn_opts(NLG, ASM, UBF, UseFloatRegs, SGCell, SGFloat,
+ StaticCodeAddrs).
:- pred init_maybe_trace_info(trace_level::in, globals::in,
module_info::in, pred_info::in, proc_info::in, trace_slot_info::out,
@@ -730,7 +749,9 @@ get_persistent_temps(CI, CI ^ code_info_persistent ^ cip_persistent_temps).
get_closure_seq_counter(CI,
CI ^ code_info_persistent ^ cip_closure_layout_seq).
get_closure_layouts(CI, CI ^ code_info_persistent ^ cip_closure_layouts).
-get_max_reg_in_use_at_trace(CI, CI ^ code_info_persistent ^ cip_max_reg_used).
+get_max_reg_in_use_at_trace(CI, MaxRegR, MaxRegF) :-
+ MaxRegR = CI ^ code_info_persistent ^ cip_max_reg_r_used,
+ MaxRegF = CI ^ code_info_persistent ^ cip_max_reg_f_used.
get_created_temp_frame(CI, CI ^ code_info_persistent ^ cip_created_temp_frame).
get_static_cell_info(CI, CI ^ code_info_persistent ^ cip_static_cell_info).
get_alloc_sites(CI, CI ^ code_info_persistent ^ cip_alloc_sites).
@@ -763,8 +784,9 @@ set_closure_seq_counter(CLS, CI,
CI ^ code_info_persistent ^ cip_closure_layout_seq := CLS).
set_closure_layouts(CG, CI,
CI ^ code_info_persistent ^ cip_closure_layouts := CG).
-set_max_reg_in_use_at_trace(MR, CI,
- CI ^ code_info_persistent ^ cip_max_reg_used := MR).
+set_max_reg_in_use_at_trace(MR, MF, !CI) :-
+ !CI ^ code_info_persistent ^ cip_max_reg_r_used := MR,
+ !CI ^ code_info_persistent ^ cip_max_reg_f_used := MF.
set_created_temp_frame(MR, CI,
CI ^ code_info_persistent ^ cip_created_temp_frame := MR).
set_static_cell_info(SCI, CI,
@@ -802,7 +824,7 @@ get_containing_goal_map_det(CI, ContainingGoalMap) :-
% Get the integer that gives the number of the next
% non-reserved register.
%
-:- pred get_next_non_reserved(code_info::in, int::out) is det.
+:- pred get_next_non_reserved(code_info::in, reg_type::in, int::out) is det.
% Set the table that contains advice about where
% variables should be put.
@@ -951,9 +973,9 @@ get_follow_var_map(CI, FollowVarMap) :-
get_var_locn_info(CI, VarLocnInfo),
var_locn_get_follow_var_map(VarLocnInfo, FollowVarMap).
-get_next_non_reserved(CI, NextNonReserved) :-
+get_next_non_reserved(CI, RegType, NextNonReserved) :-
get_var_locn_info(CI, VarLocnInfo),
- var_locn_get_next_non_reserved(VarLocnInfo, NextNonReserved).
+ var_locn_get_next_non_reserved(VarLocnInfo, RegType, NextNonReserved).
set_follow_vars(FollowVars, !CI) :-
get_var_locn_info(!.CI, VarLocnInfo0),
@@ -1314,8 +1336,8 @@ generate_branch_end(StoreMap, MaybeEnd0, MaybeEnd, Code, !CI) :-
% must in any case be annotated with its own follow_var set.
map.to_assoc_list(StoreMap, AbsVarLocs),
assoc_list.values(AbsVarLocs, AbsLocs),
- code_util.max_mentioned_abs_reg(AbsLocs, MaxMentionedReg),
- set_follow_vars(abs_follow_vars(StoreMap, MaxMentionedReg + 1), !CI),
+ code_util.max_mentioned_abs_regs(AbsLocs, MaxRegR, MaxRegF),
+ set_follow_vars(abs_follow_vars(StoreMap, MaxRegR + 1, MaxRegF + 1), !CI),
get_instmap(!.CI, InstMap),
( instmap_is_reachable(InstMap) ->
VarLocs = assoc_list.map_values_only(abs_locn_to_lval, AbsVarLocs),
@@ -3357,17 +3379,20 @@ make_vars_forward_live_2([Var | Vars], StackSlots, N0, !VarLocnInfo) :-
Lval = stack_slot_to_lval(Slot),
N1 = N0
;
- find_unused_reg(!.VarLocnInfo, N0, N1),
- Lval = reg(reg_r, N1)
+ % reg_r is fine since we don't care where the variables are put.
+ RegType = reg_r,
+ find_unused_reg(!.VarLocnInfo, RegType, N0, N1),
+ Lval = reg(RegType, N1)
),
var_locn_set_magic_var_location(Var, Lval, !VarLocnInfo),
make_vars_forward_live_2(Vars, StackSlots, N1, !VarLocnInfo).
-:- pred find_unused_reg(var_locn_info::in, int::in, int::out) is det.
+:- pred find_unused_reg(var_locn_info::in, reg_type::in, int::in, int::out)
+ is det.
-find_unused_reg(VLI, N0, N) :-
- ( var_locn_lval_in_use(VLI, reg(reg_r, N0)) ->
- find_unused_reg(VLI, N0 + 1, N)
+find_unused_reg(VLI, RegType, N0, N) :-
+ ( var_locn_lval_in_use(VLI, reg(RegType, N0)) ->
+ find_unused_reg(VLI, RegType, N0 + 1, N)
;
N = N0
).
@@ -3743,10 +3768,10 @@ should_add_region_ops(CodeInfo, _GoalInfo) = AddRegionOps :-
:- pred materialize_vars_in_lval(lval::in, lval::out,
llds_code::out, code_info::in, code_info::out) is det.
-:- pred acquire_reg_for_var(prog_var::in, lval::out,
+:- pred acquire_reg_for_var(prog_var::in, reg_type::in, lval::out,
code_info::in, code_info::out) is det.
-:- pred acquire_reg_not_in_storemap(abs_store_map::in, lval::out,
+:- pred acquire_reg_not_in_storemap(abs_store_map::in, reg_type::in, lval::out,
code_info::in, code_info::out) is det.
:- pred acquire_reg(reg_type::in, lval::out,
@@ -3784,7 +3809,7 @@ should_add_region_ops(CodeInfo, _GoalInfo) = AddRegionOps :-
:- pred setup_return(assoc_list(prog_var, arg_info)::in,
set(lval)::out, llds_code::out, code_info::in, code_info::out) is det.
-:- pred lock_regs(int::in, assoc_list(prog_var, lval)::in,
+:- pred lock_regs(int::in, int::in, assoc_list(prog_var, lval)::in,
code_info::in, code_info::out) is det.
:- pred unlock_regs(code_info::in, code_info::out) is det.
@@ -3804,7 +3829,7 @@ should_add_region_ops(CodeInfo, _GoalInfo) = AddRegionOps :-
:- pred save_variables_on_stack(list(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred max_reg_in_use(code_info::in, int::out) is det.
+:- pred max_reg_in_use(code_info::in, int::out, int::out) is det.
:- pred magically_put_var_in_unused_reg(prog_var::in,
code_info::in, code_info::out) is det.
@@ -3983,57 +4008,63 @@ materialize_vars_in_lval(Lval0, Lval, Code, !CI) :-
VarLocnInfo0, VarLocnInfo),
set_var_locn_info(VarLocnInfo, !CI).
-acquire_reg_for_var(Var, Lval, !CI) :-
+acquire_reg_for_var(Var, RegType, Lval, !CI) :-
get_follow_var_map(!.CI, FollowVarsMap),
- get_next_non_reserved(!.CI, NextNonReserved),
+ get_next_non_reserved(!.CI, RegType, NextNonReserved),
get_var_locn_info(!.CI, VarLocnInfo0),
(
map.search(FollowVarsMap, Var, PrefLocn),
- PrefLocn = abs_reg(PrefRegNum),
+ PrefLocn = abs_reg(RegType, PrefRegNum),
PrefRegNum >= 1
->
- var_locn_acquire_reg_prefer_given(PrefRegNum, Lval,
- VarLocnInfo0, VarLocnInfo)
+ var_locn_acquire_reg_prefer_given(RegType, PrefRegNum, Lval,
+ VarLocnInfo0, VarLocnInfo)
;
% XXX We should only get a register if the map.search succeeded;
% otherwise we should put the var in its stack slot.
- var_locn_acquire_reg_start_at_given(NextNonReserved, Lval,
+ var_locn_acquire_reg_start_at_given(RegType, NextNonReserved, Lval,
VarLocnInfo0, VarLocnInfo)
),
set_var_locn_info(VarLocnInfo, !CI).
-acquire_reg_not_in_storemap(StoreMap, Lval, !CI) :-
- map.foldl(record_highest_used_reg, StoreMap, 0, HighestUsedRegNum),
+acquire_reg_not_in_storemap(StoreMap, RegType, Lval, !CI) :-
+ map.foldl2(record_highest_used_reg, StoreMap, 0, HighestUsedRegR,
+ 0, HighestUsedRegF),
get_var_locn_info(!.CI, VarLocnInfo0),
- var_locn_acquire_reg_start_at_given(HighestUsedRegNum + 1, Lval,
+ (
+ RegType = reg_r,
+ NextRegNum = HighestUsedRegR + 1
+ ;
+ RegType = reg_f,
+ NextRegNum = HighestUsedRegF + 1
+ ),
+ var_locn_acquire_reg_start_at_given(RegType, NextRegNum, Lval,
VarLocnInfo0, VarLocnInfo),
set_var_locn_info(VarLocnInfo, !CI).
-:- pred record_highest_used_reg(prog_var::in, abs_locn::in, int::in, int::out)
- is det.
+:- pred record_highest_used_reg(prog_var::in, abs_locn::in, int::in, int::out,
+ int::in, int::out) is det.
-record_highest_used_reg(_, AbsLocn, !HighestUsedRegNum) :-
+record_highest_used_reg(_, AbsLocn, !HighestUsedRegR, !HighestUsedRegF) :-
(
AbsLocn = any_reg
;
- AbsLocn = abs_reg(N),
- ( N > !.HighestUsedRegNum ->
- !:HighestUsedRegNum = N
- ;
- true
- )
+ AbsLocn = abs_reg(reg_r, N),
+ int.max(N, !HighestUsedRegR)
+ ;
+ AbsLocn = abs_reg(reg_f, N),
+ int.max(N, !HighestUsedRegF)
;
- AbsLocn = abs_stackvar(_)
+ AbsLocn = abs_stackvar(_, _)
;
- AbsLocn = abs_parent_stackvar(_)
+ AbsLocn = abs_parent_stackvar(_, _)
;
- AbsLocn = abs_framevar(_)
+ AbsLocn = abs_framevar(_, _)
).
acquire_reg(Type, Lval, !CI) :-
get_var_locn_info(!.CI, VarLocnInfo0),
- expect(unify(Type, reg_r), $module, $pred, "unknown reg type"),
- var_locn_acquire_reg(Lval, VarLocnInfo0, VarLocnInfo),
+ var_locn_acquire_reg(Type, Lval, VarLocnInfo0, VarLocnInfo),
set_var_locn_info(VarLocnInfo, !CI).
release_reg(Lval, !CI) :-
@@ -4184,9 +4215,9 @@ call_arg_in_selected_dir(Direction, _ - arg_info(_, Mode)) :-
Direction = callee
).
-lock_regs(N, Exceptions, !CI) :-
+lock_regs(R, F, Exceptions, !CI) :-
get_var_locn_info(!.CI, VarLocnInfo0),
- var_locn_lock_regs(N, Exceptions, VarLocnInfo0, VarLocnInfo),
+ var_locn_lock_regs(R, F, Exceptions, VarLocnInfo0, VarLocnInfo),
set_var_locn_info(VarLocnInfo, !CI).
unlock_regs(!CI) :-
@@ -4236,9 +4267,9 @@ compute_forward_live_var_saves(CI, OutArgs, VarLocs) :-
associate_stack_slot(CI, Var, Var - Slot) :-
get_variable_slot(CI, Var, Slot).
-max_reg_in_use(CI, Max) :-
+max_reg_in_use(CI, MaxR, MaxF) :-
get_var_locn_info(CI, VarLocnInfo),
- var_locn_max_reg_in_use(VarLocnInfo, Max).
+ var_locn_max_reg_in_use(VarLocnInfo, MaxR, MaxF).
magically_put_var_in_unused_reg(Var, !CI) :-
get_var_locn_info(!.CI, VarLocnInfo0),
@@ -4663,14 +4694,18 @@ max_var_slot(StackSlots, SlotCount) :-
max_var_slot_2([], !Max).
max_var_slot_2([L | Ls], !Max) :-
(
- L = det_slot(N),
- int.max(N, !Max)
+ L = det_slot(N, Width)
;
- L = parent_det_slot(N),
- int.max(N, !Max)
+ L = parent_det_slot(N, Width)
;
- L = nondet_slot(N),
+ L = nondet_slot(N, Width)
+ ),
+ (
+ Width = single_width,
int.max(N, !Max)
+ ;
+ Width = double_width,
+ int.max(N + 1, !Max)
),
max_var_slot_2(Ls, !Max).
diff --git a/compiler/code_util.m b/compiler/code_util.m
index 85bb4d7..b57f60f 100644
--- a/compiler/code_util.m
+++ b/compiler/code_util.m
@@ -61,8 +61,8 @@
:- pred arg_loc_to_register(arg_loc::in, lval::out) is det.
-:- pred max_mentioned_reg(list(lval)::in, int::out) is det.
-:- pred max_mentioned_abs_reg(list(abs_locn)::in, int::out) is det.
+:- pred max_mentioned_regs(list(lval)::in, int::out, int::out) is det.
+:- pred max_mentioned_abs_regs(list(abs_locn)::in, int::out, int::out) is det.
:- pred goal_may_alloc_temp_frame(hlds_goal::in, bool::out) is det.
@@ -188,37 +188,51 @@ extract_proc_label_from_code_addr(CodeAddr) = ProcLabel :-
%-----------------------------------------------------------------------------%
-arg_loc_to_register(ArgLoc, reg(reg_r, ArgLoc)).
+arg_loc_to_register(reg(RegType, N), reg(RegType, N)).
%-----------------------------------------------------------------------------%
-max_mentioned_reg(Lvals, MaxRegNum) :-
- max_mentioned_reg_2(Lvals, 0, MaxRegNum).
+max_mentioned_regs(Lvals, MaxRegR, MaxRegF) :-
+ max_mentioned_reg_2(Lvals, 0, MaxRegR, 0, MaxRegF).
-:- pred max_mentioned_reg_2(list(lval)::in, int::in, int::out) is det.
+:- pred max_mentioned_reg_2(list(lval)::in, int::in, int::out,
+ int::in, int::out) is det.
-max_mentioned_reg_2([], !MaxRegNum).
-max_mentioned_reg_2([Lval | Lvals], !MaxRegNum) :-
- ( Lval = reg(reg_r, N) ->
- int.max(N, !MaxRegNum)
+max_mentioned_reg_2([], !MaxRegR, !MaxRegF).
+max_mentioned_reg_2([Lval | Lvals], !MaxRegR, !MaxRegF) :-
+ ( Lval = reg(RegType, N) ->
+ (
+ RegType = reg_r,
+ int.max(N, !MaxRegR)
+ ;
+ RegType = reg_f,
+ int.max(N, !MaxRegF)
+ )
;
true
),
- max_mentioned_reg_2(Lvals, !MaxRegNum).
+ max_mentioned_reg_2(Lvals, !MaxRegR, !MaxRegF).
-max_mentioned_abs_reg(Lvals, MaxRegNum) :-
- max_mentioned_abs_reg_2(Lvals, 0, MaxRegNum).
+max_mentioned_abs_regs(Lvals, MaxRegR, MaxRegF) :-
+ max_mentioned_abs_reg_2(Lvals, 0, MaxRegR, 0, MaxRegF).
-:- pred max_mentioned_abs_reg_2(list(abs_locn)::in, int::in, int::out) is det.
+:- pred max_mentioned_abs_reg_2(list(abs_locn)::in,
+ int::in, int::out, int::in, int::out) is det.
-max_mentioned_abs_reg_2([], !MaxRegNum).
-max_mentioned_abs_reg_2([Lval | Lvals], !MaxRegNum) :-
- ( Lval = abs_reg(N) ->
- int.max(N, !MaxRegNum)
+max_mentioned_abs_reg_2([], !MaxRegR, !MaxRegF).
+max_mentioned_abs_reg_2([Lval | Lvals], !MaxRegR, !MaxRegF) :-
+ ( Lval = abs_reg(RegType, N) ->
+ (
+ RegType = reg_r,
+ int.max(N, !MaxRegR)
+ ;
+ RegType = reg_f,
+ int.max(N, !MaxRegF)
+ )
;
true
),
- max_mentioned_abs_reg_2(Lvals, !MaxRegNum).
+ max_mentioned_abs_reg_2(Lvals, !MaxRegR, !MaxRegF).
%-----------------------------------------------------------------------------%
@@ -363,6 +377,7 @@ lvals_in_lval(reg(_, _)) = [].
lvals_in_lval(stackvar(_)) = [].
lvals_in_lval(parent_stackvar(_)) = [].
lvals_in_lval(framevar(_)) = [].
+lvals_in_lval(double_stackvar(_, _)) = [].
lvals_in_lval(succip) = [].
lvals_in_lval(maxfr) = [].
lvals_in_lval(curfr) = [].
diff --git a/compiler/continuation_info.m b/compiler/continuation_info.m
index 5095fe1..e049be0 100644
--- a/compiler/continuation_info.m
+++ b/compiler/continuation_info.m
@@ -107,9 +107,10 @@
% associated with the call event, whose stack layout says
% which variables were live and where on entry.
- pli_max_trace_reg :: int,
- % The number of the highest numbered rN register that can
- % contain useful information during a call to MR_trace from
+ pli_max_trace_reg_r :: int,
+ pli_max_trace_reg_f :: int,
+ % The number of the highest numbered rN and fN registers that
+ % can contain useful information during a call to MR_trace from
% within this procedure.
pli_head_vars :: list(prog_var),
@@ -734,6 +735,8 @@ generate_resume_layout_for_var(Var, LvalSet, InstMap, ProcInfo, ModuleInfo,
expect(N > 0, $module, $pred, "bad stackvar")
; Lval = stackvar(N) ->
expect(N > 0, $module, $pred, "bad framevar")
+ ; Lval = double_stackvar(_, N) ->
+ expect(N > 0, $module, $pred, "bad stackvar")
;
true
),
@@ -819,8 +822,8 @@ generate_closure_layout(ModuleInfo, PredId, ProcId, ClosureLayout) :-
:- pred build_closure_info(list(prog_var)::in,
list(mer_type)::in, list(arg_info)::in, list(closure_arg_info)::out,
- instmap::in, map(prog_var, set(lval))::in,
- map(prog_var, set(lval))::out, set(tvar)::in, set(tvar)::out) is semidet.
+ instmap::in, map(prog_var, set(lval))::in, map(prog_var, set(lval))::out,
+ set(tvar)::in, set(tvar)::out) is semidet.
build_closure_info([], [], [], [], _, !VarLocs, !TypeVars).
build_closure_info([Var | Vars], [Type | Types],
@@ -829,7 +832,8 @@ build_closure_info([Var | Vars], [Type | Types],
ArgInfo = arg_info(ArgLoc, _ArgMode),
instmap_lookup_var(InstMap, Var, Inst),
Layout = closure_arg_info(Type, Inst),
- set.singleton_set(Locations, reg(reg_r, ArgLoc)),
+ arg_loc_to_register(ArgLoc, Reg),
+ Locations = set.make_singleton_set(Reg),
map.det_insert(Var, Locations, !VarLocs),
type_vars(Type, VarTypeVars),
set.insert_list(VarTypeVars, !TypeVars),
@@ -952,6 +956,7 @@ live_value_type(slot_lval(reg(_, _)), live_value_unwanted).
live_value_type(slot_lval(stackvar(_)), live_value_unwanted).
live_value_type(slot_lval(parent_stackvar(_)), live_value_unwanted).
live_value_type(slot_lval(framevar(_)), live_value_unwanted).
+live_value_type(slot_lval(double_stackvar(_, _)), live_value_unwanted).
live_value_type(slot_lval(mem_ref(_)), live_value_unwanted). % XXX
live_value_type(slot_lval(global_var_ref(_)), live_value_unwanted).
live_value_type(slot_success_record, live_value_unwanted).
diff --git a/compiler/disj_gen.m b/compiler/disj_gen.m
index 18244f9..38ccb57 100644
--- a/compiler/disj_gen.m
+++ b/compiler/disj_gen.m
@@ -215,7 +215,7 @@ generate_lookup_disj(ResumeVars, LookupDisjInfo, Code, !CI) :-
% Since we release BaseReg only after the calls to generate_branch_end
% (invoked through set_liveness_and_end_branch) we must ensure that
% generate_branch_end won't want to overwrite BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
BaseRegInitCode = cord.singleton(
llds_instr(assign(BaseReg,
@@ -258,7 +258,7 @@ generate_lookup_disj(ResumeVars, LookupDisjInfo, Code, !CI) :-
maybe_reset_ticket(MaybeTicketSlot, reset_reason_undo, RestoreTicketCode),
maybe_restore_hp(MaybeHpSlot, RestoreHpCode),
- acquire_reg_not_in_storemap(StoreMap, LaterBaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, LaterBaseReg, !CI),
get_next_label(UndoLabel, !CI),
get_next_label(AfterUndoLabel, !CI),
MaxSlot = (NumSolns - 1) * NumOutVars,
diff --git a/compiler/dupelim.m b/compiler/dupelim.m
index cdd3ad9..09f4125 100644
--- a/compiler/dupelim.m
+++ b/compiler/dupelim.m
@@ -480,6 +480,7 @@ standardize_lval(Lval0, Lval) :-
; Lval0 = stackvar(_)
; Lval0 = parent_stackvar(_)
; Lval0 = framevar(_)
+ ; Lval0 = double_stackvar(_, _)
; Lval0 = succip_slot(_)
; Lval0 = redoip_slot(_)
; Lval0 = succfr_slot(_)
@@ -878,12 +879,14 @@ most_specific_lval(LvalA, LvalB, Lval) :-
; LvalA = stackvar(_)
; LvalA = parent_stackvar(_)
; LvalA = framevar(_)
+ ; LvalA = double_stackvar(_, _)
; LvalA = succip_slot(_)
; LvalA = redoip_slot(_)
; LvalA = redofr_slot(_)
; LvalA = succfr_slot(_)
; LvalA = prevfr_slot(_)
; LvalA = mem_ref(_)
+ ; LvalA = global_var_ref(_)
),
LvalA = LvalB,
Lval = LvalA
diff --git a/compiler/export.m b/compiler/export.m
index 9087f0a..e591349 100644
--- a/compiler/export.m
+++ b/compiler/export.m
@@ -19,6 +19,7 @@
:- import_module hlds.
:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
@@ -56,17 +57,18 @@
% The {MLDS,LLDS}->C backends and fact tables use this code.
% Generate C code to convert an rval (represented as a string), from
- % a C type to a mercury C type (ie. convert strings and floats to
+ % a C type to a Mercury C type (i.e. convert strings and floats to
% words) and return the resulting C code as a string.
%
-:- pred convert_type_to_mercury(string::in, mer_type::in, string::out) is det.
+:- pred convert_type_to_mercury(string::in, mer_type::in, arg_loc::in,
+ string::out) is det.
% Generate C code to convert an rval (represented as a string), from
- % a mercury C type to a C type. (ie. convert words to strings and
+ % a Mercury C type to a C type (i.e. convert words to strings and
% floats if required) and return the resulting C code as a string.
%
-:- pred convert_type_from_mercury(string::in, mer_type::in, string::out)
- is det.
+:- pred convert_type_from_mercury(arg_loc::in, string::in, mer_type::in,
+ string::out) is det.
% Succeeds iff the given C type is known by the compiler to be an integer
% or pointer type the same size as MR_Word.
@@ -87,7 +89,7 @@
:- import_module hlds.arg_info.
:- import_module hlds.code_model.
:- import_module hlds.hlds_data.
-:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_llds.
:- import_module hlds.pred_table.
:- import_module libs.
:- import_module libs.globals.
@@ -386,7 +388,8 @@ get_export_info_for_lang_c(Preds, PredId, ProcId, _Globals, ModuleInfo,
ArgInfos = ArgInfos0
;
MaybeArgInfos = no,
- generate_proc_arg_info(ArgTypes, ModuleInfo, ProcInfo, NewProcInfo),
+ generate_proc_arg_info(Status, ArgTypes, ModuleInfo, ProcInfo,
+ NewProcInfo),
proc_info_arg_info(NewProcInfo, ArgInfos)
),
CodeModel = proc_info_interface_code_model(ProcInfo),
@@ -405,8 +408,9 @@ get_export_info_for_lang_c(Preds, PredId, ProcId, _Globals, ModuleInfo,
->
Export_RetType = foreign.to_exported_type(ModuleInfo, RetType),
C_RetType = exported_type_to_string(lang_c, Export_RetType),
- argloc_to_string(RetArgLoc, RetArgString0),
- convert_type_from_mercury(RetArgString0, RetType, RetArgString),
+ arg_loc_to_string(RetArgLoc, RetArgString0),
+ convert_type_from_mercury(RetArgLoc, RetArgString0, RetType,
+ RetArgString),
MaybeDeclareRetval = "\t" ++ C_RetType ++ " return_value;\n",
% We need to unbox non-word-sized foreign types
% before returning them to C code
@@ -528,8 +532,8 @@ get_input_args([AT | ATs], Num0, ModuleInfo, Result) :-
Mode = top_in,
string.int_to_string(Num, NumString),
ArgName0 = "Mercury__argument" ++ NumString,
- convert_type_to_mercury(ArgName0, Type, ArgName),
- argloc_to_string(ArgLoc, ArgLocString),
+ arg_loc_to_string(ArgLoc, ArgLocString),
+ convert_type_to_mercury(ArgName0, Type, ArgLoc, ArgName),
Export_Type = foreign.to_exported_type(ModuleInfo, Type),
% We need to box non-word-sized foreign types
% before passing them to Mercury code
@@ -565,8 +569,8 @@ copy_output_args([AT | ATs], Num0, ModuleInfo, Result) :-
Mode = top_out,
string.int_to_string(Num, NumString),
string.append("Mercury__argument", NumString, ArgName),
- argloc_to_string(ArgLoc, ArgLocString0),
- convert_type_from_mercury(ArgLocString0, Type, ArgLocString),
+ arg_loc_to_string(ArgLoc, ArgLocString0),
+ convert_type_from_mercury(ArgLoc, ArgLocString0, Type, ArgLocString),
Export_Type = foreign.to_exported_type(ModuleInfo, Type),
% We need to unbox non-word-sized foreign types
% before returning them to C code
@@ -584,20 +588,27 @@ copy_output_args([AT | ATs], Num0, ModuleInfo, Result) :-
copy_output_args(ATs, Num, ModuleInfo, TheRest),
string.append(OutputArg, TheRest, Result).
- % convert an argument location (currently just a register number)
- % to a string representing a C code fragment that names it.
-:- pred argloc_to_string(arg_loc::in, string::out) is det.
+ % Convert an argument location to a string representing a C code fragment
+ % that names it.
+ %
+:- pred arg_loc_to_string(arg_loc::in, string::out) is det.
-argloc_to_string(RegNum, RegName) :-
- % XXX We should handle float registers.
- % XXX This magic number can't be good.
- ( RegNum > 32 ->
- RegName = "MR_r(" ++ int_to_string(RegNum) ++ ")"
+arg_loc_to_string(reg(RegType, RegNum), RegName) :-
+ % XXX this should reuse llds_out_data.reg_to_string
+ (
+ RegType = reg_r,
+ % XXX This magic number can't be good.
+ ( RegNum > 32 ->
+ RegName = "MR_r(" ++ int_to_string(RegNum) ++ ")"
+ ;
+ RegName = "MR_r" ++ int_to_string(RegNum)
+ )
;
- RegName = "MR_r" ++ int_to_string(RegNum)
+ RegType = reg_f,
+ RegName = "MR_f(" ++ int_to_string(RegNum) ++ ")"
).
-convert_type_to_mercury(Rval, Type, ConvertedRval) :-
+convert_type_to_mercury(Rval, Type, TargetArgLoc, ConvertedRval) :-
(
Type = builtin_type(BuiltinType),
(
@@ -605,7 +616,13 @@ convert_type_to_mercury(Rval, Type, ConvertedRval) :-
ConvertedRval = "(MR_Word) " ++ Rval
;
BuiltinType = builtin_type_float,
- ConvertedRval = "MR_float_to_word(" ++ Rval ++ ")"
+ (
+ TargetArgLoc = reg(reg_r, _),
+ ConvertedRval = "MR_float_to_word(" ++ Rval ++ ")"
+ ;
+ TargetArgLoc = reg(reg_f, _),
+ ConvertedRval = Rval
+ )
;
BuiltinType = builtin_type_char,
% We need to explicitly cast to MR_UnsignedChar
@@ -627,7 +644,7 @@ convert_type_to_mercury(Rval, Type, ConvertedRval) :-
ConvertedRval = Rval
).
-convert_type_from_mercury(Rval, Type, ConvertedRval) :-
+convert_type_from_mercury(SourceArgLoc, Rval, Type, ConvertedRval) :-
(
Type = builtin_type(BuiltinType),
(
@@ -635,7 +652,13 @@ convert_type_from_mercury(Rval, Type, ConvertedRval) :-
ConvertedRval = "(MR_String) " ++ Rval
;
BuiltinType = builtin_type_float,
- ConvertedRval = "MR_word_to_float(" ++ Rval ++ ")"
+ (
+ SourceArgLoc = reg(reg_r, _),
+ ConvertedRval = "MR_word_to_float(" ++ Rval ++ ")"
+ ;
+ SourceArgLoc = reg(reg_f, _),
+ ConvertedRval = Rval
+ )
;
( BuiltinType = builtin_type_int
; BuiltinType = builtin_type_char
diff --git a/compiler/exprn_aux.m b/compiler/exprn_aux.m
index 95a4b4e..667395a 100644
--- a/compiler/exprn_aux.m
+++ b/compiler/exprn_aux.m
@@ -220,6 +220,7 @@ vars_in_lval(parent_sp, []).
vars_in_lval(stackvar(_SlotNum), []).
vars_in_lval(parent_stackvar(_SlotNum), []).
vars_in_lval(framevar(_SlotNum), []).
+vars_in_lval(double_stackvar(_, _), []).
vars_in_lval(succip_slot(Rval), Vars) :-
vars_in_rval(Rval, Vars).
vars_in_lval(redoip_slot(Rval), Vars) :-
@@ -578,6 +579,7 @@ substitute_lval_in_lval_count_2(OldLval, NewLval, Lval0, Lval, !N) :-
; Lval0 = stackvar(_SlotNum)
; Lval0 = parent_stackvar(_SlotNum)
; Lval0 = framevar(_SlotNum)
+ ; Lval0 = double_stackvar(_Type, _SlotNum)
; Lval0 = lvar(_Var)
; Lval0 = global_var_ref(_GlobalVarName)
),
@@ -679,6 +681,7 @@ substitute_rval_in_lval(OldRval, NewRval, Lval0, Lval) :-
; Lval0 = stackvar(_)
; Lval0 = parent_stackvar(_)
; Lval0 = framevar(_)
+ ; Lval0 = double_stackvar(_, _)
; Lval0 = global_var_ref(_)
; Lval0 = lvar(_)
),
@@ -837,6 +840,7 @@ lval_addrs(reg(_Type, _RegNum), [], []).
lval_addrs(stackvar(_SlotNum), [], []).
lval_addrs(parent_stackvar(_SlotNum), [], []).
lval_addrs(framevar(_SlotNum), [], []).
+lval_addrs(double_stackvar(_Type, _SlotNum), [], []).
lval_addrs(succip, [], []).
lval_addrs(maxfr, [], []).
lval_addrs(curfr, [], []).
diff --git a/compiler/fact_table.m b/compiler/fact_table.m
index 67bc5bb..07c9817 100644
--- a/compiler/fact_table.m
+++ b/compiler/fact_table.m
@@ -101,6 +101,7 @@
:- import_module check_hlds.mode_util.
:- import_module hlds.arg_info.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_llds.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module libs.options.
@@ -2976,7 +2977,17 @@ generate_argument_vars_code(PragmaVars, Types, ModuleInfo, DeclCode, InputCode,
OutputCode, SaveRegsCode, GetRegsCode, NumInputArgs) :-
list.map((pred(X::in, Y::out) is det :- X = pragma_var(_, _, Y, _)),
PragmaVars, Modes),
- make_arg_infos(Types, Modes, model_non, ModuleInfo, ArgInfos),
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, use_float_registers, FloatRegs),
+ (
+ FloatRegs = yes,
+ FloatRegType = reg_f
+ ;
+ FloatRegs = no,
+ FloatRegType = reg_r
+ ),
+ make_arg_infos(Types, Modes, model_non, ModuleInfo, FloatRegType,
+ ArgInfos),
generate_argument_vars_code_2(PragmaVars, ArgInfos, Types, ModuleInfo,
DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode, 1,
NumInputArgs).
@@ -3035,39 +3046,40 @@ generate_arg_decl_code(Name, Type, Module, DeclCode) :-
C_Type = mercury_exported_type_to_string(Module, lang_c, Type),
string.format("\t\t%s %s;\n", [s(C_Type), s(Name)], DeclCode).
-:- pred generate_arg_input_code(string::in, mer_type::in, int::in, int::in,
+:- pred generate_arg_input_code(string::in, mer_type::in, arg_loc::in, int::in,
string::out, string::out, string::out) is det.
-generate_arg_input_code(Name, Type, RegNum, FrameVarNum, InputCode,
+generate_arg_input_code(Name, Type, ArgLoc, FrameVarNum, InputCode,
SaveRegCode, GetRegCode) :-
- get_reg_name(RegNum, RegName),
- convert_type_from_mercury(RegName, Type, Converted),
+ ArgLoc = reg(RegType, RegNum),
+ (
+ RegType = reg_r,
+ ConvertToFrameVar = "",
+ ConvertFromFrameVar = ""
+ ;
+ RegType = reg_f,
+ ConvertToFrameVar = "MR_float_to_word",
+ ConvertFromFrameVar = "MR_word_to_float"
+ ),
+ RegName = reg_to_string(RegType, RegNum),
+ convert_type_from_mercury(ArgLoc, RegName, Type, Converted),
Template = "\t\t%s = %s;\n",
string.format(Template, [s(Name), s(Converted)], InputCode),
- string.format("\t\tMR_framevar(%d) = %s;\n",
- [i(FrameVarNum), s(RegName)], SaveRegCode),
- string.format("\t\t%s = MR_framevar(%d);\n",
- [s(RegName), i(FrameVarNum)], GetRegCode).
+ string.format("\t\tMR_framevar(%d) = %s(%s);\n",
+ [i(FrameVarNum), s(ConvertToFrameVar), s(RegName)], SaveRegCode),
+ string.format("\t\t%s = %s(MR_framevar(%d));\n",
+ [s(RegName), s(ConvertFromFrameVar), i(FrameVarNum)], GetRegCode).
-:- pred generate_arg_output_code(string::in, mer_type::in, int::in,
+:- pred generate_arg_output_code(string::in, mer_type::in, arg_loc::in,
string::out) is det.
-generate_arg_output_code(Name, Type, RegNum, OutputCode) :-
- get_reg_name(RegNum, RegName),
- convert_type_to_mercury(Name, Type, Converted),
+generate_arg_output_code(Name, Type, ArgLoc, OutputCode) :-
+ ArgLoc = reg(RegType, RegNum),
+ RegName = reg_to_string(RegType, RegNum),
+ convert_type_to_mercury(Name, Type, ArgLoc, Converted),
Template = "\t\t%s = %s;\n",
string.format(Template, [s(RegName), s(Converted)], OutputCode).
-:- pred get_reg_name(int::in, string::out) is det.
-
-get_reg_name(RegNum, RegName) :-
- code_util.arg_loc_to_register(RegNum, Lval),
- ( Lval = reg(RegType, N) ->
- RegName = reg_to_string(RegType, N)
- ;
- unexpected($module, $pred, "lval is not a register")
- ).
-
% Generate code to test that the fact found matches the input arguments.
% This is only required for generate_primary_nondet_code. Other procedures
% can test the key in the hash table against the input arguments.
diff --git a/compiler/follow_vars.m b/compiler/follow_vars.m
index 192a6da..ce7c46c 100644
--- a/compiler/follow_vars.m
+++ b/compiler/follow_vars.m
@@ -39,12 +39,12 @@
%-----------------------------------------------------------------------------%
:- pred find_final_follow_vars(proc_info::in, abs_follow_vars_map::out,
- int::out) is det.
+ int::out, int::out) is det.
:- pred find_follow_vars_in_goal(hlds_goal::in, hlds_goal::out,
vartypes::in, module_info::in,
abs_follow_vars_map::in, abs_follow_vars_map::out,
- int::in, int::out) is det.
+ int::in, int::out, int::in, int::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -67,61 +67,74 @@
%-----------------------------------------------------------------------------%
-find_final_follow_vars(ProcInfo, FollowVarsMap, NextNonReserved) :-
+find_final_follow_vars(ProcInfo, FollowVarsMap, NextNonReservedR,
+ NextNonReservedF) :-
proc_info_arg_info(ProcInfo, ArgInfo),
proc_info_get_headvars(ProcInfo, HeadVars),
assoc_list.from_corresponding_lists(ArgInfo, HeadVars, ArgInfoHeadVars),
map.init(FollowVarsMap0),
find_final_follow_vars_2(ArgInfoHeadVars,
- FollowVarsMap0, FollowVarsMap, 1, NextNonReserved).
+ FollowVarsMap0, FollowVarsMap, 1, NextNonReservedR,
+ 1, NextNonReservedF).
:- pred find_final_follow_vars_2(assoc_list(arg_info, prog_var)::in,
- abs_follow_vars_map::in, abs_follow_vars_map::out, int::in, int::out)
- is det.
+ abs_follow_vars_map::in, abs_follow_vars_map::out, int::in, int::out,
+ int::in, int::out) is det.
-find_final_follow_vars_2([], !FollowMap, !NextNonReserved).
-find_final_follow_vars_2([arg_info(RegNum, Mode) - Var | ArgInfoVars],
- !FollowVarsMap, !NextNonReserved) :-
+find_final_follow_vars_2([], !FollowMap, !NextNonReservedR, !NextNonReservedF).
+find_final_follow_vars_2([arg_info(ArgLoc, Mode) - Var | ArgInfoVars],
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF) :-
(
Mode = top_out,
- Locn = abs_reg(RegNum),
+ ArgLoc = reg(RegType, RegNum),
+ Locn = abs_reg(RegType, RegNum),
map.det_insert(Var, Locn, !FollowVarsMap),
- int.max(RegNum + 1, !NextNonReserved)
+ (
+ RegType = reg_r,
+ int.max(RegNum + 1, !NextNonReservedR)
+ ;
+ RegType = reg_f,
+ int.max(RegNum + 1, !NextNonReservedF)
+ )
;
Mode = top_in
;
Mode = top_unused
),
- find_final_follow_vars_2(ArgInfoVars, !FollowVarsMap, !NextNonReserved).
+ find_final_follow_vars_2(ArgInfoVars, !FollowVarsMap, !NextNonReservedR,
+ !NextNonReservedF).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
find_follow_vars_in_goal(hlds_goal(GoalExpr0, GoalInfo0),
hlds_goal(GoalExpr, GoalInfo), VarTypes, ModuleInfo,
- !FollowVarsMap, !NextNonReserved) :-
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF) :-
find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo,
- VarTypes, ModuleInfo, !FollowVarsMap, !NextNonReserved).
+ VarTypes, ModuleInfo, !FollowVarsMap, !NextNonReservedR,
+ !NextNonReservedF).
%-----------------------------------------------------------------------------%
:- pred find_follow_vars_in_goal_expr(hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out, vartypes::in, module_info::in,
abs_follow_vars_map::in, abs_follow_vars_map::out,
- int::in, int::out) is det.
+ int::in, int::out, int::in, int::out) is det.
find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
- VarTypes, ModuleInfo, !FollowVarsMap, !NextNonReserved) :-
+ VarTypes, ModuleInfo, !FollowVarsMap,
+ !NextNonReservedR, !NextNonReservedF) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
find_follow_vars_in_conj(Goals0, Goals, VarTypes, ModuleInfo,
- no, !FollowVarsMap, !NextNonReserved)
+ no, !FollowVarsMap, !NextNonReservedR, !NextNonReservedF)
;
ConjType = parallel_conj,
find_follow_vars_in_independent_goals(Goals0, Goals, VarTypes,
- ModuleInfo, !FollowVarsMap, !NextNonReserved)
+ ModuleInfo, !FollowVarsMap, !NextNonReservedR,
+ !NextNonReservedF)
),
GoalExpr = conj(ConjType, Goals)
;
@@ -131,7 +144,7 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
% the requirements of the code following the disjunction.
goal_info_set_store_map(!.FollowVarsMap, !GoalInfo),
find_follow_vars_in_independent_goals(Goals0, Goals, VarTypes,
- ModuleInfo, !FollowVarsMap, !NextNonReserved),
+ ModuleInfo, !FollowVarsMap, !NextNonReservedR, !NextNonReservedF),
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(Var, Det, Cases0),
@@ -140,12 +153,13 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
% reflects the requirements of the code following the switch.
goal_info_set_store_map(!.FollowVarsMap, !GoalInfo),
find_follow_vars_in_cases(Cases0, Cases, VarTypes, ModuleInfo,
- !FollowVarsMap, !NextNonReserved),
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF),
GoalExpr = switch(Var, Det, Cases)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
FollowVarsMap0 = !.FollowVarsMap,
- NextNonReserved0 = !.NextNonReserved,
+ NextNonReservedR0 = !.NextNonReservedR,
+ NextNonReservedF0 = !.NextNonReservedF,
% Set the follow_vars field for the condition, the then-part and the
% else-part, since in general they have requirements about where
@@ -165,34 +179,38 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
% following the if-then-else.
find_follow_vars_in_goal(Then0, Then1, VarTypes, ModuleInfo,
FollowVarsMap0, FollowVarsMapThen,
- NextNonReserved0, NextNonReservedThen),
- FollowVarsThen =
- abs_follow_vars(FollowVarsMapThen, NextNonReservedThen),
+ NextNonReservedR0, NextNonReservedThenR,
+ NextNonReservedF0, NextNonReservedThenF),
+ FollowVarsThen = abs_follow_vars(FollowVarsMapThen,
+ NextNonReservedThenR, NextNonReservedThenF),
goal_set_follow_vars(yes(FollowVarsThen), Then1, Then),
find_follow_vars_in_goal(Cond0, Cond1, VarTypes, ModuleInfo,
FollowVarsMapThen, FollowVarsMapCond,
- NextNonReservedThen, NextNonReservedCond),
- FollowVarsCond =
- abs_follow_vars(FollowVarsMapCond, NextNonReservedCond),
+ NextNonReservedThenR, NextNonReservedCondR,
+ NextNonReservedThenF, NextNonReservedCondF),
+ FollowVarsCond = abs_follow_vars(FollowVarsMapCond,
+ NextNonReservedCondR, NextNonReservedCondF),
goal_set_follow_vars(yes(FollowVarsCond), Cond1, Cond),
find_follow_vars_in_goal(Else0, Else1, VarTypes, ModuleInfo,
FollowVarsMap0, FollowVarsMapElse,
- NextNonReserved0, NextNonReservedElse),
- FollowVarsElse =
- abs_follow_vars(FollowVarsMapElse, NextNonReservedElse),
+ NextNonReservedR0, NextNonReservedElseR,
+ NextNonReservedF0, NextNonReservedElseF),
+ FollowVarsElse = abs_follow_vars(FollowVarsMapElse,
+ NextNonReservedElseR, NextNonReservedElseF),
goal_set_follow_vars(yes(FollowVarsElse), Else1, Else),
goal_info_set_store_map(FollowVarsMap0, !GoalInfo),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
!:FollowVarsMap = FollowVarsMapCond,
- !:NextNonReserved = NextNonReservedCond
+ !:NextNonReservedR = NextNonReservedCondR,
+ !:NextNonReservedF = NextNonReservedCondF
;
GoalExpr0 = negation(SubGoal0),
find_follow_vars_in_goal(SubGoal0, SubGoal, VarTypes, ModuleInfo,
- !FollowVarsMap, !NextNonReserved),
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
@@ -200,7 +218,7 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
SubGoal = SubGoal0
;
find_follow_vars_in_goal(SubGoal0, SubGoal, VarTypes, ModuleInfo,
- !FollowVarsMap, !NextNonReserved)
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF)
),
GoalExpr = scope(Reason, SubGoal)
;
@@ -224,7 +242,7 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
; State = not_builtin
),
find_follow_vars_in_call(PredId, ProcId, Args, ModuleInfo,
- !:FollowVarsMap, !:NextNonReserved)
+ !:FollowVarsMap, !:NextNonReservedR, !:NextNonReservedF)
)
;
GoalExpr0 = generic_call(GenericCall, Args, Modes, Det),
@@ -239,7 +257,9 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
),
determinism_to_code_model(Det, CodeModel),
map.apply_to_list(Args, VarTypes, Types),
- make_arg_infos(Types, Modes, CodeModel, ModuleInfo, ArgInfos),
+ % Generic calls use rN registers for all arguments.
+ make_arg_infos(Types, Modes, CodeModel, ModuleInfo, reg_r,
+ ArgInfos),
assoc_list.from_corresponding_lists(Args, ArgInfos, ArgsInfos),
arg_info.partition_args(ArgsInfos, InVarInfos, _),
assoc_list.keys(InVarInfos, InVars),
@@ -247,9 +267,10 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
call_gen.generic_call_info(Globals, GenericCall,
length(InVars), _, SpecifierArgInfos, FirstInput, _),
find_follow_vars_from_arginfo(SpecifierArgInfos,
- map.init, !:FollowVarsMap, 1, _),
- find_follow_vars_from_sequence(InVars, FirstInput,
- !FollowVarsMap, !:NextNonReserved)
+ map.init, !:FollowVarsMap, 1, _, 1, _),
+ find_follow_vars_from_generic_in_vars(InVars, !FollowVarsMap,
+ FirstInput, !:NextNonReservedR),
+ !:NextNonReservedF = 1
)
;
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
@@ -263,26 +284,28 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
%-----------------------------------------------------------------------------%
:- pred find_follow_vars_in_call(pred_id::in, proc_id::in, list(prog_var)::in,
- module_info::in, abs_follow_vars_map::out, int::out) is det.
+ module_info::in, abs_follow_vars_map::out, int::out, int::out) is det.
find_follow_vars_in_call(PredId, ProcId, Args, ModuleInfo,
- FollowVarsMap, NextNonReserved) :-
+ FollowVarsMap, NextNonReservedR, NextNonReservedF) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_arg_info(ProcInfo, ArgInfo),
assoc_list.from_corresponding_lists(Args, ArgInfo, ArgsInfos),
find_follow_vars_from_arginfo(ArgsInfos, map.init, FollowVarsMap,
- 1, NextNonReserved).
+ 1, NextNonReservedR, 1, NextNonReservedF).
:- pred find_follow_vars_from_arginfo(assoc_list(prog_var, arg_info)::in,
abs_follow_vars_map::in, abs_follow_vars_map::out,
- int::in, int::out) is det.
+ int::in, int::out, int::in, int::out) is det.
-find_follow_vars_from_arginfo([], !FollowVarsMap, !NextNonReserved).
-find_follow_vars_from_arginfo([ArgVar - arg_info(RegNum, Mode) | ArgsInfos],
- !FollowVarsMap, !NextNonReserved) :-
+find_follow_vars_from_arginfo([],
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF).
+find_follow_vars_from_arginfo([ArgVar - arg_info(ArgLoc, Mode) | ArgsInfos],
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF) :-
(
Mode = top_in,
- Locn = abs_reg(RegNum),
+ ArgLoc = reg(RegType, RegNum),
+ Locn = abs_reg(RegType, RegNum),
( map.insert(ArgVar, Locn, !FollowVarsMap) ->
true % FollowVarsMap is updated
;
@@ -293,24 +316,33 @@ find_follow_vars_from_arginfo([ArgVar - arg_info(RegNum, Mode) | ArgsInfos],
% we would give to this appearance of the variable.
true % FollowVarsMap is not updated
),
- int.max(RegNum + 1, !NextNonReserved)
+ (
+ RegType = reg_r,
+ int.max(RegNum + 1, !NextNonReservedR)
+ ;
+ RegType = reg_f,
+ int.max(RegNum + 1, !NextNonReservedF)
+ )
;
( Mode = top_out
; Mode = top_unused
)
),
find_follow_vars_from_arginfo(ArgsInfos,
- !FollowVarsMap, !NextNonReserved).
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF).
%-----------------------------------------------------------------------------%
-:- pred find_follow_vars_from_sequence(list(prog_var)::in, int::in,
- abs_follow_vars_map::in, abs_follow_vars_map::out, int::out) is det.
+ % Generic calls use regular registers (rN) only.
+ %
+:- pred find_follow_vars_from_generic_in_vars(list(prog_var)::in,
+ abs_follow_vars_map::in, abs_follow_vars_map::out, int::in, int::out)
+ is det.
-find_follow_vars_from_sequence([], NextRegNum, !FollowVarsMap, NextRegNum).
-find_follow_vars_from_sequence([InVar | InVars], NextRegNum, !FollowVarsMap,
- NextNonReserved) :-
- Locn = abs_reg(NextRegNum),
+find_follow_vars_from_generic_in_vars([], !FollowVarsMap, !NextRegR).
+find_follow_vars_from_generic_in_vars([InVar | InVars], !FollowVarsMap,
+ !NextRegR) :-
+ Locn = abs_reg(reg_r, !.NextRegR),
( map.insert(InVar, Locn, !FollowVarsMap) ->
true % FollowVarsMap is updated
;
@@ -321,8 +353,8 @@ find_follow_vars_from_sequence([InVar | InVars], NextRegNum, !FollowVarsMap,
% variable.
true % FollowVarsMap is not updated
),
- find_follow_vars_from_sequence(InVars, NextRegNum + 1,
- !FollowVarsMap, NextNonReserved).
+ !:NextRegR = !.NextRegR + 1,
+ find_follow_vars_from_generic_in_vars(InVars, !FollowVarsMap, !NextRegR).
%-----------------------------------------------------------------------------%
@@ -347,23 +379,27 @@ find_follow_vars_from_sequence([InVar | InVars], NextRegNum, !FollowVarsMap,
%
:- pred find_follow_vars_in_independent_goals(list(hlds_goal)::in,
list(hlds_goal)::out, vartypes::in, module_info::in,
- abs_follow_vars_map::in, abs_follow_vars_map::out, int::in, int::out)
- is det.
+ abs_follow_vars_map::in, abs_follow_vars_map::out, int::in, int::out,
+ int::in, int::out) is det.
find_follow_vars_in_independent_goals([], [], _, _ModuleInfo,
- FollowVarsMap, FollowVarsMap,
- NextNonReserved, NextNonReserved).
+ FollowVarsMap, FollowVarsMap, NextNonReservedR, NextNonReservedR,
+ NextNonReservedF, NextNonReservedF).
find_follow_vars_in_independent_goals([Goal0 | Goals0], [Goal | Goals],
VarTypes, ModuleInfo, FollowVarsMap0, FollowVarsMap,
- NextNonReserved0, NextNonReserved) :-
+ NextNonReservedR0, NextNonReservedR,
+ NextNonReservedF0, NextNonReservedF) :-
find_follow_vars_in_goal(Goal0, Goal1, VarTypes, ModuleInfo,
FollowVarsMap0, FollowVarsMap,
- NextNonReserved0, NextNonReserved),
- FollowVars = abs_follow_vars(FollowVarsMap, NextNonReserved),
+ NextNonReservedR0, NextNonReservedR,
+ NextNonReservedF0, NextNonReservedF),
+ FollowVars = abs_follow_vars(FollowVarsMap, NextNonReservedR,
+ NextNonReservedF),
goal_set_follow_vars(yes(FollowVars), Goal1, Goal),
find_follow_vars_in_independent_goals(Goals0, Goals, VarTypes, ModuleInfo,
FollowVarsMap0, _FollowVarsMap,
- NextNonReserved0, _NextNonReserved).
+ NextNonReservedR0, _NextNonReservedR,
+ NextNonReservedF0, _NextNonReservedF).
%-----------------------------------------------------------------------------%
@@ -381,22 +417,27 @@ find_follow_vars_in_independent_goals([Goal0 | Goals0], [Goal | Goals],
:- pred find_follow_vars_in_cases(list(case)::in, list(case)::out,
vartypes::in, module_info::in,
abs_follow_vars_map::in, abs_follow_vars_map::out,
- int::in, int::out) is det.
+ int::in, int::out, int::in, int::out) is det.
-find_follow_vars_in_cases([], [], _, _, !FollowVarsMap, !NextNonReserved).
+find_follow_vars_in_cases([], [], _, _, !FollowVarsMap, !NextNonReservedR,
+ !NextNonReservedF).
find_follow_vars_in_cases([Case0 | Cases0], [Case | Cases],
VarTypes, ModuleInfo, FollowVarsMap0, FollowVarsMap,
- NextNonReserved0, NextNonReserved) :-
+ NextNonReservedR0, NextNonReservedR,
+ NextNonReservedF0, NextNonReservedF) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
find_follow_vars_in_goal(Goal0, Goal1, VarTypes, ModuleInfo,
FollowVarsMap0, FollowVarsMap,
- NextNonReserved0, NextNonReserved),
- FollowVars = abs_follow_vars(FollowVarsMap, NextNonReserved),
+ NextNonReservedR0, NextNonReservedR,
+ NextNonReservedF0, NextNonReservedF),
+ FollowVars = abs_follow_vars(FollowVarsMap, NextNonReservedR,
+ NextNonReservedF),
goal_set_follow_vars(yes(FollowVars), Goal1, Goal),
Case = case(MainConsId, OtherConsIds, Goal),
find_follow_vars_in_cases(Cases0, Cases, VarTypes, ModuleInfo,
FollowVarsMap0, _FollowVarsMap,
- NextNonReserved, _NextNonReserved).
+ NextNonReservedR, _NextNonReservedR,
+ NextNonReservedF, _NextNonReservedF).
%-----------------------------------------------------------------------------%
@@ -406,12 +447,13 @@ find_follow_vars_in_cases([Case0 | Cases0], [Case | Cases],
:- pred find_follow_vars_in_conj(list(hlds_goal)::in, list(hlds_goal)::out,
vartypes::in, module_info::in, bool::in,
abs_follow_vars_map::in, abs_follow_vars_map::out,
- int::in, int::out) is det.
+ int::in, int::out, int::in, int::out) is det.
find_follow_vars_in_conj([], [], _, _ModuleInfo, _AttachToFirst,
- !FollowVarsMap, !NextNonReserved).
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF).
find_follow_vars_in_conj([Goal0 | Goals0], [Goal | Goals], VarTypes,
- ModuleInfo, AttachToFirst, !FollowVarsMap, !NextNonReserved) :-
+ ModuleInfo, AttachToFirst, !FollowVarsMap, !NextNonReservedR,
+ !NextNonReservedF) :-
(
Goal0 = hlds_goal(GoalExpr0, _),
(
@@ -427,12 +469,13 @@ find_follow_vars_in_conj([Goal0 | Goals0], [Goal | Goals], VarTypes,
AttachToNext = yes
),
find_follow_vars_in_conj(Goals0, Goals, VarTypes, ModuleInfo,
- AttachToNext, !FollowVarsMap, !NextNonReserved),
+ AttachToNext, !FollowVarsMap, !NextNonReservedR, !NextNonReservedF),
find_follow_vars_in_goal(Goal0, Goal1, VarTypes, ModuleInfo,
- !FollowVarsMap, !NextNonReserved),
+ !FollowVarsMap, !NextNonReservedR, !NextNonReservedF),
(
AttachToFirst = yes,
- FollowVars = abs_follow_vars(!.FollowVarsMap, !.NextNonReserved),
+ FollowVars = abs_follow_vars(!.FollowVarsMap, !.NextNonReservedR,
+ !.NextNonReservedF),
goal_set_follow_vars(yes(FollowVars), Goal1, Goal)
;
AttachToFirst = no,
diff --git a/compiler/global_data.m b/compiler/global_data.m
index 7f35030..65f4d80 100644
--- a/compiler/global_data.m
+++ b/compiler/global_data.m
@@ -1218,6 +1218,7 @@ remap_lval(Remap, Lval0, Lval) :-
; Lval0 = stackvar(_)
; Lval0 = parent_stackvar(_)
; Lval0 = framevar(_)
+ ; Lval0 = double_stackvar(_, _)
; Lval0 = succip_slot(_)
; Lval0 = redoip_slot(_)
; Lval0 = redofr_slot(_)
diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index 8667e98..a019d81 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -1284,6 +1284,11 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
option_implies(single_prec_float, unboxed_float, bool(yes),
!Globals),
+ % We only use the float registers if floats would not fit into the
+ % regular registers.
+ option_implies(unboxed_float, use_float_registers, bool(no),
+ !Globals),
+
% Changing this means that the code in make_hlds_passes.m that
% handles the declarations for the global variables used by
% mutables should also be updated.
diff --git a/compiler/hlds_llds.m b/compiler/hlds_llds.m
index e5ed470..97f21aa 100644
--- a/compiler/hlds_llds.m
+++ b/compiler/hlds_llds.m
@@ -26,10 +26,23 @@
:- import_module map.
:- import_module maybe.
+ % reg_r are the general purpose registers.
+ %
+ % reg_f are float registers.
+ % They are only present when float is wider than a word.
+ %
+:- type reg_type
+ ---> reg_r
+ ; reg_f.
+
:- type stack_slot
- ---> det_slot(int)
- ; parent_det_slot(int)
- ; nondet_slot(int).
+ ---> det_slot(int, stack_slot_width)
+ ; parent_det_slot(int, stack_slot_width)
+ ; nondet_slot(int, stack_slot_width).
+
+:- type stack_slot_width
+ ---> single_width
+ ; double_width. % occupies slots N and N+1
% Maps variables to their stack slots.
%
@@ -39,10 +52,10 @@
:- type abs_locn
---> any_reg
- ; abs_reg(int)
- ; abs_stackvar(int)
- ; abs_parent_stackvar(int)
- ; abs_framevar(int).
+ ; abs_reg(reg_type, int)
+ ; abs_stackvar(int, stack_slot_width)
+ ; abs_parent_stackvar(int, stack_slot_width)
+ ; abs_framevar(int, stack_slot_width).
:- type abs_follow_vars_map == map(prog_var, abs_locn).
@@ -50,12 +63,16 @@
% Variables may or may not appear in the map. If they do, then the
% associated locn says where the value of that variable ought to be put
% when it is computed, or, if the locn is any_reg, it says that it
- % should be put into any available register. The integer in the
- % second half of the pair gives the number of the first register that
- % is not reserved for other purposes, and is free to hold such variables.
+ % should be put into any available register. The two integers give the
+ % first regular and float registers, respectively, that are not reserved
+ % for other purposes, and so are free to hold such variables.
%
:- type abs_follow_vars
- ---> abs_follow_vars(abs_follow_vars_map, int).
+ ---> abs_follow_vars(
+ afv_map :: abs_follow_vars_map,
+ afv_next_non_res_reg_r :: int,
+ afv_next_non_res_reg_f :: int
+ ).
% Authoritative information about where variables must be put
% at the ends of branches of branched control structures.
@@ -270,7 +287,8 @@
:- func stack_slot_to_abs_locn(stack_slot) = abs_locn.
:- func key_stack_slot_to_abs_locn(_, stack_slot) = abs_locn.
-:- func abs_locn_to_string(abs_locn) = string.
+:- pred abs_locn_to_string(abs_locn::in, string::out, maybe(string)::out)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -298,18 +316,25 @@ explain_stack_slots_2([], _, !Explanation).
explain_stack_slots_2([Var - Slot | Rest], VarSet, !Explanation) :-
explain_stack_slots_2(Rest, VarSet, !Explanation),
(
- Slot = det_slot(SlotNum),
+ Slot = det_slot(SlotNum, Width),
StackStr = "sv"
;
- Slot = parent_det_slot(SlotNum),
+ Slot = parent_det_slot(SlotNum, Width),
StackStr = "parent_sv"
;
- Slot = nondet_slot(SlotNum),
+ Slot = nondet_slot(SlotNum, Width),
StackStr = "fv"
),
int_to_string(SlotNum, SlotStr),
+ (
+ Width = single_width,
+ WidthStr = ""
+ ;
+ Width = double_width,
+ WidthStr = " (double width)"
+ ),
varset.lookup_name(VarSet, Var, VarName),
- string.append_list([VarName, "\t ->\t", StackStr, SlotStr, "\n",
+ string.append_list([VarName, "\t ->\t", StackStr, SlotStr, WidthStr, "\n",
!.Explanation], !:Explanation).
%----------------------------------------------------------------------------%
@@ -679,10 +704,12 @@ rename_vars_in_llds_code_gen_info(Must, Subn, Details0, Details) :-
MaybeFollowVars = no
;
MaybeFollowVars0 = yes(FollowVars0),
- FollowVars0 = abs_follow_vars(FollowVarsMap0, FirstFreeReg),
+ FollowVars0 = abs_follow_vars(FollowVarsMap0, FirstFreeRegR,
+ FirstFreeRegF),
rename_vars_in_var_locn_map(Must, Subn,
FollowVarsMap0, FollowVarsMap),
- FollowVars = abs_follow_vars(FollowVarsMap, FirstFreeReg),
+ FollowVars = abs_follow_vars(FollowVarsMap, FirstFreeRegR,
+ FirstFreeRegF),
MaybeFollowVars = yes(FollowVars)
),
rename_vars_in_var_locn_map(Must, Subn, StoreMap0, StoreMap),
@@ -749,23 +776,67 @@ rename_vars_in_var_locn_list(Must, Subn,
%-----------------------------------------------------------------------------%
-stack_slot_num(det_slot(N)) = N.
-stack_slot_num(parent_det_slot(N)) = N.
-stack_slot_num(nondet_slot(N)) = N.
+stack_slot_num(StackSlot) = N :-
+ (
+ StackSlot = det_slot(N, Width)
+ ;
+ StackSlot = parent_det_slot(N, Width)
+ ;
+ StackSlot = nondet_slot(N, Width)
+ ),
+ (
+ Width = single_width
+ ;
+ Width = double_width,
+ unexpected($module, $pred, "double_width")
+ ).
-stack_slot_to_abs_locn(det_slot(N)) = abs_stackvar(N).
-stack_slot_to_abs_locn(parent_det_slot(N)) = abs_parent_stackvar(N).
-stack_slot_to_abs_locn(nondet_slot(N)) = abs_framevar(N).
+stack_slot_to_abs_locn(StackSlot) = AbsLocn :-
+ (
+ StackSlot = det_slot(N, Width),
+ AbsLocn = abs_stackvar(N, Width)
+ ;
+ StackSlot = parent_det_slot(N, Width),
+ AbsLocn = abs_parent_stackvar(N, Width)
+ ;
+ StackSlot = nondet_slot(N, Width),
+ AbsLocn = abs_framevar(N, Width)
+ ).
key_stack_slot_to_abs_locn(_, Slot) =
stack_slot_to_abs_locn(Slot).
-abs_locn_to_string(any_reg) = "any_reg".
-abs_locn_to_string(abs_reg(N)) = "r" ++ int_to_string(N).
-abs_locn_to_string(abs_stackvar(N)) = "stackvar" ++ int_to_string(N).
-abs_locn_to_string(abs_parent_stackvar(N)) =
- "parent_stackvar" ++ int_to_string(N).
-abs_locn_to_string(abs_framevar(N)) = "framevar" ++ int_to_string(N).
+abs_locn_to_string(Locn, Str, MaybeWidth) :-
+ (
+ Locn = any_reg,
+ Str = "any_reg",
+ MaybeWidth = no
+ ;
+ Locn = abs_reg(reg_r, N),
+ Str = "r" ++ int_to_string(N),
+ MaybeWidth = no
+ ;
+ Locn = abs_reg(reg_f, N),
+ Str = "f" ++ int_to_string(N),
+ MaybeWidth = no
+ ;
+ Locn = abs_stackvar(N, Width),
+ Str = "stackvar" ++ int_to_string(N),
+ MaybeWidth = stack_slot_width_to_string(Width)
+ ;
+ Locn = abs_parent_stackvar(N, Width),
+ Str = "parent_stackvar" ++ int_to_string(N),
+ MaybeWidth = stack_slot_width_to_string(Width)
+ ;
+ Locn = abs_framevar(N, Width),
+ Str = "framevar" ++ int_to_string(N),
+ MaybeWidth = stack_slot_width_to_string(Width)
+ ).
+
+:- func stack_slot_width_to_string(stack_slot_width) = maybe(string).
+
+stack_slot_width_to_string(single_width) = no.
+stack_slot_width_to_string(double_width) = yes("(double width)").
%-----------------------------------------------------------------------------%
:- end_module hlds.hlds_llds.
diff --git a/compiler/hlds_out_goal.m b/compiler/hlds_out_goal.m
index 3fa182c..74ff168 100644
--- a/compiler/hlds_out_goal.m
+++ b/compiler/hlds_out_goal.m
@@ -526,11 +526,13 @@ write_llds_code_gen_info(Info, GoalInfo, VarSet, AppendVarNums, Indent, !IO) :-
goal_info_get_follow_vars(GoalInfo, MaybeFollowVars),
(
MaybeFollowVars = yes(FollowVars),
- FollowVars = abs_follow_vars(FollowVarsMap, NextReg),
+ FollowVars = abs_follow_vars(FollowVarsMap, NextRegR, NextRegF),
map.to_assoc_list(FollowVarsMap, FVlist),
write_indent(Indent, !IO),
- io.write_string("% follow vars: ", !IO),
- io.write_int(NextReg, !IO),
+ io.write_string("% follow vars: r", !IO),
+ io.write_int(NextRegR, !IO),
+ io.write_string(", f", !IO),
+ io.write_int(NextRegF, !IO),
io.write_string("\n", !IO),
write_var_to_abs_locns(FVlist, VarSet, AppendVarNums, Indent, !IO)
;
@@ -689,7 +691,15 @@ write_var_to_abs_locns([Var - Loc | VarLocs], VarSet, AppendVarNums,
io.write_string("%\t", !IO),
mercury_output_var(VarSet, AppendVarNums, Var, !IO),
io.write_string("\t-> ", !IO),
- io.write_string(abs_locn_to_string(Loc), !IO),
+ abs_locn_to_string(Loc, LocnStr, MaybeWidth),
+ io.write_string(LocnStr, !IO),
+ (
+ MaybeWidth = yes(Width),
+ io.write_string(" ", !IO),
+ io.write_string(Width, !IO)
+ ;
+ MaybeWidth = no
+ ),
io.write_string("\n", !IO),
write_var_to_abs_locns(VarLocs, VarSet, AppendVarNums, Indent, !IO).
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index 3eb12c0..6c0508b 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -206,7 +206,8 @@
; top_out
; top_unused.
-:- type arg_loc == int.
+:- type arg_loc
+ ---> reg(reg_type, int).
% The type `import_status' describes whether an entity (a predicate,
% type, inst, or mode) is local to the current module, exported from
diff --git a/compiler/jumpopt.m b/compiler/jumpopt.m
index 81acfab..52d279d 100644
--- a/compiler/jumpopt.m
+++ b/compiler/jumpopt.m
@@ -64,6 +64,7 @@
:- implementation.
:- import_module backend_libs.builtin_ops.
+:- import_module hlds.hlds_llds.
:- import_module ll_backend.code_util.
:- import_module ll_backend.opt_util.
:- import_module parse_tree.prog_data.
@@ -1168,6 +1169,7 @@ short_labels_lval(_, temp(T, N), temp(T, N)).
short_labels_lval(_, stackvar(N), stackvar(N)).
short_labels_lval(_, parent_stackvar(N), parent_stackvar(N)).
short_labels_lval(_, framevar(N), framevar(N)).
+short_labels_lval(_, double_stackvar(Type, N), double_stackvar(Type, N)).
short_labels_lval(_, global_var_ref(Var), global_var_ref(Var)).
short_labels_lval(InstrMap, succip_slot(Rval0), succip_slot(Rval)) :-
short_labels_rval(InstrMap, Rval0, Rval).
diff --git a/compiler/layout.m b/compiler/layout.m
index d41b258..db07b1e 100644
--- a/compiler/layout.m
+++ b/compiler/layout.m
@@ -213,7 +213,8 @@
plet_var_names :: maybe(layout_slot_name),
plet_max_var_num :: int,
- plet_max_r_num :: int,
+ plet_max_reg_r_num :: int,
+ plet_max_reg_f_num :: int,
plet_maybe_from_full_slot :: maybe(int),
plet_maybe_io_seq_slot :: maybe(int),
plet_maybe_trail_slot :: maybe(int),
diff --git a/compiler/layout_out.m b/compiler/layout_out.m
index 29d7add..f843bb4 100644
--- a/compiler/layout_out.m
+++ b/compiler/layout_out.m
@@ -1459,7 +1459,7 @@ output_exec_trace_slot(Info, ExecTrace, !Slot, !IO) :-
ExecTrace = proc_layout_exec_trace(MaybeCallLabelSlotName,
EventLayoutsSlotName, NumEventLayouts, MaybeTableInfo,
MaybeHeadVarsSlotName, NumHeadVarNums, MaybeVarNamesSlotName,
- MaxVarNum, MaxRegNum, MaybeFromFullSlot, MaybeIoSeqSlot,
+ MaxVarNum, MaxRegR, MaxRegF, MaybeFromFullSlot, MaybeIoSeqSlot,
MaybeTrailSlot, MaybeMaxfrSlot, EvalMethod, MaybeCallTableSlot,
MaybeTailRecSlot, EffTraceLevel, Flags),
AutoComments = Info ^ lout_auto_comments,
@@ -1531,7 +1531,9 @@ output_exec_trace_slot(Info, ExecTrace, !Slot, !IO) :-
io.write_string(",", !IO),
io.write_int(MaxVarNum, !IO),
io.write_string(",", !IO),
- io.write_int(MaxRegNum, !IO),
+ io.write_int(MaxRegR, !IO),
+ io.write_string(",", !IO),
+ io.write_int(MaxRegF, !IO),
io.write_string(",", !IO),
write_maybe_slot_num(MaybeFromFullSlot, !IO),
io.write_string(",", !IO),
diff --git a/compiler/llds.m b/compiler/llds.m
index ecdccfb..1bc231c 100644
--- a/compiler/llds.m
+++ b/compiler/llds.m
@@ -1047,6 +1047,12 @@
% value of `curfr'. These are used in nondet code. Framevar slot
% numbers start at 1.
+ ; double_stackvar(double_stack_type, int)
+ % Two consecutive stack slots for storing a double-precision float:
+ % - stackvar(Slot), stackvar(Slot + 1)
+ % - parent_stackvar(Slot), parent_stackvar(Slot + 1)
+ % - framevar(Slot), framevar(Slot + 1)
+
; succip_slot(rval)
% The succip slot of the specified nondet stack frame; holds the
% code address to jump to on successful exit from this nondet
@@ -1098,6 +1104,11 @@
% during code generation, but should not be present in the LLDS
% at any stage after code generation.
+:- type double_stack_type
+ ---> double_stackvar
+ ; double_parent_stackvar
+ ; double_framevar.
+
% An rval is an expression that represents a value.
%
:- type rval
@@ -1196,10 +1207,6 @@
:- type layout_slot_id_kind
---> table_io_decl_id.
-:- type reg_type
- ---> reg_r % general-purpose (integer) regs
- ; reg_f. % floating point regs
-
% There are two kinds of labels: entry labels and internal labels.
% Entry labels are the entry points of procedures; internal labels are not.
%
@@ -1411,6 +1418,10 @@
---> have_unboxed_floats
; do_not_have_unboxed_floats.
+:- type use_float_registers
+ ---> use_float_registers
+ ; do_not_use_float_registers.
+
:- type have_static_ground_cells
---> have_static_ground_cells
; do_not_have_static_ground_cells.
@@ -1428,6 +1439,7 @@
non_local_gotos :: have_non_local_gotos,
asm_labels :: have_asm_labels,
unboxed_floats :: have_unboxed_floats,
+ float_registers :: use_float_registers,
static_ground_cells :: have_static_ground_cells,
static_ground_floats :: have_static_ground_floats,
static_code_addresses :: have_static_code_addresses
@@ -1436,6 +1448,7 @@
:- func get_nonlocal_gotos(exprn_opts) = have_non_local_gotos.
:- func get_asm_labels(exprn_opts) = have_asm_labels.
:- func get_unboxed_floats(exprn_opts) = have_unboxed_floats.
+:- func get_float_registers(exprn_opts) = use_float_registers.
:- func get_static_ground_cells(exprn_opts) = have_static_ground_cells.
:- func get_static_ground_floats(exprn_opts) = have_static_ground_floats.
:- func get_static_code_addresses(exprn_opts) = have_static_code_addresses.
@@ -1459,26 +1472,57 @@ first_nonfixed_embedded_slot_addr(EmbeddedStackId, FixedSize) = Rval :-
LowestAddrNonfixedSlot = LastSlot - FixedSize,
Rval = stack_slot_num_to_lval_ref(MainStackId, LowestAddrNonfixedSlot).
-stack_slot_to_lval(det_slot(N)) = stackvar(N).
-stack_slot_to_lval(parent_det_slot(N)) = parent_stackvar(N).
-stack_slot_to_lval(nondet_slot(N)) = framevar(N).
+stack_slot_to_lval(Slot) = Lval :-
+ (
+ Slot = det_slot(N, Width),
+ (
+ Width = single_width,
+ Lval = stackvar(N)
+ ;
+ Width = double_width,
+ Lval = double_stackvar(double_stackvar, N)
+ )
+ ;
+ Slot = parent_det_slot(N, Width),
+ (
+ Width = single_width,
+ Lval = parent_stackvar(N)
+ ;
+ Width = double_width,
+ Lval = double_stackvar(double_parent_stackvar, N)
+ )
+ ;
+ Slot = nondet_slot(N, Width),
+ (
+ Width = single_width,
+ Lval = framevar(N)
+ ;
+ Width = double_width,
+ Lval = double_stackvar(double_framevar, N)
+ )
+ ).
key_stack_slot_to_lval(_, Slot) =
stack_slot_to_lval(Slot).
abs_locn_to_lval_or_any_reg(any_reg) = loa_any_reg.
-abs_locn_to_lval_or_any_reg(abs_reg(N)) = loa_lval(reg(reg_r, N)).
-abs_locn_to_lval_or_any_reg(abs_stackvar(N)) = loa_lval(stackvar(N)).
-abs_locn_to_lval_or_any_reg(abs_parent_stackvar(N))
- = loa_lval(parent_stackvar(N)).
-abs_locn_to_lval_or_any_reg(abs_framevar(N)) = loa_lval(framevar(N)).
+abs_locn_to_lval_or_any_reg(abs_reg(Type, N)) = loa_lval(reg(Type, N)).
+abs_locn_to_lval_or_any_reg(abs_stackvar(N, Width)) =
+ loa_lval(stack_slot_to_lval(det_slot(N, Width))).
+abs_locn_to_lval_or_any_reg(abs_parent_stackvar(N, Width)) =
+ loa_lval(stack_slot_to_lval(parent_det_slot(N, Width))).
+abs_locn_to_lval_or_any_reg(abs_framevar(N, Width)) =
+ loa_lval(stack_slot_to_lval(nondet_slot(N, Width))).
abs_locn_to_lval(any_reg) = _ :-
unexpected($module, $pred, "any_reg").
-abs_locn_to_lval(abs_reg(N)) = reg(reg_r, N).
-abs_locn_to_lval(abs_stackvar(N)) = stackvar(N).
-abs_locn_to_lval(abs_parent_stackvar(N)) = parent_stackvar(N).
-abs_locn_to_lval(abs_framevar(N)) = framevar(N).
+abs_locn_to_lval(abs_reg(Type, N)) = reg(Type, N).
+abs_locn_to_lval(abs_stackvar(N, Width)) =
+ stack_slot_to_lval(det_slot(N, Width)).
+abs_locn_to_lval(abs_parent_stackvar(N, Width)) =
+ stack_slot_to_lval(parent_det_slot(N, Width)).
+abs_locn_to_lval(abs_framevar(N, Width)) =
+ stack_slot_to_lval(nondet_slot(N, Width)).
key_abs_locn_to_lval(_, AbsLocn) =
abs_locn_to_lval(AbsLocn).
@@ -1520,6 +1564,7 @@ lval_type(temp(RegType, _), Type) :-
lval_type(stackvar(_), lt_word).
lval_type(parent_stackvar(_), lt_word).
lval_type(framevar(_), lt_word).
+lval_type(double_stackvar(_, _), lt_float).
lval_type(succip_slot(_), lt_code_ptr).
lval_type(redoip_slot(_), lt_code_ptr).
lval_type(redofr_slot(_), lt_data_ptr).
@@ -1647,6 +1692,7 @@ get_nonlocal_gotos(ExprnOpts) = ExprnOpts ^ non_local_gotos.
get_asm_labels(ExprnOpts) = ExprnOpts ^ asm_labels.
get_static_ground_cells(ExprnOpts) = ExprnOpts ^ static_ground_cells.
get_unboxed_floats(ExprnOpts) = ExprnOpts ^ unboxed_floats.
+get_float_registers(ExprnOpts) = ExprnOpts ^ float_registers.
get_static_ground_floats(ExprnOpts) = ExprnOpts ^ static_ground_floats.
get_static_code_addresses(ExprnOpts) = ExprnOpts ^ static_code_addresses.
diff --git a/compiler/llds_out_data.m b/compiler/llds_out_data.m
index d5a8671..43d5746 100644
--- a/compiler/llds_out_data.m
+++ b/compiler/llds_out_data.m
@@ -17,6 +17,7 @@
:- module ll_backend.llds_out.llds_out_data.
:- interface.
+:- import_module hlds.hlds_llds.
:- import_module ll_backend.llds.
:- import_module ll_backend.llds_out.llds_out_util.
@@ -202,6 +203,7 @@ output_record_lval_decls_format(Info, Lval, FirstIndent, LaterIndent,
; Lval = stackvar(_)
; Lval = parent_stackvar(_)
; Lval = framevar(_)
+ ; Lval = double_stackvar(_, _)
; Lval = succip
; Lval = maxfr
; Lval = curfr
@@ -263,6 +265,11 @@ output_lval(Info, Lval, !IO) :-
io.write_int(N, !IO),
io.write_string(")", !IO)
;
+ Lval = double_stackvar(StackType, SlotNum),
+ io.write_string("MR_float_from_dword_ptr(", !IO),
+ output_double_stackvar_ptr(Info, StackType, SlotNum, !IO),
+ io.write_string(")", !IO)
+ ;
Lval = succip,
io.write_string("MR_succip", !IO)
;
@@ -352,8 +359,13 @@ output_lval(Info, Lval, !IO) :-
output_lval_for_assign(Info, Lval, Type, !IO) :-
(
Lval = reg(RegType, Num),
- Type = lt_word,
- expect(unify(RegType, reg_r), $module, $pred, "float reg"),
+ (
+ RegType = reg_r,
+ Type = lt_word
+ ;
+ RegType = reg_f,
+ Type = lt_float
+ ),
output_reg(RegType, Num, !IO)
;
Lval = stackvar(N),
@@ -389,6 +401,11 @@ output_lval_for_assign(Info, Lval, Type, !IO) :-
io.write_int(N, !IO),
io.write_string(")", !IO)
;
+ Lval = double_stackvar(StackType, SlotNum),
+ Type = lt_float,
+ io.write_string("* (MR_Float *) ", !IO),
+ output_double_stackvar_ptr(Info, StackType, SlotNum, !IO)
+ ;
Lval = succip,
Type = lt_word,
io.write_string("MR_succip_word", !IO)
@@ -502,6 +519,25 @@ output_lval_as_word(Info, Lval, !IO) :-
io.write_string(")", !IO)
).
+:- pred output_double_stackvar_ptr(llds_out_info::in,
+ double_stack_type::in, int::in, io::di, io::uo) is det.
+
+output_double_stackvar_ptr(Info, StackType, SlotNum, !IO) :-
+ % We take the address of the second slot because our stacks grow downwards,
+ % i.e. &MR_sv(n + 1) < &MR_sv(n).
+ (
+ StackType = double_stackvar,
+ Lval = stackvar(SlotNum + 1)
+ ;
+ StackType = double_parent_stackvar,
+ Lval = parent_stackvar(SlotNum + 1)
+ ;
+ StackType = double_framevar,
+ Lval = framevar(SlotNum + 1)
+ ),
+ io.write_string("&", !IO),
+ output_lval(Info, Lval, !IO).
+
% llds_types_match(DesiredType, ActualType) is true iff
% a value of type ActualType can be used as a value of
% type DesiredType without casting.
@@ -551,14 +587,26 @@ output_llds_type(lt_data_ptr, !IO) :-
output_llds_type(lt_code_ptr, !IO) :-
io.write_string("MR_Code *", !IO).
+lval_to_string(reg(RegType, RegNum)) =
+ "reg(" ++ reg_to_string(RegType, RegNum) ++ ")".
lval_to_string(framevar(N)) =
"MR_fv(" ++ int_to_string(N) ++ ")".
lval_to_string(stackvar(N)) =
"MR_sv(" ++ int_to_string(N) ++ ")".
lval_to_string(parent_stackvar(N)) =
"MR_parent_sv(" ++ int_to_string(N) ++ ")".
-lval_to_string(reg(RegType, RegNum)) =
- "reg(" ++ reg_to_string(RegType, RegNum) ++ ")".
+lval_to_string(double_stackvar(Type, N)) = String :-
+ (
+ Type = double_stackvar,
+ Macro = "MR_sv"
+ ;
+ Type = double_parent_stackvar,
+ Macro = "MR_parent_sv"
+ ;
+ Type = double_framevar,
+ Macro = "MR_fv"
+ ),
+ string.format("%s(%d,%d)", [s(Macro), i(N), i(N + 1)], String).
reg_to_string(reg_r, N) =
( N =< max_real_r_reg ->
@@ -569,7 +617,11 @@ reg_to_string(reg_r, N) =
unexpected($module, $pred, "register number too large")
).
reg_to_string(reg_f, N) =
- "MR_f(" ++ int_to_string(N) ++ ")".
+ ( N =< max_virtual_f_reg ->
+ "MR_f(" ++ int_to_string(N) ++ ")"
+ ;
+ unexpected($module, $pred, "register number too large")
+ ).
:- func max_real_r_reg = int.
:- func max_virtual_r_reg = int.
@@ -577,12 +629,14 @@ reg_to_string(reg_f, N) =
max_real_r_reg = 32.
max_virtual_r_reg = 1024.
+:- func max_virtual_f_reg = int.
+
+max_virtual_f_reg = 1024.
+
:- pred output_reg(reg_type::in, int::in, io::di, io::uo) is det.
-output_reg(reg_r, N, !IO) :-
- io.write_string(reg_to_string(reg_r, N), !IO).
-output_reg(reg_f, _, !IO) :-
- sorry($module, $pred, "Floating point registers not implemented").
+output_reg(RegType, N, !IO) :-
+ io.write_string(reg_to_string(RegType, N), !IO).
% The calls to env_var_is_acceptable_char in prog_io_goal.m ensure that
% EnvVarName is acceptable as part of a C identifier.
diff --git a/compiler/llds_out_instr.m b/compiler/llds_out_instr.m
index 220bf53..2567428 100644
--- a/compiler/llds_out_instr.m
+++ b/compiler/llds_out_instr.m
@@ -1950,29 +1950,44 @@ output_foreign_proc_output(Info, Output, !IO) :-
)
;
MaybeForeignType = no,
- output_lval_as_word(Info, Lval, !IO),
- io.write_string(" = ", !IO),
( OrigType = builtin_type(BuiltinType) ->
(
BuiltinType = builtin_type_string,
+ output_lval_as_word(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
output_llds_type_cast(lt_word, !IO),
io.write_string(VarName, !IO)
;
BuiltinType = builtin_type_float,
- io.write_string("MR_float_to_word(", !IO),
- io.write_string(VarName, !IO),
- io.write_string(")", !IO)
+ llds.lval_type(Lval, ActualType),
+ ( ActualType = lt_float ->
+ output_lval(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
+ io.write_string(VarName, !IO)
+ ;
+ output_lval_as_word(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
+ io.write_string("MR_float_to_word(", !IO),
+ io.write_string(VarName, !IO),
+ io.write_string(")", !IO)
+ )
;
BuiltinType = builtin_type_char,
+ output_lval_as_word(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
% Characters must be cast to MR_UnsignedChar to
% prevent sign-extension.
io.write_string("(MR_UnsignedChar) ", !IO),
io.write_string(VarName, !IO)
;
BuiltinType = builtin_type_int,
+ output_lval_as_word(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
io.write_string(VarName, !IO)
)
;
+ output_lval_as_word(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
io.write_string(VarName, !IO)
)
)
diff --git a/compiler/llds_to_x86_64.m b/compiler/llds_to_x86_64.m
index dacdcc9..7894916 100644
--- a/compiler/llds_to_x86_64.m
+++ b/compiler/llds_to_x86_64.m
@@ -49,6 +49,7 @@
:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.name_mangle.
+:- import_module hlds.hlds_llds.
:- import_module ll_backend.llds_out.
:- import_module ll_backend.llds_out.llds_out_code_addr.
:- import_module ll_backend.x86_64_out.
@@ -507,6 +508,8 @@ transform_lval(!RegMap, framevar(Offset), Op, Instr) :-
Instr = yes([x86_64_instr(mov(
operand_label(FakeRegVal), operand_reg(ScratchReg)))])
).
+transform_lval(!RegMap, double_stackvar(_, _), _, _) :-
+ sorry($module, $pred, "double_stackvar").
transform_lval(!RegMap, succip_slot(Rval), Op, Instr) :-
transform_rval(!RegMap, Rval, Op, Instr).
transform_lval(!RegMap, redoip_slot(Rval), Op, Instr) :-
diff --git a/compiler/lookup_switch.m b/compiler/lookup_switch.m
index 0a590a7..c301887 100644
--- a/compiler/lookup_switch.m
+++ b/compiler/lookup_switch.m
@@ -399,7 +399,7 @@ generate_simple_int_lookup_switch(IndexRval, StoreMap, StartVal, EndVal,
% Since we release BaseReg only after the call to generate_branch_end,
% we must make sure that generate_branch_end won't want to overwrite
% BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
MaybeBaseReg = yes(BaseReg),
% Generate the static lookup table for this switch.
@@ -525,7 +525,7 @@ generate_several_soln_int_lookup_switch(IndexRval, EndLabel, StoreMap,
% Since we release BaseReg only after the calls to generate_branch_end,
% we must make sure that generate_branch_end won't want to overwrite
% BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
% IndexRval has already had Start subtracted from it.
BaseRegInitCode = singleton(
llds_instr(
@@ -666,7 +666,7 @@ generate_code_for_each_kind([Kind | Kinds], NumPrevColumns,
RestoreTicketCode),
maybe_restore_hp(MaybeHpSlot, RestoreHpCode),
- acquire_reg_not_in_storemap(StoreMap, LaterBaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, LaterBaseReg, !CI),
get_next_label(UndoLabel, !CI),
get_next_label(AfterUndoLabel, !CI),
list.length(OutVars, NumOutVars),
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index 8adcd9a..dce9932 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -295,13 +295,17 @@ use_double_word_floats(Globals, DoubleWordFloats) :-
TargetWordBits = 32,
SinglePrecFloat = no
->
- % Until we implement float registers for low-level C grades,
- % storing double-word floats in structures does more harm than
- % good.
- % globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
- % DoubleWordFloats = HighLevelCode
- % XXX pw -- for testing
- DoubleWordFloats = yes
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ (
+ HighLevelCode = yes,
+ DoubleWordFloats = yes
+ ;
+ HighLevelCode = no,
+ % Double word floats in structures works best in conjunction
+ % with float registers. Work on the latter is in progress.
+ globals.lookup_bool_option(Globals, use_float_registers,
+ DoubleWordFloats)
+ )
;
DoubleWordFloats = no
)
diff --git a/compiler/opt_debug.m b/compiler/opt_debug.m
index 4b6cab0..dfd6d58 100644
--- a/compiler/opt_debug.m
+++ b/compiler/opt_debug.m
@@ -19,6 +19,7 @@
:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.rtti.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_llds.
:- import_module ll_backend.layout.
:- import_module ll_backend.livemap.
:- import_module ll_backend.llds.
@@ -274,6 +275,18 @@ dump_lval(_, parent_stackvar(N)) =
"parent_sv" ++ int_to_string(N).
dump_lval(_, framevar(N)) =
"fv" ++ int_to_string(N).
+dump_lval(_, double_stackvar(Type, N)) = Str :-
+ (
+ Type = double_stackvar,
+ Macro = "sv"
+ ;
+ Type = double_parent_stackvar,
+ Macro = "parent_sv"
+ ;
+ Type= double_framevar,
+ Macro = "fv"
+ ),
+ string.format("%s%d,%s%d", [s(Macro), i(N), s(Macro), i(N + 1)], Str).
dump_lval(_, succip) = "succip".
dump_lval(_, maxfr) = "maxfr".
dump_lval(_, curfr) = "curfr".
diff --git a/compiler/opt_util.m b/compiler/opt_util.m
index b203833..7264895 100644
--- a/compiler/opt_util.m
+++ b/compiler/opt_util.m
@@ -322,6 +322,7 @@
:- import_module backend_libs.builtin_ops.
:- import_module check_hlds.type_util.
+:- import_module hlds.hlds_llds.
:- import_module hlds.special_pred.
:- import_module ll_backend.exprn_aux.
:- import_module parse_tree.prog_data.
@@ -710,6 +711,7 @@ lval_refers_stackvars(reg(_, _)) = no.
lval_refers_stackvars(stackvar(_)) = yes.
lval_refers_stackvars(parent_stackvar(_)) = yes.
lval_refers_stackvars(framevar(_)) = yes.
+lval_refers_stackvars(double_stackvar(_, _)) = yes.
lval_refers_stackvars(succip) = no.
lval_refers_stackvars(maxfr) = no.
lval_refers_stackvars(curfr) = no.
@@ -1799,17 +1801,15 @@ count_temps_lval(Lval, !R, !F) :-
; Lval = stackvar(_)
; Lval = framevar(_)
; Lval = parent_stackvar(_)
+ ; Lval = double_stackvar(_, _)
; Lval = global_var_ref(_)
)
;
- Lval = temp(Type, N),
- (
- Type = reg_r,
- int.max(N, !R)
- ;
- Type = reg_f,
- int.max(N, !F)
- )
+ Lval = temp(reg_r, N),
+ int.max(N, !R)
+ ;
+ Lval = temp(reg_f, N),
+ int.max(N, !F)
;
Lval = field(_, BaseAddrRval, FieldNumRval),
count_temps_rval(BaseAddrRval, !R, !F),
@@ -2029,6 +2029,7 @@ touches_nondet_ctrl_lval(reg(_, _)) = no.
touches_nondet_ctrl_lval(stackvar(_)) = no.
touches_nondet_ctrl_lval(parent_stackvar(_)) = no.
touches_nondet_ctrl_lval(framevar(_)) = no.
+touches_nondet_ctrl_lval(double_stackvar(_, _)) = no.
touches_nondet_ctrl_lval(succip) = no.
touches_nondet_ctrl_lval(maxfr) = yes.
touches_nondet_ctrl_lval(curfr) = yes.
@@ -2104,6 +2105,7 @@ lval_access_rvals(reg(_, _), []).
lval_access_rvals(stackvar(_), []).
lval_access_rvals(parent_stackvar(_), []).
lval_access_rvals(framevar(_), []).
+lval_access_rvals(double_stackvar(_, _), []).
lval_access_rvals(succip, []).
lval_access_rvals(maxfr, []).
lval_access_rvals(curfr, []).
@@ -2620,6 +2622,7 @@ replace_labels_lval(Lval0, Lval, ReplMap) :-
; Lval0 = stackvar(_)
; Lval0 = framevar(_)
; Lval0 = parent_stackvar(_)
+ ; Lval0 = double_stackvar(_, _)
; Lval0 = succip
; Lval0 = maxfr
; Lval0 = curfr
diff --git a/compiler/options.m b/compiler/options.m
index c053dd4..213ee9e 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -417,6 +417,7 @@
; gcc_global_registers
; asm_labels
; pic_reg
+ ; use_float_registers
% MLDS back-end compilation model options
; highlevel_code
@@ -1344,6 +1345,7 @@ option_defaults_2(compilation_model_option, [
gcc_non_local_gotos - bool(yes),
gcc_global_registers - bool(yes),
asm_labels - bool(yes),
+ use_float_registers - bool(no),
% MLDS back-end compilation model options
highlevel_code - bool(no),
@@ -2232,6 +2234,7 @@ long_option("high-level-data", highlevel_data).
long_option("gcc-non-local-gotos", gcc_non_local_gotos).
long_option("gcc-global-registers", gcc_global_registers).
long_option("asm-labels", asm_labels).
+long_option("use-float-registers", use_float_registers).
% MLDS back-end compilation model options
long_option("highlevel-code", highlevel_code).
long_option("high-level-code", highlevel_code).
@@ -4418,6 +4421,10 @@ options_help_compilation_model -->
"\texhaustion at the cost of increased execution time.",
"\tThis option is ignored if the `--high-level-code' option is",
"\tenabled."
+ % This is a developer only option.
+% "--use-float-registers",
+% "(This option is not for general use.)",
+% "\tUse float registers for argument passing."
]),
io.write_string("\n MLDS back-end compilation model options:\n"),
diff --git a/compiler/par_conj_gen.m b/compiler/par_conj_gen.m
index 048a691..3170bc0 100644
--- a/compiler/par_conj_gen.m
+++ b/compiler/par_conj_gen.m
@@ -349,6 +349,18 @@ replace_stack_vars_by_parent_sv_lval(Lval0, Lval, !Acc) :-
),
Lval = parent_stackvar(SlotNum)
;
+ Lval0 = double_stackvar(Type, SlotNum),
+ (
+ Type = double_stackvar,
+ Lval = double_stackvar(double_parent_stackvar, SlotNum)
+ ;
+ Type = double_parent_stackvar,
+ Lval = Lval0
+ ;
+ Type = double_framevar,
+ Lval = Lval0
+ )
+ ;
( Lval0 = reg(_Type, _RegNum)
; Lval0 = succip
; Lval0 = maxfr
diff --git a/compiler/pragma_c_gen.m b/compiler/pragma_c_gen.m
index 0c5b275..6a0ba8d 100644
--- a/compiler/pragma_c_gen.m
+++ b/compiler/pragma_c_gen.m
@@ -71,6 +71,7 @@
:- import_module ll_backend.code_util.
:- import_module ll_backend.llds_out.
:- import_module ll_backend.llds_out.llds_out_code_addr.
+:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.
@@ -615,7 +616,16 @@ generate_ordinary_foreign_proc_code(CodeModel, Attributes, PredId, ProcId,
),
% <assignment of the output values from local variables to registers>
- foreign_proc_acquire_regs(OutCArgs, Regs, !CI),
+ get_exprn_opts(!.CI, ExprnOpts),
+ UseFloatRegs = get_float_registers(ExprnOpts),
+ (
+ UseFloatRegs = use_float_registers,
+ FloatRegType = reg_f
+ ;
+ UseFloatRegs = do_not_use_float_registers,
+ FloatRegType = reg_r
+ ),
+ foreign_proc_acquire_regs(FloatRegType, OutCArgs, Regs, !CI),
place_foreign_proc_output_args_in_regs(OutCArgs, Regs,
CanOptAwayUnnamedArgs, OutputDescs, !CI),
OutputComp = foreign_proc_outputs(OutputDescs),
@@ -792,15 +802,22 @@ make_c_arg_list([_ | _], [], _) :-
list(arg_info)::in, list(c_arg)::out) is det.
make_extra_c_arg_list(ExtraArgs, ModuleInfo, ArgInfos, ExtraCArgs) :-
- get_highest_arg_num(ArgInfos, 0, MaxArgNum),
- make_extra_c_arg_list_seq(ExtraArgs, ModuleInfo, MaxArgNum, ExtraCArgs).
+ get_highest_arg_num(ArgInfos, 0, MaxR, 0, _MaxF),
+ make_extra_c_arg_list_seq(ExtraArgs, ModuleInfo, MaxR, ExtraCArgs).
-:- pred get_highest_arg_num(list(arg_info)::in, int::in, int::out) is det.
+:- pred get_highest_arg_num(list(arg_info)::in, int::in, int::out,
+ int::in, int::out) is det.
-get_highest_arg_num([], !Max).
-get_highest_arg_num([arg_info(Loc, _) | ArgInfos], !Max) :-
- int.max(Loc, !Max),
- get_highest_arg_num(ArgInfos, !Max).
+get_highest_arg_num([], !MaxR, !MaxF).
+get_highest_arg_num([arg_info(Loc, _) | ArgInfos], !MaxR, !MaxF) :-
+ (
+ Loc = reg(reg_r, RegNum),
+ int.max(RegNum, !MaxR)
+ ;
+ Loc = reg(reg_f, RegNum),
+ int.max(RegNum, !MaxF)
+ ),
+ get_highest_arg_num(ArgInfos, !MaxR, !MaxF).
:- pred make_extra_c_arg_list_seq(list(foreign_arg)::in, module_info::in,
int::in, list(c_arg)::out) is det.
@@ -816,9 +833,10 @@ make_extra_c_arg_list_seq([ExtraArg | ExtraArgs], ModuleInfo, LastReg,
MaybeNameMode = no,
unexpected($module, $pred, "no name")
),
+ % Extra args are always input, and passed in regular registers.
+ RegType = reg_r,
NextReg = LastReg + 1,
- % Extra args are always input.
- ArgInfo = arg_info(NextReg, ArgMode),
+ ArgInfo = arg_info(reg(RegType, NextReg), ArgMode),
CArg = c_arg(Var, yes(Name), OrigType, BoxPolicy, ArgInfo),
make_extra_c_arg_list_seq(ExtraArgs, ModuleInfo, NextReg, CArgs).
@@ -1023,14 +1041,31 @@ get_maybe_foreign_type_info(CI, Type) = MaybeForeignTypeInfo :-
% foreign_proc_acquire_regs acquires a list of registers in which to place
% each of the given arguments.
%
-:- pred foreign_proc_acquire_regs(list(c_arg)::in, list(lval)::out,
- code_info::in, code_info::out) is det.
+:- pred foreign_proc_acquire_regs(reg_type::in,
+ list(c_arg)::in, list(lval)::out, code_info::in, code_info::out) is det.
-foreign_proc_acquire_regs([], [], !CI).
-foreign_proc_acquire_regs([Arg | Args], [Reg | Regs], !CI) :-
- Arg = c_arg(Var, _, _, _, _),
- acquire_reg_for_var(Var, Reg, !CI),
- foreign_proc_acquire_regs(Args, Regs, !CI).
+foreign_proc_acquire_regs(_, [], [], !CI).
+foreign_proc_acquire_regs(FloatRegType, [Arg | Args], [Reg | Regs], !CI) :-
+ Arg = c_arg(Var, _, VarType, BoxPolicy, _),
+ foreign_proc_arg_reg_type(FloatRegType, VarType, BoxPolicy, RegType),
+ acquire_reg_for_var(Var, RegType, Reg, !CI),
+ foreign_proc_acquire_regs(FloatRegType, Args, Regs, !CI).
+
+:- pred foreign_proc_arg_reg_type(reg_type::in, mer_type::in, box_policy::in,
+ reg_type::out) is det.
+
+foreign_proc_arg_reg_type(FloatRegType, VarType, BoxPolicy, RegType) :-
+ (
+ BoxPolicy = native_if_possible,
+ ( VarType = float_type ->
+ RegType = FloatRegType
+ ;
+ RegType = reg_r
+ )
+ ;
+ BoxPolicy = always_boxed,
+ RegType = reg_r
+ ).
%---------------------------------------------------------------------------%
@@ -1090,8 +1125,8 @@ input_descs_from_arg_info(CI, [Arg | Args], CanOptAwayUnnamedArgs, Inputs) :-
(
MaybeName = yes(Name),
VarType = variable_type(CI, Var),
- ArgInfo = arg_info(N, _),
- Reg = reg(reg_r, N),
+ ArgInfo = arg_info(Loc, _),
+ arg_loc_to_register(Loc, Reg),
MaybeForeign = get_maybe_foreign_type_info(CI, OrigType),
get_module_info(CI, ModuleInfo),
IsDummy = check_dummy_type(ModuleInfo, VarType),
@@ -1120,8 +1155,8 @@ output_descs_from_arg_info(CI, [Arg | Args], CanOptAwayUnnamedArgs, Outputs) :-
(
MaybeName = yes(Name),
VarType = variable_type(CI, Var),
- ArgInfo = arg_info(N, _),
- Reg = reg(reg_r, N),
+ ArgInfo = arg_info(Loc, _),
+ arg_loc_to_register(Loc, Reg),
MaybeForeign = get_maybe_foreign_type_info(CI, OrigType),
get_module_info(CI, ModuleInfo),
IsDummy = check_dummy_type(ModuleInfo, VarType),
diff --git a/compiler/proc_gen.m b/compiler/proc_gen.m
index 4ecb59d..c55fc86 100644
--- a/compiler/proc_gen.m
+++ b/compiler/proc_gen.m
@@ -338,7 +338,7 @@ generate_proc_code(PredInfo, ProcInfo0, PredId, ProcId, ModuleInfo0,
;
MaybeFollowVars = no,
map.init(FollowVarsMap),
- FollowVars = abs_follow_vars(FollowVarsMap, 1)
+ FollowVars = abs_follow_vars(FollowVarsMap, 1, 1)
),
basic_stack_layout_for_proc(PredInfo, Globals, BasicStackLayout,
ForceProcId),
@@ -375,7 +375,7 @@ generate_proc_code(PredInfo, ProcInfo0, PredId, ProcId, ModuleInfo0,
generate_category_code(CodeModel, ProcContext, Goal, OutsideResumePoint,
TraceSlotInfo, CodeTree, MaybeTraceCallLabel, FrameInfo,
CodeInfo0, CodeInfo),
- get_max_reg_in_use_at_trace(CodeInfo, MaxTraceReg),
+ get_max_reg_in_use_at_trace(CodeInfo, MaxTraceRegR, MaxTraceRegF),
get_static_cell_info(CodeInfo, StaticCellInfo),
global_data_set_static_cell_info(StaticCellInfo, !GlobalData),
@@ -476,7 +476,7 @@ generate_proc_code(PredInfo, ProcInfo0, PredId, ProcId, ModuleInfo0,
),
ProcLayout = proc_layout_info(RttiProcLabel, EntryLabel,
Detism, TotalSlots, MaybeSuccipSlot, EvalMethod,
- EffTraceLevel, MaybeTraceCallLabel, MaxTraceReg,
+ EffTraceLevel, MaybeTraceCallLabel, MaxTraceRegR, MaxTraceRegF,
HeadVars, ArgModes, Goal, NeedGoalRep, InstMap0,
TraceSlotInfo, ForceProcId, VarSet, VarTypes,
InternalMap, MaybeTableInfo, NeedsAllNames,
diff --git a/compiler/stack_alloc.m b/compiler/stack_alloc.m
index 373c6e9..81ad598 100644
--- a/compiler/stack_alloc.m
+++ b/compiler/stack_alloc.m
@@ -47,7 +47,9 @@
:- import_module libs.trace_params.
:- import_module ll_backend.live_vars.
:- import_module ll_backend.liveness.
+:- import_module ll_backend.llds.
:- import_module ll_backend.trace_gen.
+:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.set_of_var.
@@ -59,6 +61,7 @@
:- import_module map.
:- import_module maybe.
:- import_module pair.
+:- import_module require.
:- import_module set.
%-----------------------------------------------------------------------------%
@@ -107,12 +110,34 @@ allocate_stack_slots_in_proc(ModuleInfo, proc(PredId, _ProcId), !ProcInfo) :-
set.to_sorted_list(ColourSets, ColourList),
CodeModel = proc_info_interface_code_model(!.ProcInfo),
- allocate_stack_slots(ColourList, CodeModel, NumReservedSlots,
- MaybeReservedVarInfo, StackSlots1),
- allocate_dummy_stack_slots(DummyVars, CodeModel, -1,
+ MainStack = code_model_to_main_stack(CodeModel),
+ FloatWidth = get_float_width(Globals),
+ allocate_stack_slots(ColourList, MainStack, VarTypes, FloatWidth,
+ NumReservedSlots, MaybeReservedVarInfo, StackSlots1),
+ allocate_dummy_stack_slots(DummyVars, MainStack, -1,
StackSlots1, StackSlots),
proc_info_set_stack_slots(StackSlots, !ProcInfo).
+:- func get_float_width(globals) = stack_slot_width.
+
+get_float_width(Globals) = FloatWidth :-
+ globals.lookup_int_option(Globals, bits_per_word, TargetWordBits),
+ ( TargetWordBits = 64 ->
+ FloatWidth = single_width
+ ; TargetWordBits = 32 ->
+ globals.lookup_bool_option(Globals, single_prec_float,
+ SinglePrecFloat),
+ (
+ SinglePrecFloat = yes,
+ FloatWidth = single_width
+ ;
+ SinglePrecFloat = no,
+ FloatWidth = double_width
+ )
+ ;
+ unexpected($module, $pred, "bits_per_word not 32 or 64")
+ ).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -186,55 +211,98 @@ var_is_not_dummy(DummyVarArray, Var) :-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred allocate_stack_slots(list(set_of_progvar)::in, code_model::in, int::in,
+:- pred allocate_stack_slots(list(set_of_progvar)::in, main_stack::in,
+ vartypes::in, stack_slot_width::in, int::in,
maybe(pair(prog_var, int))::in, stack_slots::out) is det.
-allocate_stack_slots(ColourList, CodeModel, NumReservedSlots,
- MaybeReservedVarInfo, StackSlots) :-
+allocate_stack_slots(ColourList, MainStack, VarTypes, FloatWidth,
+ NumReservedSlots, MaybeReservedVarInfo, StackSlots) :-
% The reserved slots are referred to by fixed number
% (e.g. framevar(1)) in trace.setup.
FirstVarSlot = NumReservedSlots + 1,
- allocate_stack_slots_2(ColourList, CodeModel, FirstVarSlot,
- MaybeReservedVarInfo, map.init, StackSlots).
+ allocate_stack_slots_2(ColourList, MainStack, VarTypes, FloatWidth,
+ MaybeReservedVarInfo, FirstVarSlot, map.init, StackSlots).
+
+:- pred allocate_stack_slots_2(list(set_of_progvar)::in, main_stack::in,
+ vartypes::in, stack_slot_width::in, maybe(pair(prog_var, int))::in,
+ int::in, stack_slots::in, stack_slots::out) is det.
+
+allocate_stack_slots_2([], _, _, _, _, _, !StackSlots).
+allocate_stack_slots_2([Vars | VarSets], MainStack, VarTypes, FloatWidth,
+ MaybeReservedVarInfo, N0, !StackSlots) :-
+ (
+ FloatWidth = single_width,
+ SingleWidthVars = Vars,
+ DoubleWidthVars = set_of_var.init
+ ;
+ FloatWidth = double_width,
+ set_of_var.divide(var_is_float(VarTypes), Vars,
+ DoubleWidthVars, SingleWidthVars)
+ ),
+ ( set_of_var.is_non_empty(SingleWidthVars) ->
+ allocate_stack_slots_3(SingleWidthVars, MainStack, single_width,
+ MaybeReservedVarInfo, N0, N1, !StackSlots)
+ ;
+ N1 = N0
+ ),
+ ( set_of_var.is_non_empty(DoubleWidthVars) ->
+ % XXX We do NOT currently allow single-width vars to overlap with
+ % double-width vars. The code generator does not understand that
+ % clobbering one of the pair of slots is equivalent to clobbering
+ % both of them.
+ allocate_stack_slots_3(DoubleWidthVars, MainStack, double_width,
+ MaybeReservedVarInfo, N1, N, !StackSlots)
+ ;
+ N = N1
+ ),
+ allocate_stack_slots_2(VarSets, MainStack, VarTypes, FloatWidth,
+ MaybeReservedVarInfo, N, !StackSlots).
-:- pred allocate_stack_slots_2(list(set_of_progvar)::in, code_model::in,
- int::in, maybe(pair(prog_var, int))::in,
+:- pred allocate_stack_slots_3(set_of_progvar::in, main_stack::in,
+ stack_slot_width::in, maybe(pair(prog_var, int))::in, int::in, int::out,
stack_slots::in, stack_slots::out) is det.
-allocate_stack_slots_2([], _, _, _, !StackSlots).
-allocate_stack_slots_2([Vars | VarSets], CodeModel, N0, MaybeReservedVarInfo,
- !StackSlots) :-
+allocate_stack_slots_3(Vars, MainStack, StackSlotWidth, MaybeReservedVarInfo,
+ !N, !StackSlots) :-
(
MaybeReservedVarInfo = yes(ResVar - ResSlotNum),
set_of_var.member(Vars, ResVar)
->
- SlotNum = ResSlotNum,
- N1 = N0
+ expect(unify(StackSlotWidth, single_width), $module, $pred,
+ "reserved multiple stack slots"),
+ SlotNum = ResSlotNum
;
- SlotNum = N0,
- N1 = N0 + 1
+ SlotNum = !.N,
+ (
+ StackSlotWidth = single_width,
+ !:N = !.N + 1
+ ;
+ StackSlotWidth = double_width,
+ !:N = !.N + 2
+ )
+ ),
+ (
+ MainStack = det_stack,
+ Locn = det_slot(SlotNum, StackSlotWidth)
+ ;
+ MainStack = nondet_stack,
+ Locn = nondet_slot(SlotNum, StackSlotWidth)
),
VarList = set_of_var.to_sorted_list(Vars),
- allocate_same_stack_slot(VarList, CodeModel, SlotNum, !StackSlots),
- allocate_stack_slots_2(VarSets, CodeModel, N1, MaybeReservedVarInfo,
- !StackSlots).
+ allocate_same_stack_slot(VarList, Locn, !StackSlots).
+
+:- pred var_is_float(vartypes::in, prog_var::in) is semidet.
+
+var_is_float(VarTypes, Var) :-
+ map.lookup(VarTypes, Var, float_type).
-:- pred allocate_same_stack_slot(list(prog_var)::in, code_model::in, int::in,
+:- pred allocate_same_stack_slot(list(prog_var)::in, stack_slot::in,
stack_slots::in, stack_slots::out) is det.
-allocate_same_stack_slot([], _CodeModel, _Slot, !StackSlots).
-allocate_same_stack_slot([Var | Vars], CodeModel, Slot, !StackSlots) :-
- (
- CodeModel = model_non,
- Locn = nondet_slot(Slot)
- ;
- ( CodeModel = model_det
- ; CodeModel = model_semi
- ),
- Locn = det_slot(Slot)
- ),
- map.det_insert(Var, Locn, !StackSlots),
- allocate_same_stack_slot(Vars, CodeModel, Slot, !StackSlots).
+allocate_same_stack_slot([], _Slot, !StackSlots).
+allocate_same_stack_slot([Var | Vars], Slot, !StackSlots) :-
+ map.det_insert(Var, Slot, !StackSlots),
+ allocate_same_stack_slot(Vars, Slot, !StackSlots).
% We must not allocate the same stack slot to dummy variables. If we do,
% then the code that saves variables on the stack at calls will get
@@ -247,13 +315,20 @@ allocate_same_stack_slot([Var | Vars], CodeModel, Slot, !StackSlots) :-
% grades, due to our policy of extending variable lifetimes, more than
% one io.state may be live at the same time.
%
-:- pred allocate_dummy_stack_slots(list(prog_var)::in, code_model::in,
+:- pred allocate_dummy_stack_slots(list(prog_var)::in, main_stack::in,
int::in, stack_slots::in, stack_slots::out) is det.
allocate_dummy_stack_slots([], _, _, !StackSlots).
-allocate_dummy_stack_slots([Var | Vars], CodeModel, N0, !StackSlots) :-
- allocate_same_stack_slot([Var], CodeModel, N0, !StackSlots),
- allocate_dummy_stack_slots(Vars, CodeModel, N0 - 1, !StackSlots).
+allocate_dummy_stack_slots([Var | Vars], MainStack, N0, !StackSlots) :-
+ (
+ MainStack = det_stack,
+ Locn = det_slot(N0, single_width)
+ ;
+ MainStack = nondet_stack,
+ Locn = nondet_slot(N0, single_width)
+ ),
+ allocate_same_stack_slot([Var], Locn, !StackSlots),
+ allocate_dummy_stack_slots(Vars, MainStack, N0 - 1, !StackSlots).
%-----------------------------------------------------------------------------%
:- end_module stack_alloc.
diff --git a/compiler/stack_layout.m b/compiler/stack_layout.m
index 416a939..ad123e3 100644
--- a/compiler/stack_layout.m
+++ b/compiler/stack_layout.m
@@ -104,6 +104,7 @@
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
+:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module libs.globals.
@@ -400,7 +401,7 @@ construct_proc_and_label_layouts_for_proc(Params, PLI, !LabelTables,
!StringTable, !StaticCellInfo, !LabelLayoutInfo, !ProcLayoutInfo) :-
PLI = proc_layout_info(RttiProcLabel, EntryLabel,
_Detism, _StackSlots, _SuccipLoc, _EvalMethod, _EffTraceLevel,
- _MaybeCallLabel, _MaxTraceReg, HeadVars, _ArgModes,
+ _MaybeCallLabel, _MaxTraceRegR, _MaxTraceRegF, HeadVars, _ArgModes,
Goal, _NeedGoalRep, _InstMap,
_TraceSlotInfo, ForceProcIdLayout, VarSet, _VarTypes,
InternalMap, MaybeTableIoDecl, _NeedsAllNames, _MaybeDeepProfInfo),
@@ -555,7 +556,7 @@ construct_proc_layout(Params, PLI, ProcLayoutName, Kind,
!StringTable, !StaticCellInfo, !ProcLayoutInfo) :-
PLI = proc_layout_info(RttiProcLabel, EntryLabel,
Detism, StackSlots, SuccipLoc, EvalMethod, EffTraceLevel,
- MaybeCallLabel, MaxTraceReg, HeadVars, ArgModes,
+ MaybeCallLabel, MaxTraceRegR, MaxTraceRegF, HeadVars, ArgModes,
Goal, NeedGoalRep, InstMap,
TraceSlotInfo, _ForceProcIdLayout, VarSet, VarTypes,
InternalMap, MaybeTableInfo, NeedsAllNames, MaybeDeepProfInfo),
@@ -589,7 +590,7 @@ construct_proc_layout(Params, PLI, ProcLayoutName, Kind,
ExecTraceInfo0 = !.ProcLayoutInfo ^ pli_exec_traces,
construct_exec_trace_layout(Params, RttiProcLabel,
EvalMethod, EffTraceLevel, MaybeCallLabel, MaybeTableSlotName,
- MaxTraceReg, HeadVars, ArgModes, TraceSlotInfo,
+ MaxTraceRegR, MaxTraceRegF, HeadVars, ArgModes, TraceSlotInfo,
VarSet, VarTypes, MaybeTableInfo, NeedsAllNames,
VarNumMap, InternalLabelInfos, ExecTraceSlotName,
LabelLayoutInfo, !StringTable,
@@ -866,7 +867,7 @@ init_proc_statics_info = Info :-
:- pred construct_exec_trace_layout(stack_layout_params::in,
rtti_proc_label::in, eval_method::in, trace_level::in, maybe(label)::in,
- maybe(layout_slot_name)::in, int::in,
+ maybe(layout_slot_name)::in, int::in, int::in,
list(prog_var)::in, list(mer_mode)::in,
trace_slot_info::in, prog_varset::in, vartypes::in,
maybe(proc_layout_table_info)::in, bool::in, var_num_map::in,
@@ -876,7 +877,8 @@ init_proc_statics_info = Info :-
exec_traces_info::in, exec_traces_info::out) is det.
construct_exec_trace_layout(Params, RttiProcLabel, EvalMethod,
- EffTraceLevel, MaybeCallLabel, MaybeTableSlotName, MaxTraceReg,
+ EffTraceLevel, MaybeCallLabel, MaybeTableSlotName,
+ MaxTraceRegR, MaxTraceRegF,
HeadVars, ArgModes, TraceSlotInfo, _VarSet, VarTypes, MaybeTableInfo,
NeedsAllNames, VarNumMap, InternalLabelInfos, ExecTraceName,
LabelLayoutInfo, !StringTable, !ExecTraceInfo) :-
@@ -1005,8 +1007,8 @@ construct_exec_trace_layout(Params, RttiProcLabel, EvalMethod,
ExecTrace = proc_layout_exec_trace(MaybeCallLabelSlotName,
EventLayoutsSlotName, NumProcEventLayouts, MaybeTable,
MaybeHeadVarsSlotName, NumHeadVars, MaybeVarNamesSlotName,
- MaxVarNum, MaxTraceReg, MaybeFromFullSlot, MaybeIoSeqSlot,
- MaybeTrailSlots, MaybeMaxfrSlot, EvalMethod,
+ MaxVarNum, MaxTraceRegR, MaxTraceRegF, MaybeFromFullSlot,
+ MaybeIoSeqSlot, MaybeTrailSlots, MaybeMaxfrSlot, EvalMethod,
MaybeCallTableSlot, MaybeTailRecSlot, EffTraceLevel, Flags),
RevExecTraces0 = !.ExecTraceInfo ^ eti_rev_exec_traces,
@@ -1634,8 +1636,20 @@ select_trace_return(LocnInfo) :-
LocnInfo = layout_var_info(Locn, LvalType, _),
LvalType = live_value_var(_, Name, _, _),
Name \= "",
- ( Locn = locn_direct(Lval) ; Locn = locn_indirect(Lval, _)),
- ( Lval = stackvar(_) ; Lval = framevar(_) ).
+ (
+ Locn = locn_direct(Lval)
+ ;
+ Locn = locn_indirect(Lval, _)
+ ),
+ (
+ Lval = stackvar(_)
+ ;
+ Lval = framevar(_)
+ ;
+ Lval = double_stackvar(double_stackvar, _)
+ ;
+ Lval = double_stackvar(double_framevar, _)
+ ).
% Given a list of layout_var_infos, put the ones that tracing can be
% interested in (whether at an internal port or for uplevel printing)
@@ -2197,6 +2211,18 @@ represent_lval(parent_stackvar(Num), Word) :-
represent_lval(framevar(Num), Word) :-
expect(Num > 0, $module, $pred, "bad framevar"),
make_tagged_word(lval_framevar, Num, Word).
+represent_lval(double_stackvar(StackType, Num), Word) :-
+ expect(Num > 0, $module, $pred, "bad stackvar"),
+ (
+ StackType = double_stackvar,
+ make_tagged_word(lval_double_stackvar, Num, Word)
+ ;
+ StackType = double_parent_stackvar,
+ make_tagged_word(lval_double_parent_stackvar, Num, Word)
+ ;
+ StackType = double_framevar,
+ make_tagged_word(lval_double_framevar, Num, Word)
+ ).
represent_lval(succip, Word) :-
make_tagged_word(lval_succip, 0, Word).
represent_lval(maxfr, Word) :-
@@ -2260,13 +2286,18 @@ make_tagged_word(Locn, Value, TaggedValue) :-
; lval_sp
; lval_indirect
; lval_parent_sp
- ; lval_parent_stackvar.
+ ; lval_parent_stackvar
+ ; lval_double_stackvar
+ ; lval_double_parent_stackvar
+ ; lval_double_framevar.
:- pred locn_type_code(locn_type::in, int::out) is det.
% The code of this predicate should be kept in sync with the enum type
% MR_LongLvalType in runtime/mercury_stack_layout.h. Note that the values
-% equal to 0 modulo 4 are reserved for representing constants.
+% equal to 0 modulo 4 are reserved for representing constants (aligned
+% pointers to static data).
+
locn_type_code(lval_r_reg, 1).
locn_type_code(lval_f_reg, 2).
locn_type_code(lval_stackvar, 3).
@@ -2278,14 +2309,17 @@ locn_type_code(lval_curfr, 9).
locn_type_code(lval_hp, 10).
locn_type_code(lval_sp, 11).
locn_type_code(lval_parent_sp, 11). % XXX placeholder only
-locn_type_code(lval_indirect, 13).
+locn_type_code(lval_double_stackvar, 13).
+locn_type_code(lval_double_parent_stackvar, 13). % XXX placeholder only
+locn_type_code(lval_double_framevar, 14).
+locn_type_code(lval_indirect, 15).
% This number of tag bits must be able to encode all values of
% locn_type_code.
%
:- func long_lval_tag_bits = int.
-long_lval_tag_bits = 4.
+long_lval_tag_bits = 5.
% This number of tag bits must be able to encode the largest offset
% of a type_info within a typeclass_info.
diff --git a/compiler/store_alloc.m b/compiler/store_alloc.m
index cb95148..82e7921 100644
--- a/compiler/store_alloc.m
+++ b/compiler/store_alloc.m
@@ -49,12 +49,14 @@
:- import_module hlds.hlds_llds.
:- import_module hlds.instmap.
:- import_module libs.globals.
+:- import_module libs.options.
:- import_module libs.trace_params.
:- import_module ll_backend.code_util.
:- import_module ll_backend.follow_vars.
:- import_module ll_backend.liveness.
:- import_module ll_backend.llds.
:- import_module ll_backend.trace_gen.
+:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.set_of_var.
@@ -76,12 +78,14 @@ allocate_store_maps(RunType, ModuleInfo, proc(PredId, _), !ProcInfo) :-
RunType = final_allocation,
proc_info_get_goal(!.ProcInfo, Goal0),
- find_final_follow_vars(!.ProcInfo, FollowVarsMap0, NextNonReserved0),
- proc_info_get_vartypes(!.ProcInfo, VarTypes),
+ find_final_follow_vars(!.ProcInfo, FollowVarsMap0, NextNonReservedR0,
+ NextNonReservedF0),
find_follow_vars_in_goal(Goal0, Goal1, VarTypes, ModuleInfo,
- FollowVarsMap0, FollowVarsMap, NextNonReserved0, NextNonReserved),
+ FollowVarsMap0, FollowVarsMap, NextNonReservedR0, NextNonReservedR,
+ NextNonReservedF0, NextNonReservedF),
Goal1 = hlds_goal(GoalExpr1, GoalInfo1),
- FollowVars = abs_follow_vars(FollowVarsMap, NextNonReserved),
+ FollowVars = abs_follow_vars(FollowVarsMap, NextNonReservedR,
+ NextNonReservedF),
goal_info_set_follow_vars(yes(FollowVars), GoalInfo1, GoalInfo2),
Goal2 = hlds_goal(GoalExpr1, GoalInfo2)
;
@@ -102,7 +106,16 @@ allocate_store_maps(RunType, ModuleInfo, proc(PredId, _), !ProcInfo) :-
build_input_arg_list(!.ProcInfo, InputArgLvals),
LastLocns0 = initial_last_locns(InputArgLvals),
proc_info_get_stack_slots(!.ProcInfo, StackSlots),
- StoreAllocInfo = store_alloc_info(ModuleInfo, StackSlots),
+ proc_info_get_vartypes(!.ProcInfo, VarTypes),
+ globals.lookup_bool_option(Globals, use_float_registers, FloatRegs),
+ (
+ FloatRegs = yes,
+ FloatRegType = reg_f
+ ;
+ FloatRegs = no,
+ FloatRegType = reg_r
+ ),
+ StoreAllocInfo = store_alloc_info(StackSlots, VarTypes, FloatRegType),
store_alloc_in_goal(Goal2, Goal, Liveness0, _, LastLocns0, _,
ResumeVars, StoreAllocInfo),
proc_info_set_goal(Goal, !ProcInfo).
@@ -118,10 +131,10 @@ initial_last_locns([Var - Lval | VarLvals]) =
:- type store_alloc_info
---> store_alloc_info(
- sai_module_info :: module_info,
-
% Maps each var to its stack slot (if it has one).
- sai_stack_slots :: stack_slots
+ sai_stack_slots :: stack_slots,
+ sai_vartypes :: vartypes,
+ sai_float_reg :: reg_type
).
:- type where_stored == set(lval). % These lvals may contain var() rvals.
@@ -390,11 +403,11 @@ store_alloc_allocate_storage(LiveVars, StoreAllocInfo, FollowVars,
% This addresses points 3 and 4.
map.keys(!.StoreMap, StoreVars),
set.init(SeenLvals0),
- store_alloc_handle_conflicts_and_nonreal(StoreVars, 1, N,
- SeenLvals0, SeenLvals, !StoreMap),
+ store_alloc_handle_conflicts_and_nonreal(StoreAllocInfo, StoreVars,
+ 1, N, SeenLvals0, SeenLvals, !StoreMap),
% This addresses point 2.
- store_alloc_allocate_extras(LiveVars, N, SeenLvals, StoreAllocInfo,
+ store_alloc_allocate_extras(StoreAllocInfo, LiveVars, N, SeenLvals,
!StoreMap).
:- pred store_alloc_remove_nonlive(list(prog_var)::in, list(prog_var)::in,
@@ -409,35 +422,41 @@ store_alloc_remove_nonlive([Var | Vars], LiveVars, !StoreMap) :-
),
store_alloc_remove_nonlive(Vars, LiveVars, !StoreMap).
-:- pred store_alloc_handle_conflicts_and_nonreal(list(prog_var)::in,
- int::in, int::out, set(abs_locn)::in, set(abs_locn)::out,
+:- pred store_alloc_handle_conflicts_and_nonreal(store_alloc_info::in,
+ list(prog_var)::in, int::in, int::out,
+ set(abs_locn)::in, set(abs_locn)::out,
abs_store_map::in, abs_store_map::out) is det.
-store_alloc_handle_conflicts_and_nonreal([], !N, !SeenLocns, !StoreMap).
-store_alloc_handle_conflicts_and_nonreal([Var | Vars], !N, !SeenLocns,
- !StoreMap) :-
+store_alloc_handle_conflicts_and_nonreal(_, [],
+ !N, !SeenLocns, !StoreMap).
+store_alloc_handle_conflicts_and_nonreal(StoreAllocInfo, [Var | Vars],
+ !N, !SeenLocns, !StoreMap) :-
map.lookup(!.StoreMap, Var, Locn),
(
( Locn = any_reg
; set.member(Locn, !.SeenLocns)
)
->
- next_free_reg(!.SeenLocns, !N),
- FinalLocn = abs_reg(!.N),
+ ( Locn = abs_reg(RegTypePrime, _) ->
+ RegType = RegTypePrime
+ ;
+ reg_type_for_var(StoreAllocInfo, Var, RegType)
+ ),
+ next_free_reg(RegType, !.SeenLocns, !N),
+ FinalLocn = abs_reg(RegType, !.N),
map.det_update(Var, FinalLocn, !StoreMap)
;
FinalLocn = Locn
),
set.insert(FinalLocn, !SeenLocns),
- store_alloc_handle_conflicts_and_nonreal(Vars, !N, !SeenLocns,
- !StoreMap).
+ store_alloc_handle_conflicts_and_nonreal(StoreAllocInfo, Vars,
+ !N, !SeenLocns, !StoreMap).
-:- pred store_alloc_allocate_extras(list(prog_var)::in, int::in,
- set(abs_locn)::in, store_alloc_info::in,
- abs_store_map::in, abs_store_map::out) is det.
+:- pred store_alloc_allocate_extras(store_alloc_info::in, list(prog_var)::in,
+ int::in, set(abs_locn)::in, abs_store_map::in, abs_store_map::out) is det.
-store_alloc_allocate_extras([], _, _, _, !StoreMap).
-store_alloc_allocate_extras([Var | Vars], !.N, !.SeenLocns, StoreAllocInfo,
+store_alloc_allocate_extras(_, [], _, _, !StoreMap).
+store_alloc_allocate_extras(StoreAllocInfo, [Var | Vars], !.N, !.SeenLocns,
!StoreMap) :-
( map.contains(!.StoreMap, Var) ->
% We have already allocated a slot for this variable.
@@ -445,7 +464,7 @@ store_alloc_allocate_extras([Var | Vars], !.N, !.SeenLocns, StoreAllocInfo,
;
% We have not yet allocated a slot for this variable,
% which means it is not in the follow vars (if any).
- StoreAllocInfo = store_alloc_info(_, StackSlots),
+ StoreAllocInfo = store_alloc_info(StackSlots, _, _),
(
map.search(StackSlots, Var, StackSlot),
StackSlotLocn = stack_slot_to_abs_locn(StackSlot),
@@ -456,23 +475,43 @@ store_alloc_allocate_extras([Var | Vars], !.N, !.SeenLocns, StoreAllocInfo,
->
Locn = StackSlotLocn
;
- next_free_reg(!.SeenLocns, !N),
- Locn = abs_reg(!.N)
+ reg_type_for_var(StoreAllocInfo, Var, RegType),
+ next_free_reg(RegType, !.SeenLocns, !N),
+ Locn = abs_reg(RegType, !.N)
),
map.det_insert(Var, Locn, !StoreMap),
set.insert(Locn, !SeenLocns)
),
- store_alloc_allocate_extras(Vars, !.N, !.SeenLocns, StoreAllocInfo,
+ store_alloc_allocate_extras(StoreAllocInfo, Vars, !.N, !.SeenLocns,
!StoreMap).
+:- pred reg_type_for_var(store_alloc_info::in, prog_var::in, reg_type::out)
+ is det.
+
+reg_type_for_var(StoreAllocInfo, Var, RegType) :-
+ StoreAllocInfo = store_alloc_info(_, VarTypes, FloatRegType),
+ (
+ FloatRegType = reg_r,
+ RegType = reg_r
+ ;
+ FloatRegType = reg_f,
+ map.lookup(VarTypes, Var, VarType),
+ ( VarType = float_type ->
+ RegType = reg_f
+ ;
+ RegType = reg_r
+ )
+ ).
+
%-----------------------------------------------------------------------------%
-:- pred next_free_reg(set(abs_locn)::in, int::in, int::out) is det.
+:- pred next_free_reg(reg_type::in, set(abs_locn)::in, int::in, int::out)
+ is det.
-next_free_reg(Values, N0, N) :-
- ( set.member(abs_reg(N0), Values) ->
+next_free_reg(RegType, Values, N0, N) :-
+ ( set.member(abs_reg(RegType, N0), Values) ->
N1 = N0 + 1,
- next_free_reg(Values, N1, N)
+ next_free_reg(RegType, Values, N1, N)
;
N = N0
).
diff --git a/compiler/string_switch.m b/compiler/string_switch.m
index 869bf2c..c70e570 100644
--- a/compiler/string_switch.m
+++ b/compiler/string_switch.m
@@ -298,7 +298,7 @@ generate_string_hash_simple_lookup_switch(VarRval, CaseValues,
% Since we release BaseReg only after the call to
% generate_branch_end, we must make sure that generate_branch_end
% won't want to overwrite BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
MaybeBaseReg = yes(BaseReg),
% Generate code to look up each of the variables in OutVars
@@ -455,7 +455,7 @@ generate_string_hash_several_soln_lookup_switch(VarRval, CaseSolns,
% Since we release BaseReg only after the calls to generate_branch_end,
% we must make sure that generate_branch_end won't want to overwrite
% BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
% Generate code to look up each of the variables in OutVars
% in its slot in the table row RowStartReg. Most of the change is done
@@ -825,7 +825,7 @@ generate_string_binary_simple_lookup_switch(VarRval, CaseValues,
% Since we release BaseReg only after the call to
% generate_branch_end, we must make sure that generate_branch_end
% won't want to overwrite BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
MaybeBaseReg = yes(BaseReg),
% Generate code to look up each of the variables in OutVars
@@ -955,7 +955,7 @@ generate_string_binary_several_soln_lookup_switch(VarRval, CaseSolns,
% Since we release BaseReg only after the calls to generate_branch_end,
% we must make sure that generate_branch_end won't want to overwrite
% BaseReg.
- acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ acquire_reg_not_in_storemap(StoreMap, reg_r, BaseReg, !CI),
MidReg = BinarySwitchInfo ^ sbsi_mid_reg,
SetBaseRegCode = singleton(
llds_instr(
diff --git a/compiler/tag_switch.m b/compiler/tag_switch.m
index 2f1947b..34a5d3e 100644
--- a/compiler/tag_switch.m
+++ b/compiler/tag_switch.m
@@ -42,6 +42,7 @@
:- import_module backend_libs.rtti.
:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_llds.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module ll_backend.switch_case.
diff --git a/compiler/trace_gen.m b/compiler/trace_gen.m
index 3503e0e..57a1d4f 100644
--- a/compiler/trace_gen.m
+++ b/compiler/trace_gen.m
@@ -1055,12 +1055,17 @@ generate_event_code(Port, PortInfo, MaybeTraceInfo, Context, HideEvent,
get_instmap(!.CI, InstMap),
trace_produce_vars(LiveVars, VarSet, VarTypes, InstMap, Port,
set.init, TvarSet, [], VarInfoList, ProduceCode, !CI),
- max_reg_in_use(!.CI, MaxReg),
- get_max_reg_in_use_at_trace(!.CI, MaxTraceReg0),
- ( MaxTraceReg0 < MaxReg ->
- set_max_reg_in_use_at_trace(MaxReg, !CI)
- ;
+ max_reg_in_use(!.CI, MaxRegR, MaxRegF),
+ get_max_reg_in_use_at_trace(!.CI, MaxTraceRegR0, MaxTraceRegF0),
+ int.max(MaxRegR, MaxTraceRegR0, MaxTraceRegR),
+ int.max(MaxRegF, MaxTraceRegF0, MaxTraceRegF),
+ (
+ MaxTraceRegR0 = MaxTraceRegR,
+ MaxTraceRegF0 = MaxTraceRegF
+ ->
true
+ ;
+ set_max_reg_in_use_at_trace(MaxTraceRegR, MaxTraceRegF, !CI)
),
variable_locations(!.CI, VarLocs),
get_proc_info(!.CI, ProcInfo),
@@ -1271,6 +1276,9 @@ stackref_to_string(Lval, LvalStr) :-
; Lval = framevar(Slot) ->
string.int_to_string(Slot, SlotString),
LvalStr = "MR_fv(" ++ SlotString ++ ")"
+ ; Lval = double_stackvar(_, _) ->
+ % XXX how do we get here?
+ sorry($module, $pred, "double-width stack slot")
;
unexpected($module, $pred, "non-stack lval")
).
diff --git a/compiler/tupling.m b/compiler/tupling.m
index d8031d0..9e24fe0 100644
--- a/compiler/tupling.m
+++ b/compiler/tupling.m
@@ -876,8 +876,9 @@ prepare_proc_for_counting(PredProcId, !ReverseGoalPathMapMap, !ModuleInfo) :-
some [!ProcInfo] (
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo, !:ProcInfo),
+ pred_info_get_import_status(PredInfo, Status),
pred_info_get_arg_types(PredInfo, ArgTypes),
- generate_proc_arg_info(ArgTypes, !.ModuleInfo, !ProcInfo),
+ generate_proc_arg_info(Status, ArgTypes, !.ModuleInfo, !ProcInfo),
detect_liveness_proc(!.ModuleInfo, PredProcId, !ProcInfo),
initial_liveness(!.ProcInfo, PredId, !.ModuleInfo, Liveness0),
diff --git a/compiler/use_local_vars.m b/compiler/use_local_vars.m
index 7e428f6..608c17c 100644
--- a/compiler/use_local_vars.m
+++ b/compiler/use_local_vars.m
@@ -82,6 +82,7 @@
:- implementation.
+:- import_module hlds.hlds_llds.
:- import_module ll_backend.basic_block.
:- import_module ll_backend.code_util.
:- import_module ll_backend.exprn_aux.
@@ -212,7 +213,7 @@ opt_assign([Instr0 | TailInstrs0], Instrs, !TempCounter, NumRealRRegs,
not set.member(ToLval, CompulsoryLvals)
->
counter.allocate(TempNum, !TempCounter),
- NewLval = temp(reg_r, TempNum),
+ NewLval = temp(reg_type_for_lval(ToLval), TempNum),
substitute_lval_in_defn(ToLval, NewLval, Instr0, Instr),
list.map_foldl(
exprn_aux.substitute_lval_in_instr(ToLval, NewLval),
@@ -231,7 +232,7 @@ opt_assign([Instr0 | TailInstrs0], Instrs, !TempCounter, NumRealRRegs,
)
;
counter.allocate(TempNum, !TempCounter),
- NewLval = temp(reg_r, TempNum),
+ NewLval = temp(reg_type_for_lval(ToLval), TempNum),
substitute_lval_in_instr_until_defn(ToLval, NewLval,
TailInstrs0, TailInstrs1, 0, NumSubst),
NumSubst > 1
@@ -413,7 +414,7 @@ opt_access([Instr0 | TailInstrs0], Instrs, !TempCounter, NumRealRRegs,
->
OrigTempCounter = !.TempCounter,
counter.allocate(TempNum, !TempCounter),
- TempLval = temp(reg_r, TempNum),
+ TempLval = temp(reg_type_for_lval(ChosenLval), TempNum),
SubChosenLvals = lvals_in_lval(ChosenLval),
expect(unify(SubChosenLvals, []), $module, $pred,
"nonempty SubChosenLvals"),
@@ -455,9 +456,13 @@ base_lval_worth_replacing(NumRealRRegs, Lval) :-
Lval = reg(reg_r, RegNum),
RegNum > NumRealRRegs
;
+ Lval = reg(reg_f, _)
+ ;
Lval = stackvar(_)
;
Lval = framevar(_)
+ ;
+ Lval = double_stackvar(_, _)
).
:- pred base_lval_worth_replacing_not_tried(lvalset::in, int::in, lval::in)
@@ -467,6 +472,39 @@ base_lval_worth_replacing_not_tried(AlreadyTried, NumRealRRegs, Lval) :-
\+ set.member(Lval, AlreadyTried),
base_lval_worth_replacing(NumRealRRegs, Lval).
+:- func reg_type_for_lval(lval) = reg_type.
+
+reg_type_for_lval(Lval) = RegType :-
+ (
+ Lval = reg(RegType, _)
+ ;
+ Lval = temp(RegType, _)
+ ;
+ Lval = double_stackvar(_, _),
+ RegType = reg_f
+ ;
+ ( Lval = succip
+ ; Lval = maxfr
+ ; Lval = curfr
+ ; Lval = hp
+ ; Lval = sp
+ ; Lval = parent_sp
+ ; Lval = stackvar(_)
+ ; Lval = parent_stackvar(_)
+ ; Lval = framevar(_)
+ ; Lval = succip_slot(_)
+ ; Lval = succfr_slot(_)
+ ; Lval = redoip_slot(_)
+ ; Lval = redofr_slot(_)
+ ; Lval = prevfr_slot(_)
+ ; Lval = field(_, _, _)
+ ; Lval = mem_ref(_)
+ ; Lval = global_var_ref(_)
+ ; Lval = lvar(_)
+ ),
+ RegType = reg_r
+ ).
+
%-----------------------------------------------------------------------------%
% When processing substituting e.g. tempr1 for e.g. r2 in the instruction
diff --git a/compiler/var_locn.m b/compiler/var_locn.m
index ef60c49..090ad77 100644
--- a/compiler/var_locn.m
+++ b/compiler/var_locn.m
@@ -40,8 +40,8 @@
:- type var_locn_info.
- % init_var_locn_state(Arguments, Liveness, VarSet, VarTypes, StackSlots,
- % FollowVars, VarLocnInfo):
+ % init_var_locn_state(Arguments, Liveness, VarSet, VarTypes, FloatRegType,
+ % StackSlots, FollowVars, VarLocnInfo):
%
% Produces an initial state of the VarLocnInfo given
% an association list of variables and lvalues. The initial
@@ -51,14 +51,15 @@
% used in the body). The VarSet parameter contains a mapping from
% variables to names, which is used when code is generated
% to provide meaningful comments. VarTypes gives the types of
- % of all the procedure's variables. StackSlots maps each variable
+ % of all the procedure's variables. FloatRegType gives the preferred
+ % register type for floats. StackSlots maps each variable
% to its stack slot, if it has one. FollowVars is the initial
% follow_vars set; such sets give guidance as to what lvals
% (if any) each variable will be needed in next.
%
:- pred init_var_locn_state(assoc_list(prog_var, lval)::in, set_of_progvar::in,
- prog_varset::in, vartypes::in, stack_slots::in, abs_follow_vars::in,
- var_locn_info::out) is det.
+ prog_varset::in, vartypes::in, reg_type::in, stack_slots::in,
+ abs_follow_vars::in, var_locn_info::out) is det.
% reinit_var_locn_state(VarLocs, !VarLocnInfo):
%
@@ -261,7 +262,7 @@
%
% Finds an unused register and marks it as 'in use'.
%
-:- pred var_locn_acquire_reg(lval::out,
+:- pred var_locn_acquire_reg(reg_type::in, lval::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_acquire_reg_require_given(Reg, Lval, !VarLocInfo):
@@ -271,12 +272,12 @@
:- pred var_locn_acquire_reg_require_given(lval::in,
var_locn_info::in, var_locn_info::out) is det.
- % var_locn_acquire_reg_prefer_given(Pref, Lval, !VarLocInfo):
+ % var_locn_acquire_reg_prefer_given(Type, Pref, Lval, !VarLocInfo):
%
% Finds an unused register, and marks it as 'in use'.
% If Pref itself is free, assigns that.
%
-:- pred var_locn_acquire_reg_prefer_given(int::in, lval::out,
+:- pred var_locn_acquire_reg_prefer_given(reg_type::in, int::in, lval::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_acquire_reg_start_at_given(Start, Lval, !VarLocInfo):
@@ -285,7 +286,7 @@
% It starts the search at the one numbered Start,
% continuing towards higher register numbers.
%
-:- pred var_locn_acquire_reg_start_at_given(int::in, lval::out,
+:- pred var_locn_acquire_reg_start_at_given(reg_type::in, int::in, lval::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_release_reg(Lval, !VarLocnInfo):
@@ -295,14 +296,15 @@
:- pred var_locn_release_reg(lval::in, var_locn_info::in, var_locn_info::out)
is det.
- % var_locn_lock_regs(N, Exceptions, !VarLocnInfo):
+ % var_locn_lock_regs(R, F, Exceptions, !VarLocnInfo):
%
- % Prevents registers r1 through rN from being reused, even if there are
- % no variables referring to them, with the exceptions of the registers
- % named in Exceptions, which however can only be used to store their
- % corresponding variables. Should be followed by a call to unlock_regs.
+ % Prevents registers r1 through rR and registers f1 through fF from being
+ % reused, even if there are no variables referring to them, with the
+ % exceptions of the registers named in Exceptions, which however can only
+ % be used to store their corresponding variables. Should be followed by a
+ % call to unlock_regs.
%
-:- pred var_locn_lock_regs(int::in, assoc_list(prog_var, lval)::in,
+:- pred var_locn_lock_regs(int::in, int::in, assoc_list(prog_var, lval)::in,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_unlock_regs(!VarLocnInfo):
@@ -361,7 +363,8 @@
% Returns the number of the first register which is free for general use.
% It does not reserve the register.
%
-:- pred var_locn_get_next_non_reserved(var_locn_info::in, int::out) is det.
+:- pred var_locn_get_next_non_reserved(var_locn_info::in, reg_type::in,
+ int::out) is det.
% var_locn_set_follow_vars(FollowVars):
%
@@ -371,11 +374,12 @@
:- pred var_locn_set_follow_vars(abs_follow_vars::in,
var_locn_info::in, var_locn_info::out) is det.
- % var_locn_max_reg_in_use(MaxReg):
+ % var_locn_max_reg_in_use(MaxRegR, MaxRegF):
%
- % Returns the number of the highest numbered rN register in use.
+ % Returns the number of the highest numbered rN and fN registers in use.
%
-:- pred var_locn_max_reg_in_use(var_locn_info::in, int::out) is det.
+:- pred var_locn_max_reg_in_use(var_locn_info::in, int::out, int::out)
+ is det.
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
@@ -384,8 +388,11 @@
:- import_module backend_libs.builtin_ops.
:- import_module check_hlds.type_util.
+:- import_module libs.globals.
+:- import_module libs.options.
:- import_module ll_backend.code_util.
:- import_module ll_backend.exprn_aux.
+:- import_module parse_tree.builtin_lib_types.
:- import_module cord.
:- import_module int.
@@ -472,14 +479,18 @@
vli_varset :: prog_varset,
vli_vartypes :: vartypes,
+ % The register type to use for float vars.
+ vli_float_reg_type :: reg_type,
+
% Maps each var to its stack slot, if it has one.
vli_stack_slots :: stack_slots,
% Where vars are needed next.
vli_follow_vars_map :: abs_follow_vars_map,
- % Next register that isn't reserved in follow_vars_map.
- vli_next_non_res :: int,
+ % Next rN, fN register that isn't reserved in follow_vars_map.
+ vli_next_non_res_r :: int,
+ vli_next_non_res_f :: int,
% Documented above.
vli_var_state_map :: var_state_map,
@@ -489,13 +500,15 @@
% holding the tags of variables during switches.
vli_acquired :: set(lval),
- % If this slot contains N, then registers r1 through rN
- % can only be modified by a place_var operation, or by a
- % free_up_lval operation that moves a variable to the
- % (free or freeable) lval associated with it in the exceptions
- % field. Used to implement calls, foreign_procs and the
- % store_maps at the ends of branched control structures.
- vli_locked :: int,
+ % If these slots contain R and F then registers r1 through rR
+ % and f1 through fF can only be modified by a place_var
+ % operation, or by a free_up_lval operation that moves a
+ % variable to the (free or freeable) lval associated with it in
+ % the exceptions field. Used to implement calls, foreign_procs
+ % and the store_maps at the ends of branched control
+ % structures.
+ vli_locked_r :: int,
+ vli_locked_f :: int,
% See the documentation of the locked field above.
vli_exceptions :: assoc_list(prog_var, lval)
@@ -503,17 +516,18 @@
%----------------------------------------------------------------------------%
-init_var_locn_state(VarLocs, Liveness, VarSet, VarTypes, StackSlots,
- FollowVars, VarLocnInfo) :-
+init_var_locn_state(VarLocs, Liveness, VarSet, VarTypes, FloatRegType,
+ StackSlots, FollowVars, VarLocnInfo) :-
map.init(VarStateMap0),
map.init(LocVarMap0),
init_var_locn_state_2(VarLocs, yes(Liveness), VarStateMap0, VarStateMap,
LocVarMap0, LocVarMap),
- FollowVars = abs_follow_vars(FollowVarMap, NextNonReserved),
+ FollowVars = abs_follow_vars(FollowVarMap, NextNonReservedR,
+ NextNonReservedF),
set.init(AcquiredRegs),
- VarLocnInfo = var_locn_info(VarSet, VarTypes, StackSlots,
- FollowVarMap, NextNonReserved, VarStateMap, LocVarMap,
- AcquiredRegs, 0, []).
+ VarLocnInfo = var_locn_info(VarSet, VarTypes, FloatRegType, StackSlots,
+ FollowVarMap, NextNonReservedR, NextNonReservedF, VarStateMap,
+ LocVarMap, AcquiredRegs, 0, 0, []).
reinit_var_locn_state(VarLocs, !VarLocnInfo) :-
map.init(VarStateMap0),
@@ -521,11 +535,11 @@ reinit_var_locn_state(VarLocs, !VarLocnInfo) :-
init_var_locn_state_2(VarLocs, no, VarStateMap0, VarStateMap,
LocVarMap0, LocVarMap),
set.init(AcquiredRegs),
- !.VarLocnInfo = var_locn_info(VarSet, VarTypes, StackSlots,
- FollowVarMap, NextNonReserved, _, _, _, _, _),
- !:VarLocnInfo = var_locn_info(VarSet, VarTypes, StackSlots,
- FollowVarMap, NextNonReserved, VarStateMap, LocVarMap,
- AcquiredRegs, 0, []).
+ !.VarLocnInfo = var_locn_info(VarSet, VarTypes, FloatRegType, StackSlots,
+ FollowVarMap, NextNonReservedR, NextNonReservedF, _, _, _, _, _, _),
+ !:VarLocnInfo = var_locn_info(VarSet, VarTypes, FloatRegType, StackSlots,
+ FollowVarMap, NextNonReservedR, NextNonReservedF, VarStateMap,
+ LocVarMap, AcquiredRegs, 0, 0, []).
:- pred init_var_locn_state_2(assoc_list(prog_var, lval)::in,
maybe(set_of_progvar)::in, var_state_map::in, var_state_map::out,
@@ -577,7 +591,7 @@ convert_live_to_lval_set(Var - State, Var - Lvals) :-
var_locn_clobber_all_regs(OkToDeleteAny, !VLI) :-
var_locn_set_acquired(set.init, !VLI),
- var_locn_set_locked(0, !VLI),
+ var_locn_set_locked(0, 0, !VLI),
var_locn_set_exceptions([], !VLI),
var_locn_get_loc_var_map(!.VLI, LocVarMap0),
var_locn_get_var_state_map(!.VLI, VarStateMap0),
@@ -878,7 +892,7 @@ var_locn_assign_dynamic_cell_to_var(ModuleInfo, Var, ReserveWordAtStart, Ptag,
Code, !VLI) :-
check_var_is_unknown(!.VLI, Var),
- select_preferred_reg_or_stack(!.VLI, Var, Lval),
+ select_preferred_reg_or_stack(!.VLI, Var, reg_r, Lval),
get_var_name(!.VLI, Var, VarName),
Size = size_of_cell_args(Vector),
(
@@ -998,7 +1012,7 @@ assign_reused_cell_to_var(ModuleInfo, Lval, Ptag, Vector, CellToReuse,
% temporary register to record whether we actually are reusing a structure
% or if a new object was allocated.
( list.member(does_not_need_update, NeedsUpdates0) ->
- var_locn_acquire_reg(FlagReg, !VLI),
+ var_locn_acquire_reg(reg_r, FlagReg, !VLI),
MaybeFlag = yes(FlagReg),
TempRegs = [FlagReg | TempRegs0]
;
@@ -1235,7 +1249,8 @@ var_locn_save_cell_fields_2(ModuleInfo, ReuseLval, DepVar, SaveDepVarCode,
rval_depends_on_search_lval(DepVarRval,
specific_reg_or_stack(ReuseLval))
->
- var_locn_acquire_reg(Target, !VLI),
+ reg_type_for_type(!.VLI, DepVarType, RegType),
+ var_locn_acquire_reg(RegType, Target, !VLI),
add_additional_lval_for_var(DepVar, Target, !VLI),
get_var_name(!.VLI, DepVar, DepVarName),
AssignCode = singleton(
@@ -1249,6 +1264,16 @@ var_locn_save_cell_fields_2(ModuleInfo, ReuseLval, DepVar, SaveDepVarCode,
),
SaveDepVarCode = EvalCode ++ AssignCode.
+:- pred reg_type_for_type(var_locn_info::in, mer_type::in, reg_type::out)
+ is det.
+
+reg_type_for_type(VLI, Type, RegType) :-
+ ( Type = float_type ->
+ var_locn_get_float_reg_type(VLI, RegType)
+ ;
+ RegType = reg_r
+ ).
+
%----------------------------------------------------------------------------%
% Record that Var is now available in Lval, as well as in the locations
@@ -1371,7 +1396,8 @@ var_locn_produce_var(ModuleInfo, Var, Rval, Code, !VLI) :-
Rval = Rval2,
Code = empty
;
- select_preferred_reg(!.VLI, Var, Lval),
+ reg_type_for_var(!.VLI, Var, RegType),
+ select_preferred_reg(!.VLI, Var, RegType, Lval),
var_locn_place_var(ModuleInfo, Var, Lval, Code, !VLI),
Rval = lval(Lval)
).
@@ -1385,7 +1411,8 @@ var_locn_produce_var_in_reg(ModuleInfo, Var, Lval, Code, !VLI) :-
Lval = SelectLval,
Code = empty
;
- select_preferred_reg(!.VLI, Var, Lval),
+ reg_type_for_var(!.VLI, Var, RegType),
+ select_preferred_reg(!.VLI, Var, RegType, Lval),
var_locn_place_var(ModuleInfo, Var, Lval, Code, !VLI)
).
@@ -1398,10 +1425,30 @@ var_locn_produce_var_in_reg_or_stack(ModuleInfo, Var, Lval, Code, !VLI) :-
Lval = SelectLval,
Code = empty
;
- select_preferred_reg_or_stack(!.VLI, Var, Lval),
+ reg_type_for_var(!.VLI, Var, RegType),
+ select_preferred_reg_or_stack(!.VLI, Var, RegType, Lval),
var_locn_place_var(ModuleInfo, Var, Lval, Code, !VLI)
).
+:- pred reg_type_for_var(var_locn_info::in, prog_var::in, reg_type::out)
+ is det.
+
+reg_type_for_var(VLI, Var, RegType) :-
+ var_locn_get_float_reg_type(VLI, FloatRegType),
+ (
+ FloatRegType = reg_r,
+ RegType = reg_r
+ ;
+ FloatRegType = reg_f,
+ var_locn_get_vartypes(VLI, VarTypes),
+ map.lookup(VarTypes, Var, VarType),
+ ( VarType = float_type ->
+ RegType = reg_f
+ ;
+ RegType = reg_r
+ )
+ ).
+
%----------------------------------------------------------------------------%
var_locn_clear_r1(ModuleInfo, Code, !VLI) :-
@@ -1425,8 +1472,8 @@ var_locn_place_vars(ModuleInfo, VarLocns, Code, !VLI) :-
% moved by a freeing up operation is in VarLocns, then it is OK to move it
% to the location assigned to it by VarLocns.
assoc_list.values(VarLocns, Lvals),
- code_util.max_mentioned_reg(Lvals, MaxReg),
- var_locn_lock_regs(MaxReg, VarLocns, !VLI),
+ code_util.max_mentioned_regs(Lvals, MaxRegR, MaxRegF),
+ var_locn_lock_regs(MaxRegR, MaxRegF, VarLocns, !VLI),
actually_place_vars(ModuleInfo, VarLocns, Code, !VLI),
var_locn_unlock_regs(!VLI).
@@ -1610,7 +1657,8 @@ free_up_lval_with_copy(ModuleInfo, Lval, ToBeAssignedVars, ForbiddenLvals,
EffAffectedVars = [MovedVar]
),
- select_preferred_reg_or_stack(!.VLI, MovedVar, Pref),
+ reg_type_for_var(!.VLI, MovedVar, RegType),
+ select_preferred_reg_or_stack(!.VLI, MovedVar, RegType, Pref),
\+ Pref = Lval,
\+ list.member(Pref, ForbiddenLvals),
( \+ var_locn_lval_in_use(!.VLI, Pref) ->
@@ -1619,14 +1667,15 @@ free_up_lval_with_copy(ModuleInfo, Lval, ToBeAssignedVars, ForbiddenLvals,
% The code generator assumes that values in stack slots don't get
% clobbered without an explicit assignment (via a place_var
% operation with a stack var as a target).
- Pref = reg(reg_r, RegNum),
- reg_is_not_locked_for_var(!.VLI, RegNum, MovedVar)
+ Pref = reg(PrefRegType, RegNum),
+ reg_is_not_locked_for_var(!.VLI, PrefRegType, RegNum, MovedVar)
)
->
actually_place_var(ModuleInfo, MovedVar, Pref, [Lval | ForbiddenLvals],
Code, !VLI)
;
- get_spare_reg(!.VLI, Target),
+ RegType = lval_spare_reg_type(Lval),
+ get_spare_reg(!.VLI, RegType, Target),
record_copy(Lval, Target, !VLI),
(
( Lval = stackvar(N)
@@ -1696,6 +1745,17 @@ ensure_copies_are_present_lval([OtherSource | OtherSources], OneSource, Lval,
set.insert(SubstLval, !LvalSet),
ensure_copies_are_present_lval(OtherSources, OneSource, Lval, !LvalSet).
+:- func lval_spare_reg_type(lval) = reg_type.
+
+lval_spare_reg_type(Lval) = RegType :-
+ ( Lval = reg(reg_f, _) ->
+ RegType = reg_f
+ ; Lval = double_stackvar(_, _) ->
+ RegType = reg_f
+ ;
+ RegType = reg_r
+ ).
+
%----------------------------------------------------------------------------%
% Record the effect of the assignment New := Old on the state of all the
@@ -1924,7 +1984,12 @@ select_reg_lval([Lval0 | Lvals0], Lval) :-
:- pred select_stack_lval(list(lval)::in, lval::out) is semidet.
select_stack_lval([Lval0 | Lvals0], Lval) :-
- ( ( Lval0 = stackvar(_) ; Lval0 = framevar(_)) ->
+ (
+ ( Lval0 = stackvar(_)
+ ; Lval0 = framevar(_)
+ ; Lval0 = double_stackvar(_, _)
+ )
+ ->
Lval = Lval0
;
select_stack_lval(Lvals0, Lval)
@@ -1938,6 +2003,7 @@ select_reg_or_stack_lval([Lval0 | Lvals0], Lval) :-
( Lval0 = reg(_, _)
; Lval0 = stackvar(_)
; Lval0 = framevar(_)
+ ; Lval0 = double_stackvar(_, _)
)
->
Lval = Lval0
@@ -1955,39 +2021,39 @@ select_cheapest_lval([Lval | _], Lval).
%----------------------------------------------------------------------------%
-:- pred select_preferred_reg(var_locn_info::in, prog_var::in, lval::out)
- is det.
+:- pred select_preferred_reg(var_locn_info::in, prog_var::in, reg_type::in,
+ lval::out) is det.
-select_preferred_reg(VLI, Var, Lval) :-
- select_preferred_reg_avoid(VLI, Var, [], Lval).
+select_preferred_reg(VLI, Var, RegType, Lval) :-
+ select_preferred_reg_avoid(VLI, Var, RegType, [], Lval).
% Select the register into which Var should be put. If the follow_vars map
% maps Var to a register, then select that register, unless it is already
% in use.
%
:- pred select_preferred_reg_avoid(var_locn_info::in, prog_var::in,
- list(lval)::in, lval::out) is det.
+ reg_type::in, list(lval)::in, lval::out) is det.
-select_preferred_reg_avoid(VLI, Var, Avoid, Lval) :-
+select_preferred_reg_avoid(VLI, Var, RegType, Avoid, Lval) :-
var_locn_get_follow_var_map(VLI, FollowVarMap),
(
map.search(FollowVarMap, Var, PrefLocn),
- ( PrefLocn = abs_reg(_)
+ ( PrefLocn = abs_reg(_, _)
; PrefLocn = any_reg
)
->
(
- PrefLocn = abs_reg(N),
- PrefLval = reg(reg_r, N),
+ PrefLocn = abs_reg(PrefRegType, N),
+ PrefLval = reg(PrefRegType, N),
\+ var_locn_lval_in_use(VLI, PrefLval),
\+ list.member(PrefLval, Avoid)
->
Lval = PrefLval
;
- get_spare_reg_avoid(VLI, Avoid, Lval)
+ get_spare_reg_avoid(VLI, RegType, Avoid, Lval)
)
;
- get_spare_reg_avoid(VLI, Avoid, Lval)
+ get_spare_reg_avoid(VLI, RegType, Avoid, Lval)
).
% Select the register or stack slot into which Var should be put. If the
@@ -2000,24 +2066,24 @@ select_preferred_reg_avoid(VLI, Var, Avoid, Lval) :-
% this predicate to try to put far too many things in stack slots.)
%
:- pred select_preferred_reg_or_stack(var_locn_info::in, prog_var::in,
- lval::out) is det.
+ reg_type::in, lval::out) is det.
-select_preferred_reg_or_stack(VLI, Var, Lval) :-
+select_preferred_reg_or_stack(VLI, Var, RegType, Lval) :-
var_locn_get_follow_var_map(VLI, FollowVarMap),
(
map.search(FollowVarMap, Var, PrefLocn),
- ( PrefLocn = abs_reg(_)
+ ( PrefLocn = abs_reg(_, _)
; PrefLocn = any_reg
)
->
(
- PrefLocn = abs_reg(N),
- PrefLval = reg(reg_r, N),
+ PrefLocn = abs_reg(RegType, N),
+ PrefLval = reg(RegType, N),
\+ var_locn_lval_in_use(VLI, PrefLval)
->
Lval = PrefLval
;
- get_spare_reg(VLI, Lval)
+ get_spare_reg(VLI, RegType, Lval)
)
;
(
@@ -2028,7 +2094,7 @@ select_preferred_reg_or_stack(VLI, Var, Lval) :-
->
Lval = StackSlot
;
- get_spare_reg(VLI, Lval)
+ get_spare_reg(VLI, RegType, Lval)
)
).
@@ -2045,28 +2111,28 @@ real_lval(Lval) :-
% Get a register that is not in use. We start the search at the next
% register that is needed for the next call.
%
-:- pred get_spare_reg_avoid(var_locn_info::in, list(lval)::in,
+:- pred get_spare_reg_avoid(var_locn_info::in, reg_type::in, list(lval)::in,
lval::out) is det.
-get_spare_reg_avoid(VLI, Avoid, Lval) :-
- var_locn_get_next_non_reserved(VLI, NextNonReserved),
- get_spare_reg_2(VLI, Avoid, NextNonReserved, Lval).
+get_spare_reg_avoid(VLI, RegType, Avoid, Lval) :-
+ var_locn_get_next_non_reserved(VLI, RegType, NextNonReserved),
+ get_spare_reg_2(VLI, RegType, Avoid, NextNonReserved, Lval).
-:- pred get_spare_reg(var_locn_info::in, lval::out) is det.
+:- pred get_spare_reg(var_locn_info::in, reg_type::in, lval::out) is det.
-get_spare_reg(VLI, Lval) :-
- var_locn_get_next_non_reserved(VLI, NextNonReserved),
- get_spare_reg_2(VLI, [], NextNonReserved, Lval).
+get_spare_reg(VLI, RegType, Lval) :-
+ var_locn_get_next_non_reserved(VLI, RegType, NextNonReserved),
+ get_spare_reg_2(VLI, RegType, [], NextNonReserved, Lval).
-:- pred get_spare_reg_2(var_locn_info::in, list(lval)::in, int::in,
- lval::out) is det.
+:- pred get_spare_reg_2(var_locn_info::in, reg_type::in, list(lval)::in,
+ int::in, lval::out) is det.
-get_spare_reg_2(VLI, Avoid, N0, Lval) :-
- TryLval = reg(reg_r, N0),
+get_spare_reg_2(VLI, RegType, Avoid, N0, Lval) :-
+ TryLval = reg(RegType, N0),
( var_locn_lval_in_use(VLI, TryLval) ->
- get_spare_reg_2(VLI, Avoid, N0 + 1, Lval)
+ get_spare_reg_2(VLI, RegType, Avoid, N0 + 1, Lval)
; list.member(TryLval, Avoid) ->
- get_spare_reg_2(VLI, Avoid, N0 + 1, Lval)
+ get_spare_reg_2(VLI, RegType, Avoid, N0 + 1, Lval)
;
Lval = TryLval
).
@@ -2074,7 +2140,7 @@ get_spare_reg_2(VLI, Avoid, N0, Lval) :-
var_locn_lval_in_use(VLI, Lval) :-
var_locn_get_loc_var_map(VLI, LocVarMap),
var_locn_get_acquired(VLI, Acquired),
- var_locn_get_locked(VLI, Locked),
+ var_locn_get_locked(VLI, LockedR, LockedF),
(
map.search(LocVarMap, Lval, UsingVars),
set_of_var.is_non_empty(UsingVars)
@@ -2082,28 +2148,37 @@ var_locn_lval_in_use(VLI, Lval) :-
set.member(Lval, Acquired)
;
Lval = reg(reg_r, N),
- N =< Locked
+ N =< LockedR
+ ;
+ Lval = reg(reg_f, N),
+ N =< LockedF
).
% Succeeds if Var may be stored in Reg, possibly after copying its contents
% somewhere else. This requires Reg to be either not locked, or if it is
% locked, to be locked for Var.
%
-:- pred reg_is_not_locked_for_var(var_locn_info::in, int::in, prog_var::in)
- is semidet.
+:- pred reg_is_not_locked_for_var(var_locn_info::in, reg_type::in, int::in,
+ prog_var::in) is semidet.
-reg_is_not_locked_for_var(VLI, RegNum, Var) :-
+reg_is_not_locked_for_var(VLI, RegType, RegNum, Var) :-
var_locn_get_acquired(VLI, Acquired),
- var_locn_get_locked(VLI, Locked),
var_locn_get_exceptions(VLI, Exceptions),
- Reg = reg(reg_r, RegNum),
+ (
+ RegType = reg_r,
+ var_locn_get_locked(VLI, Locked, _LockedF)
+ ;
+ RegType = reg_f,
+ var_locn_get_locked(VLI, _LockedR, Locked)
+ ),
+ Reg = reg(RegType, RegNum),
\+ set.member(Reg, Acquired),
RegNum =< Locked => list.member(Var - Reg, Exceptions).
%----------------------------------------------------------------------------%
-var_locn_acquire_reg(Lval, !VLI) :-
- get_spare_reg(!.VLI, Lval),
+var_locn_acquire_reg(Type, Lval, !VLI) :-
+ get_spare_reg(!.VLI, Type, Lval),
var_locn_get_acquired(!.VLI, Acquired0),
set.insert(Lval, Acquired0, Acquired),
var_locn_set_acquired(Acquired, !VLI).
@@ -2118,10 +2193,10 @@ var_locn_acquire_reg_require_given(Lval, !VLI) :-
set.insert(Lval, Acquired0, Acquired),
var_locn_set_acquired(Acquired, !VLI).
-var_locn_acquire_reg_prefer_given(Pref, Lval, !VLI) :-
- PrefLval = reg(reg_r, Pref),
+var_locn_acquire_reg_prefer_given(Type, Pref, Lval, !VLI) :-
+ PrefLval = reg(Type, Pref),
( var_locn_lval_in_use(!.VLI, PrefLval) ->
- get_spare_reg(!.VLI, Lval)
+ get_spare_reg(!.VLI, Type, Lval)
;
Lval = PrefLval
),
@@ -2129,10 +2204,10 @@ var_locn_acquire_reg_prefer_given(Pref, Lval, !VLI) :-
set.insert(Lval, Acquired0, Acquired),
var_locn_set_acquired(Acquired, !VLI).
-var_locn_acquire_reg_start_at_given(Start, Lval, !VLI) :-
- StartLval = reg(reg_r, Start),
+var_locn_acquire_reg_start_at_given(Type, Start, Lval, !VLI) :-
+ StartLval = reg(Type, Start),
( var_locn_lval_in_use(!.VLI, StartLval) ->
- var_locn_acquire_reg_start_at_given(Start + 1, Lval, !VLI)
+ var_locn_acquire_reg_start_at_given(Type, Start + 1, Lval, !VLI)
;
Lval = StartLval,
var_locn_get_acquired(!.VLI, Acquired0),
@@ -2151,24 +2226,25 @@ var_locn_release_reg(Lval, !VLI) :-
%----------------------------------------------------------------------------%
-var_locn_lock_regs(N, Exceptions, !VLI) :-
- var_locn_set_locked(N, !VLI),
+var_locn_lock_regs(R, F, Exceptions, !VLI) :-
+ var_locn_set_locked(R, F, !VLI),
var_locn_set_exceptions(Exceptions, !VLI).
var_locn_unlock_regs(!VLI) :-
- var_locn_set_locked(0, !VLI),
+ var_locn_set_locked(0, 0, !VLI),
var_locn_set_exceptions([], !VLI).
%----------------------------------------------------------------------------%
-var_locn_max_reg_in_use(VLI, Max) :-
+var_locn_max_reg_in_use(VLI, MaxR, MaxF) :-
var_locn_get_loc_var_map(VLI, LocVarMap),
map.keys(LocVarMap, VarLocs),
- code_util.max_mentioned_reg(VarLocs, Max1),
+ code_util.max_mentioned_regs(VarLocs, MaxR1, MaxF1),
var_locn_get_acquired(VLI, Acquired),
set.to_sorted_list(Acquired, AcquiredList),
- code_util.max_mentioned_reg(AcquiredList, Max2),
- int.max(Max1, Max2, Max).
+ code_util.max_mentioned_regs(AcquiredList, MaxR2, MaxF2),
+ int.max(MaxR1, MaxR2, MaxR),
+ int.max(MaxF1, MaxF2, MaxF).
%----------------------------------------------------------------------------%
@@ -2240,6 +2316,7 @@ var_locn_materialize_vars_in_lval_avoid(ModuleInfo, Lval0, Avoid, Lval, Code,
; Lval0 = stackvar(_)
; Lval0 = parent_stackvar(_)
; Lval0 = framevar(_)
+ ; Lval0 = double_stackvar(_, _)
; Lval0 = global_var_ref(_)
; Lval0 = succip
; Lval0 = maxfr
@@ -2424,7 +2501,8 @@ materialize_var(ModuleInfo, Var, MaybePrefer, StoreIfReq, Avoid, Rval, Code,
NumUsingVars = set_of_var.count(UsingVars),
NumUsingVars > 1
->
- select_preferred_reg_avoid(!.VLI, Var, Avoid, Lval),
+ reg_type_for_var(!.VLI, Var, RegType),
+ select_preferred_reg_avoid(!.VLI, Var, RegType, Avoid, Lval),
var_locn_place_var(ModuleInfo, Var, Lval, PlaceCode, !VLI),
Rval = lval(Lval),
Code = ExprCode ++ PlaceCode
@@ -2487,10 +2565,11 @@ make_var_not_depend_on_root_lval(Var, Lval, !LocVarMap) :-
:- pred is_root_lval(lval::in) is semidet.
-is_root_lval(reg(reg_r, _)).
+is_root_lval(reg(_, _)).
is_root_lval(stackvar(_)).
is_root_lval(parent_stackvar(_)).
is_root_lval(framevar(_)).
+is_root_lval(double_stackvar(_, _)).
%----------------------------------------------------------------------------%
@@ -2524,47 +2603,61 @@ rval_depends_on_search_lval(binop(_Op, Rval0, Rval1), SearchLval) :-
:- pred lval_depends_on_search_lval(lval::in, dep_search_lval::in) is semidet.
-lval_depends_on_search_lval(reg(Type, Num), SearchLval) :-
+lval_depends_on_search_lval(Lval, SearchLval) :-
+ require_complete_switch [Lval]
(
- SearchLval = all_regs
+ Lval = reg(_Type, _Num),
+ (
+ SearchLval = all_regs
+ ;
+ SearchLval = specific_reg_or_stack(Lval)
+ )
;
- SearchLval = specific_reg_or_stack(Lval),
- Lval = reg(Type, Num)
- ).
-lval_depends_on_search_lval(stackvar(Num), SearchLval) :-
- SearchLval = specific_reg_or_stack(Lval),
- Lval = stackvar(Num).
-lval_depends_on_search_lval(framevar(Num), SearchLval) :-
- SearchLval = specific_reg_or_stack(Lval),
- Lval = framevar(Num).
-lval_depends_on_search_lval(lvar(_Var), _SearchLval) :-
- unexpected($module, $pred, "lvar").
-lval_depends_on_search_lval(field(_Tag, Rval0, Rval1), SearchLval) :-
- (
- rval_depends_on_search_lval(Rval0, SearchLval)
+ Lval = stackvar(_Num),
+ SearchLval = specific_reg_or_stack(Lval)
;
- rval_depends_on_search_lval(Rval1, SearchLval)
- ).
-
-:- pred args_depend_on_search_lval(list(maybe(rval))::in, dep_search_lval::in)
- is semidet.
-
-args_depend_on_search_lval([], _SearchLval) :-
- fail.
-args_depend_on_search_lval([Arg | Args], SearchLval) :-
- (
- Arg = yes(Rval),
- rval_depends_on_search_lval(Rval, SearchLval)
+ Lval = framevar(_Num),
+ SearchLval = specific_reg_or_stack(Lval)
;
- args_depend_on_search_lval(Args, SearchLval)
+ Lval = field(_Tag, Rval0, Rval1),
+ (
+ rval_depends_on_search_lval(Rval0, SearchLval)
+ ;
+ rval_depends_on_search_lval(Rval1, SearchLval)
+ )
+ ;
+ Lval = double_stackvar(_, _),
+ SearchLval = specific_reg_or_stack(Lval)
+ ;
+ ( Lval = succip
+ ; Lval = maxfr
+ ; Lval = curfr
+ ; Lval = hp
+ ; Lval = sp
+ ; Lval = parent_sp
+ ; Lval = temp(_, _)
+ ; Lval = parent_stackvar(_)
+ ; Lval = succip_slot(_)
+ ; Lval = succfr_slot(_)
+ ; Lval = redoip_slot(_)
+ ; Lval = redofr_slot(_)
+ ; Lval = redofr_slot(_)
+ ; Lval = prevfr_slot(_)
+ ; Lval = mem_ref(_)
+ ; Lval = global_var_ref(_)
+ ),
+ fail
+ ;
+ Lval = lvar(_Var),
+ unexpected($module, $pred, "lvar")
).
%----------------------------------------------------------------------------%
-var_locn_set_follow_vars(abs_follow_vars(FollowVarMap, NextNonReserved),
- !VLI) :-
+var_locn_set_follow_vars(abs_follow_vars(FollowVarMap, NextNonReservedR,
+ NextNonReservedF), !VLI) :-
var_locn_set_follow_var_map(FollowVarMap, !VLI),
- var_locn_set_next_non_reserved(NextNonReserved, !VLI).
+ var_locn_set_next_non_reserved(NextNonReservedR, NextNonReservedF, !VLI).
%----------------------------------------------------------------------------%
@@ -2589,17 +2682,18 @@ nonempty_state(State) :-
:- pred var_locn_get_varset(var_locn_info::in, prog_varset::out) is det.
:- pred var_locn_get_vartypes(var_locn_info::in, vartypes::out) is det.
+:- pred var_locn_get_float_reg_type(var_locn_info::in, reg_type::out) is det.
:- pred var_locn_get_var_state_map(var_locn_info::in, var_state_map::out)
is det.
:- pred var_locn_get_loc_var_map(var_locn_info::in, loc_var_map::out) is det.
:- pred var_locn_get_acquired(var_locn_info::in, set(lval)::out) is det.
-:- pred var_locn_get_locked(var_locn_info::in, int::out) is det.
+:- pred var_locn_get_locked(var_locn_info::in, int::out, int::out) is det.
:- pred var_locn_get_exceptions(var_locn_info::in,
assoc_list(prog_var, lval)::out) is det.
:- pred var_locn_set_follow_var_map(abs_follow_vars_map::in,
var_locn_info::in, var_locn_info::out) is det.
-:- pred var_locn_set_next_non_reserved(int::in,
+:- pred var_locn_set_next_non_reserved(int::in, int::in,
var_locn_info::in, var_locn_info::out) is det.
:- pred var_locn_set_var_state_map(var_state_map::in,
var_locn_info::in, var_locn_info::out) is det.
@@ -2607,28 +2701,34 @@ nonempty_state(State) :-
var_locn_info::in, var_locn_info::out) is det.
:- pred var_locn_set_acquired(set(lval)::in,
var_locn_info::in, var_locn_info::out) is det.
-:- pred var_locn_set_locked(int::in,
+:- pred var_locn_set_locked(int::in, int::in,
var_locn_info::in, var_locn_info::out) is det.
:- pred var_locn_set_exceptions(assoc_list(prog_var, lval)::in,
var_locn_info::in, var_locn_info::out) is det.
var_locn_get_varset(VI, VI ^ vli_varset).
var_locn_get_vartypes(VI, VI ^ vli_vartypes).
+var_locn_get_float_reg_type(VI, VI ^ vli_float_reg_type).
var_locn_get_stack_slots(VI, VI ^ vli_stack_slots).
var_locn_get_follow_var_map(VI, VI ^ vli_follow_vars_map).
-var_locn_get_next_non_reserved(VI, VI ^ vli_next_non_res).
+var_locn_get_next_non_reserved(VI, reg_r, VI ^ vli_next_non_res_r).
+var_locn_get_next_non_reserved(VI, reg_f, VI ^ vli_next_non_res_f).
var_locn_get_var_state_map(VI, VI ^ vli_var_state_map).
var_locn_get_loc_var_map(VI, VI ^ vli_loc_var_map).
var_locn_get_acquired(VI, VI ^ vli_acquired).
-var_locn_get_locked(VI, VI ^ vli_locked).
+var_locn_get_locked(VI, VI ^ vli_locked_r, VI ^ vli_locked_f).
var_locn_get_exceptions(VI, VI ^ vli_exceptions).
var_locn_set_follow_var_map(FVM, VI, VI ^ vli_follow_vars_map := FVM).
-var_locn_set_next_non_reserved(NNR, VI, VI ^ vli_next_non_res := NNR).
+var_locn_set_next_non_reserved(NNR, NNF, !VI) :-
+ !VI ^ vli_next_non_res_r := NNR,
+ !VI ^ vli_next_non_res_f := NNF.
var_locn_set_var_state_map(VSM, VI, VI ^ vli_var_state_map := VSM).
var_locn_set_loc_var_map(LVM, VI, VI ^ vli_loc_var_map := LVM).
var_locn_set_acquired(A, VI, VI ^ vli_acquired := A).
-var_locn_set_locked(L, VI, VI ^ vli_locked := L).
+var_locn_set_locked(R, F, !VI) :-
+ !VI ^ vli_locked_r := R,
+ !VI ^ vli_locked_f := F.
var_locn_set_exceptions(E, VI, VI ^ vli_exceptions := E).
%----------------------------------------------------------------------------%
diff --git a/compiler/x86_64_regs.m b/compiler/x86_64_regs.m
index 1ef623b..bdac726 100644
--- a/compiler/x86_64_regs.m
+++ b/compiler/x86_64_regs.m
@@ -90,6 +90,8 @@
:- implementation.
+:- import_module hlds.hlds_llds.
+
:- import_module bool.
:- import_module list.
:- import_module map.
@@ -171,6 +173,7 @@ reg_map_lookup_reg_locn(Map, Lval) = RegLocn :-
Map = reg_map(_, RegMap),
(
( Lval = parent_stackvar(_)
+ ; Lval = double_stackvar(_, _)
; Lval = succip_slot(_)
; Lval = redoip_slot(_)
; Lval = redofr_slot(_)
diff --git a/runtime/mercury_accurate_gc.c b/runtime/mercury_accurate_gc.c
index a27d0ab..47f0f90 100644
--- a/runtime/mercury_accurate_gc.c
+++ b/runtime/mercury_accurate_gc.c
@@ -781,6 +781,7 @@ copy_long_value(MR_LongLval locn, MR_TypeInfo type_info,
break;
case MR_LONG_LVAL_TYPE_F:
+ MR_fatal_error("copy_long_value: MR_LONG_LVAL_TYPE_F");
break;
case MR_LONG_LVAL_TYPE_STACKVAR:
@@ -799,6 +800,14 @@ copy_long_value(MR_LongLval locn, MR_TypeInfo type_info,
MR_ENGINE(MR_eng_heap_zone2->MR_zone_hardmax));
break;
+ case MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR:
+ MR_fatal_error("copy_long_value: MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR");
+ break;
+
+ case MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR:
+ MR_fatal_error("copy_long_value: MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR");
+ break;
+
case MR_LONG_LVAL_TYPE_SUCCIP:
break;
diff --git a/runtime/mercury_agc_debug.c b/runtime/mercury_agc_debug.c
index 0a3f2de..d6845f2 100644
--- a/runtime/mercury_agc_debug.c
+++ b/runtime/mercury_agc_debug.c
@@ -50,6 +50,7 @@ MR_agc_dump_roots(MR_RootList roots)
{
#ifndef MR_HIGHLEVEL_CODE
MR_Word saved_regs[MR_MAX_FAKE_REG];
+ MR_Float saved_f_regs[MR_MAX_VIRTUAL_F_REG];
#endif
fflush(NULL);
@@ -64,7 +65,8 @@ MR_agc_dump_roots(MR_RootList roots)
** and we don't want it messing with the saved registers).
*/
MR_restore_registers();
- MR_copy_regs_to_saved_regs(MR_MAX_FAKE_REG - 1, saved_regs);
+ MR_copy_regs_to_saved_regs(MR_MAX_FAKE_REG - 1, saved_regs,
+ MR_MAX_VIRTUAL_F_REG - 1, saved_f_regs);
MR_hp = MR_ENGINE(MR_eng_debug_heap_zone->MR_zone_min);
MR_virtual_hp = MR_ENGINE(MR_eng_debug_heap_zone->MR_zone_min);
@@ -242,6 +244,7 @@ MR_dump_live_variables(const MR_LabelLayout *label_layout,
MR_Word value;
MR_TypeInfoParams type_params;
MR_Word saved_regs[MR_MAX_FAKE_REG];
+ MR_Float saved_f_regs[MR_MAX_VIRTUAL_F_REG];
MR_Word *current_regs;
long_var_count = MR_long_desc_var_count(label_layout);
@@ -255,7 +258,8 @@ MR_dump_live_variables(const MR_LabelLayout *label_layout,
*/
MR_restore_registers();
- MR_copy_regs_to_saved_regs(MR_MAX_FAKE_REG - 1, saved_regs);
+ MR_copy_regs_to_saved_regs(MR_MAX_FAKE_REG - 1, saved_regs,
+ MR_MAX_VIRTUAL_F_REG - 1, saved_f_regs);
if (top_frame) {
current_regs = saved_regs;
} else {
diff --git a/runtime/mercury_engine.h b/runtime/mercury_engine.h
index 680dfc6..4bda052 100644
--- a/runtime/mercury_engine.h
+++ b/runtime/mercury_engine.h
@@ -26,6 +26,7 @@
#include "mercury_std.h" /* for `MR_bool' */
#include "mercury_types.h" /* for `MR_Code *' */
+#include "mercury_float.h" /* for `MR_Float_Dword' */
#include "mercury_goto.h" /* for `MR_define_entry()' */
#include "mercury_thread.h" /* for pthread types */
#include "mercury_context.h" /* for MR_Context, MR_IF_USE_TRAIL */
@@ -308,6 +309,11 @@ typedef struct {
** for the engine, and then invokes MR_load_context to copy the
** info from there into the MR_eng_context field.
**
+** float_reg
+** The float reg vector for this engine. This exists only if
+** MR_BOXED_FLOAT is defined, i.e. when sizeof(MR_Float) >
+** sizeof(MR_Word).
+**
** trail_ptr
** ticket_counter
** ticket_high_water
@@ -348,7 +354,8 @@ typedef struct {
** finishes, c_depth is decremented.
**
** cpu_clock_ticks_offset
-** The offset to be added to the CPU's TSC to give a time relative to the start of the program.
+** The offset to be added to the CPU's TSC to give a time relative
+** to the start of the program.
**
** ts_buffer
** The buffer object used by threadscope for this engine.
@@ -402,6 +409,9 @@ typedef struct MR_mercury_engine_struct {
#endif
MR_Context *MR_eng_this_context;
MR_Context MR_eng_context;
+#ifdef MR_BOXED_FLOAT
+ union MR_Float_Dword MR_eng_float_reg[MR_MAX_VIRTUAL_F_REG];
+#endif
#if defined(MR_THREAD_SAFE) && defined(MR_USE_TRAIL)
MR_TrailEntry *MR_eng_trail_ptr;
MR_Unsigned MR_eng_ticket_counter;
diff --git a/runtime/mercury_float.h b/runtime/mercury_float.h
index d8f72c1..280f47b 100644
--- a/runtime/mercury_float.h
+++ b/runtime/mercury_float.h
@@ -71,7 +71,10 @@
#define MR_float_const(f) MR_float_to_word(f) /* inefficient */
#endif
-#ifndef MR_USE_SINGLE_PREC_FLOAT
+ /*
+ ** MR_BOXED_FLOAT is never defined if using single-precision floats,
+ ** so MR_Float must be double.
+ */
union MR_Float_Dword {
MR_Float f;
MR_Word w[2];
@@ -105,8 +108,6 @@
}
#endif
-#endif /* not MR_USE_SINGLE_PREC_FLOAT */
-
#else /* not MR_BOXED_FLOAT */
/* unboxed float means we can assume sizeof(MR_Float) <= sizeof(MR_Word) */
diff --git a/runtime/mercury_layout_util.c b/runtime/mercury_layout_util.c
index 2e706cd..48b8d77 100644
--- a/runtime/mercury_layout_util.c
+++ b/runtime/mercury_layout_util.c
@@ -26,7 +26,8 @@ static MR_Word MR_lookup_answer_block_long_lval(MR_LongLval locn,
MR_Word *answer_block, int block_size, MR_bool *succeeded);
void
-MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs)
+MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs,
+ int max_f_num, MR_Float *saved_f_regs)
{
/*
** In the process of browsing within the debugger, we call Mercury,
@@ -41,6 +42,10 @@ MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs)
** transient registers in the fake_reg array. We here restore them
** to the real registers, save them with the other registers back in
** fake_reg, and then copy all fake_reg entries to saved_regs.
+ **
+ ** If float registers are used, we must save them as well.
+ ** We never use real machine registers for floats so we just have
+ ** to copy them from the MR_float_reg array.
*/
int i;
@@ -51,10 +56,20 @@ MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs)
for (i = 0; i <= max_mr_num; i++) {
saved_regs[i] = MR_fake_reg[i];
}
+
+#ifdef MR_BOXED_FLOAT
+ for (i = 0; i <= max_f_num; i++) {
+ saved_f_regs[i] = MR_float_reg[i].f;
+ }
+#else
+ (void) max_f_num;
+ (void) saved_f_regs;
+#endif
}
void
-MR_copy_saved_regs_to_regs(int max_mr_num, MR_Word *saved_regs)
+MR_copy_saved_regs_to_regs(int max_mr_num, MR_Word *saved_regs,
+ int max_f_num, MR_Float *saved_f_regs)
{
/*
** We execute the converse procedure to MR_copy_regs_to_saved_regs.
@@ -69,6 +84,15 @@ MR_copy_saved_regs_to_regs(int max_mr_num, MR_Word *saved_regs)
MR_fake_reg[i] = saved_regs[i];
}
+#ifdef MR_BOXED_FLOAT
+ for (i = 0; i <= max_f_num; i++) {
+ MR_float_reg[i].f = saved_f_regs[i];
+ }
+#else
+ (void) max_f_num;
+ (void) saved_f_regs;
+#endif
+
MR_restore_registers();
MR_save_transient_registers();
}
@@ -101,7 +125,7 @@ MR_materialize_type_params_base(const MR_LabelLayout *label_layout,
if (tvar_locns->MR_tp_param_locns[i] != 0) {
type_params[i + 1] = (MR_TypeInfo)
MR_lookup_long_lval_base(tvar_locns->MR_tp_param_locns[i],
- saved_regs, base_sp, base_curfr, &succeeded);
+ saved_regs, base_sp, base_curfr, NULL, &succeeded);
if (! succeeded) {
MR_fatal_error("missing type param in "
"MR_materialize_type_params_base");
@@ -220,7 +244,10 @@ MR_materialize_answer_block_type_params(const MR_TypeParamLocns *tvar_locns,
int
MR_get_register_number_long(MR_LongLval locn)
{
- if (MR_LONG_LVAL_TYPE(locn) == MR_LONG_LVAL_TYPE_R) {
+ MR_LongLvalType type;
+
+ type = MR_LONG_LVAL_TYPE(locn);
+ if (type == MR_LONG_LVAL_TYPE_R || type == MR_LONG_LVAL_TYPE_F) {
return MR_LONG_LVAL_NUMBER(locn);
} else {
return -1;
@@ -244,10 +271,12 @@ MR_get_register_number_short(MR_ShortLval locn)
#endif
MR_Word
-MR_lookup_long_lval(MR_LongLval locn, MR_Word *saved_regs, MR_bool *succeeded)
+MR_lookup_long_lval(MR_LongLval locn, MR_Word *saved_regs,
+ MR_Float *saved_f_regs, MR_bool *succeeded)
{
return MR_lookup_long_lval_base(locn, saved_regs,
- MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs), succeeded);
+ MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
+ saved_f_regs, succeeded);
}
static MR_Word
@@ -294,6 +323,18 @@ MR_lookup_closure_long_lval(MR_LongLval locn, MR_Closure *closure,
}
break;
+ case MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR:
+ if (MR_print_locn) {
+ printf("closure double stackvar%d\n", locn_num);
+ }
+ break;
+
+ case MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR:
+ if (MR_print_locn) {
+ printf("closure double framevar%d\n", locn_num);
+ }
+ break;
+
case MR_LONG_LVAL_TYPE_SUCCIP:
if (MR_print_locn) {
printf("closure succip\n");
@@ -346,6 +387,10 @@ MR_lookup_closure_long_lval(MR_LongLval locn, MR_Closure *closure,
case MR_LONG_LVAL_TYPE_CONS_1:
case MR_LONG_LVAL_TYPE_CONS_2:
case MR_LONG_LVAL_TYPE_CONS_3:
+ case MR_LONG_LVAL_TYPE_CONS_4:
+ case MR_LONG_LVAL_TYPE_CONS_5:
+ case MR_LONG_LVAL_TYPE_CONS_6:
+ case MR_LONG_LVAL_TYPE_CONS_7:
value = MR_LONG_LVAL_CONST(locn);
*succeeded = MR_TRUE;
break;
@@ -413,6 +458,18 @@ MR_lookup_typeclass_info_long_lval(MR_LongLval locn, MR_Word typeclass_info,
}
break;
+ case MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR:
+ if (MR_print_locn) {
+ printf("typeclassinfo double stackvar%d\n", locn_num);
+ }
+ break;
+
+ case MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR:
+ if (MR_print_locn) {
+ printf("typeclassinfo double framevar%d\n", locn_num);
+ }
+ break;
+
case MR_LONG_LVAL_TYPE_SUCCIP:
if (MR_print_locn) {
printf("typeclassinfo succip\n");
@@ -465,6 +522,10 @@ MR_lookup_typeclass_info_long_lval(MR_LongLval locn, MR_Word typeclass_info,
case MR_LONG_LVAL_TYPE_CONS_1:
case MR_LONG_LVAL_TYPE_CONS_2:
case MR_LONG_LVAL_TYPE_CONS_3:
+ case MR_LONG_LVAL_TYPE_CONS_4:
+ case MR_LONG_LVAL_TYPE_CONS_5:
+ case MR_LONG_LVAL_TYPE_CONS_6:
+ case MR_LONG_LVAL_TYPE_CONS_7:
value = MR_LONG_LVAL_CONST(locn);
*succeeded = MR_TRUE;
break;
@@ -529,6 +590,18 @@ MR_lookup_answer_block_long_lval(MR_LongLval locn, MR_Word *answer_block,
}
break;
+ case MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR:
+ if (MR_print_locn) {
+ printf("answer_block double stackvar%d\n", locn_num);
+ }
+ break;
+
+ case MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR:
+ if (MR_print_locn) {
+ printf("answer_block double framevar%d\n", locn_num);
+ }
+ break;
+
case MR_LONG_LVAL_TYPE_SUCCIP:
if (MR_print_locn) {
printf("answer_block succip\n");
@@ -581,6 +654,10 @@ MR_lookup_answer_block_long_lval(MR_LongLval locn, MR_Word *answer_block,
case MR_LONG_LVAL_TYPE_CONS_1:
case MR_LONG_LVAL_TYPE_CONS_2:
case MR_LONG_LVAL_TYPE_CONS_3:
+ case MR_LONG_LVAL_TYPE_CONS_4:
+ case MR_LONG_LVAL_TYPE_CONS_5:
+ case MR_LONG_LVAL_TYPE_CONS_6:
+ case MR_LONG_LVAL_TYPE_CONS_7:
value = MR_LONG_LVAL_CONST(locn);
*succeeded = MR_TRUE;
break;
@@ -603,7 +680,8 @@ MR_lookup_answer_block_long_lval(MR_LongLval locn, MR_Word *answer_block,
MR_Word
MR_lookup_long_lval_base(MR_LongLval locn, MR_Word *saved_regs,
- MR_Word *base_sp, MR_Word *base_curfr, MR_bool *succeeded)
+ MR_Word *base_sp, MR_Word *base_curfr, MR_Float *saved_f_regs,
+ MR_bool *succeeded)
{
int locn_num;
int offset;
@@ -631,6 +709,13 @@ MR_lookup_long_lval_base(MR_LongLval locn, MR_Word *saved_regs,
if (MR_print_locn) {
printf("long f%d\n", locn_num);
}
+#ifdef MR_BOXED_FLOAT
+ if (saved_f_regs != NULL) {
+ MR_Float f = MR_saved_f_reg_value(saved_f_regs, locn_num);
+ value = MR_float_to_word(f);
+ *succeeded = MR_TRUE;
+ }
+#endif
break;
case MR_LONG_LVAL_TYPE_STACKVAR:
@@ -649,6 +734,28 @@ MR_lookup_long_lval_base(MR_LongLval locn, MR_Word *saved_regs,
*succeeded = MR_TRUE;
break;
+ case MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR:
+ if (MR_print_locn) {
+ printf("long double stackvar%d\n", locn_num);
+ }
+#ifdef MR_BOXED_FLOAT
+ value = MR_float_to_word(MR_float_from_dword_ptr(
+ &MR_based_stackvar(base_sp, locn_num + 1)));
+ *succeeded = MR_TRUE;
+#endif
+ break;
+
+ case MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR:
+ if (MR_print_locn) {
+ printf("long double framevar%d\n", locn_num);
+ }
+#ifdef MR_BOXED_FLOAT
+ value = MR_float_to_word(MR_float_from_dword_ptr(
+ &MR_based_framevar(base_sp, locn_num + 1)));
+ *succeeded = MR_TRUE;
+#endif
+ break;
+
case MR_LONG_LVAL_TYPE_SUCCIP:
if (MR_print_locn) {
printf("long succip\n");
@@ -689,7 +796,7 @@ MR_lookup_long_lval_base(MR_LongLval locn, MR_Word *saved_regs,
printf("long offset %d from ", offset);
}
baseaddr = MR_lookup_long_lval_base(sublocn, saved_regs,
- base_sp, base_curfr, succeeded);
+ base_sp, base_curfr, saved_f_regs, succeeded);
if (! *succeeded) {
break;
}
@@ -701,6 +808,10 @@ MR_lookup_long_lval_base(MR_LongLval locn, MR_Word *saved_regs,
case MR_LONG_LVAL_TYPE_CONS_1:
case MR_LONG_LVAL_TYPE_CONS_2:
case MR_LONG_LVAL_TYPE_CONS_3:
+ case MR_LONG_LVAL_TYPE_CONS_4:
+ case MR_LONG_LVAL_TYPE_CONS_5:
+ case MR_LONG_LVAL_TYPE_CONS_6:
+ case MR_LONG_LVAL_TYPE_CONS_7:
value = MR_LONG_LVAL_CONST(locn);
*succeeded = MR_TRUE;
break;
@@ -814,17 +925,19 @@ MR_lookup_short_lval_base(MR_ShortLval locn, MR_Word *saved_regs,
MR_bool
MR_get_type_and_value(const MR_LabelLayout *label_layout, int i,
- MR_Word *saved_regs, MR_TypeInfo *type_params, MR_TypeInfo *type_info,
+ MR_Word *saved_regs, MR_Float *saved_f_regs,
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info,
MR_Word *value)
{
return MR_get_type_and_value_base(label_layout, i, saved_regs,
- MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
+ MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs), saved_f_regs,
type_params, type_info, value);
}
MR_bool
MR_get_type_and_value_base(const MR_LabelLayout *label_layout, int i,
MR_Word *saved_regs, MR_Word *base_sp, MR_Word *base_curfr,
+ MR_Float *saved_f_regs,
MR_TypeInfo *type_params, MR_TypeInfo *type_info, MR_Word *value)
{
MR_PseudoTypeInfo pseudo_type_info;
@@ -844,7 +957,8 @@ MR_get_type_and_value_base(const MR_LabelLayout *label_layout, int i,
long_locn = MR_long_desc_var_locn(label_layout, i);
*value = MR_lookup_long_lval_base(long_locn,
- saved_regs, base_sp, base_curfr, &succeeded);
+ saved_regs, base_sp, base_curfr, saved_f_regs,
+ &succeeded);
} else {
if (MR_print_locn) {
printf("looking up short lval: ");
diff --git a/runtime/mercury_layout_util.h b/runtime/mercury_layout_util.h
index 962280c..e13734d 100644
--- a/runtime/mercury_layout_util.h
+++ b/runtime/mercury_layout_util.h
@@ -18,11 +18,14 @@
/*
** These two functions copy the register state to and from the provided
-** saved_regs array, which should have room for MR_MAX_FAKE_REG MR_Words.
+** saved_regs and saved_f_regs arrays, which should have room for
+** MR_MAX_FAKE_REG MR_Words and MR_MAX_VIRTUAL_F_REG MR_Floats respectively.
*/
-extern void MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs);
-extern void MR_copy_saved_regs_to_regs(int max_mr_num, MR_Word *saved_regs);
+extern void MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs,
+ int max_f_num, MR_Float *saved_f_regs);
+extern void MR_copy_saved_regs_to_regs(int max_mr_num, MR_Word *saved_regs,
+ int max_f_num, MR_Float *saved_f_regs);
/*
** A MR_LabelLayout describes the variables that are live at a given
@@ -100,10 +103,12 @@ extern int MR_get_register_number_short(MR_ShortLval locn);
*/
extern MR_Word MR_lookup_long_lval(MR_LongLval locn,
- MR_Word *saved_regs, MR_bool *succeeded);
+ MR_Word *saved_regs, MR_Float *saved_f_regs,
+ MR_bool *succeeded);
extern MR_Word MR_lookup_long_lval_base(MR_LongLval locn,
MR_Word *saved_regs, MR_Word *base_sp,
- MR_Word *base_curfr, MR_bool *succeeded);
+ MR_Word *base_curfr, MR_Float *saved_f_regs,
+ MR_bool *succeeded);
extern MR_Word MR_lookup_short_lval(MR_ShortLval locn,
MR_Word *saved_regs, MR_bool *succeeded);
extern MR_Word MR_lookup_short_lval_base(MR_ShortLval locn,
@@ -136,11 +141,12 @@ extern MR_Word MR_lookup_short_lval_base(MR_ShortLval locn,
*/
extern MR_bool MR_get_type_and_value(const MR_LabelLayout *label_layout,
- int var, MR_Word *saved_regs, MR_TypeInfo *type_params,
- MR_TypeInfo *type_info, MR_Word *value);
+ int var, MR_Word *saved_regs, MR_Float *saved_f_regs,
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info,
+ MR_Word *value);
extern MR_bool MR_get_type_and_value_base(const MR_LabelLayout *label_layout,
- int var, MR_Word *saved_regs,
- MR_Word *base_sp, MR_Word *base_curfr,
+ int var, MR_Word *saved_regs, MR_Word *base_sp,
+ MR_Word *base_curfr, MR_Float *saved_f_regs,
MR_TypeInfo *type_params, MR_TypeInfo *type_info,
MR_Word *value);
extern MR_bool MR_get_type(const MR_LabelLayout *label_layout, int var,
diff --git a/runtime/mercury_regs.h b/runtime/mercury_regs.h
index 711744b..8bec3f4 100644
--- a/runtime/mercury_regs.h
+++ b/runtime/mercury_regs.h
@@ -196,7 +196,7 @@
/*
** The Mercury abstract machine registers layer.
**
-** The Mercury abstract machine registers consist of four groups.
+** The Mercury abstract machine registers consist of five groups.
**
** - The general purpose registers that may be allocated to real machine
** registers, MR_rN for 1 <= N <= MR_MAX_REAL_R_REG.
@@ -243,6 +243,9 @@
** They need to be fields in the Mercury engine structure. We already
** do this for MR_parent_sp, but incompletely for a few of the others.
**
+** - The floating point registers, if present, are always stored in the
+** float_reg array and not a physical register.
+**
** The Mercury abstract machine registers layer also provides MR_virtual_r(),
** MR_virtual_succip, MR_virtual_hp, etc., which are similar to mr<N>,
** MR_succip, MR_hp, etc. except that they always map to the underlying
@@ -268,6 +271,18 @@
#endif
/*
+** The float registers only exist if MR_BOXED_FLOAT. To reduce the need for
+** #ifdefs, we define MR_MAX_VIRTUAL_F_REG even when float registers aren't
+** used, to a small number to minimise space allocated in arrays.
+*/
+
+#ifdef MR_BOXED_FLOAT
+ #define MR_MAX_VIRTUAL_F_REG 1024
+#else
+ #define MR_MAX_VIRTUAL_F_REG 1
+#endif
+
+/*
** The MR_fake_reg array has a slot for every register of the Mercury abstract
** machine, both general and special purpose.
**
@@ -548,6 +563,7 @@
MR_min_sol_hp_rec_var)
#define MR_global_hp MR_count_usage(MR_GLOBAL_HP_SLOT, \
MR_global_hp_var)
+
#if defined(MR_THREAD_SAFE)
#define MR_trail_ptr MR_count_usage(MR_TRAIL_PTR_SLOT, \
@@ -767,6 +783,18 @@
#define MR_restore_par_registers() ((void) 0)
#endif
+#ifdef MR_BOXED_FLOAT
+ #define MR_float_reg (MR_ENGINE(MR_eng_float_reg))
+ #define MR_f(n) (MR_float_reg[n].f)
+
+ #define MR_saved_f_reg_value(save_area, n) \
+ (save_area)[(n)]
+ #define MR_saved_f_reg_assign(save_area, n, val) \
+ do { \
+ (save_area)[(n)] = (val); \
+ } while (0)
+#endif
+
/*
** The MR_save_registers() macro copies the physical machine registers
** and the global variables holding special purpose abstract machine registers
diff --git a/runtime/mercury_stack_layout.h b/runtime/mercury_stack_layout.h
index 5a67361..103f875 100644
--- a/runtime/mercury_stack_layout.h
+++ b/runtime/mercury_stack_layout.h
@@ -135,25 +135,31 @@ typedef MR_int_least16_t MR_Determinism;
typedef MR_Unsigned MR_LongLval;
typedef enum {
- MR_LONG_LVAL_TYPE_CONS_0,
- MR_LONG_LVAL_TYPE_R,
- MR_LONG_LVAL_TYPE_F,
- MR_LONG_LVAL_TYPE_STACKVAR,
- MR_LONG_LVAL_TYPE_CONS_1,
- MR_LONG_LVAL_TYPE_FRAMEVAR,
- MR_LONG_LVAL_TYPE_SUCCIP,
- MR_LONG_LVAL_TYPE_MAXFR,
- MR_LONG_LVAL_TYPE_CONS_2,
- MR_LONG_LVAL_TYPE_CURFR,
- MR_LONG_LVAL_TYPE_HP,
- MR_LONG_LVAL_TYPE_SP,
- MR_LONG_LVAL_TYPE_CONS_3,
- MR_LONG_LVAL_TYPE_INDIRECT,
- MR_LONG_LVAL_TYPE_UNKNOWN
+ MR_LONG_LVAL_TYPE_CONS_0 = 0,
+ MR_LONG_LVAL_TYPE_R = 1,
+ MR_LONG_LVAL_TYPE_F = 2,
+ MR_LONG_LVAL_TYPE_STACKVAR = 3,
+ MR_LONG_LVAL_TYPE_CONS_1 = 4,
+ MR_LONG_LVAL_TYPE_FRAMEVAR = 5,
+ MR_LONG_LVAL_TYPE_SUCCIP = 6,
+ MR_LONG_LVAL_TYPE_MAXFR = 7,
+ MR_LONG_LVAL_TYPE_CONS_2 = 8,
+ MR_LONG_LVAL_TYPE_CURFR = 9,
+ MR_LONG_LVAL_TYPE_HP = 10,
+ MR_LONG_LVAL_TYPE_SP = 11,
+ MR_LONG_LVAL_TYPE_CONS_3 = 12,
+ MR_LONG_LVAL_TYPE_DOUBLE_STACKVAR = 13,
+ MR_LONG_LVAL_TYPE_DOUBLE_FRAMEVAR = 14,
+ MR_LONG_LVAL_TYPE_INDIRECT = 15,
+ MR_LONG_LVAL_TYPE_CONS_4 = 16,
+ MR_LONG_LVAL_TYPE_UNKNOWN = 17,
+ MR_LONG_LVAL_TYPE_CONS_5 = 20,
+ MR_LONG_LVAL_TYPE_CONS_6 = 24,
+ MR_LONG_LVAL_TYPE_CONS_7 = 28
} MR_LongLvalType;
/* This must be in sync with stack_layout.long_lval_tag_bits */
-#define MR_LONG_LVAL_TAGBITS 4
+#define MR_LONG_LVAL_TAGBITS 5
#define MR_LONG_LVAL_CONST_TAGBITS 2
@@ -1136,6 +1142,7 @@ typedef struct MR_ExecTrace_Struct {
MR_uint_least16_t MR_exec_num_head_vars;
MR_uint_least16_t MR_exec_max_named_var_num;
MR_uint_least16_t MR_exec_max_r_num;
+ MR_uint_least16_t MR_exec_max_f_num;
MR_int_least8_t MR_exec_maybe_from_full;
MR_int_least8_t MR_exec_maybe_io_seq;
MR_int_least8_t MR_exec_maybe_trail;
@@ -1314,6 +1321,7 @@ typedef struct MR_ProcLayout_Traversal_Struct {
#define MR_sle_used_var_names MR_sle_exec_trace->MR_exec_used_var_names
#define MR_sle_max_named_var_num MR_sle_exec_trace->MR_exec_max_named_var_num
#define MR_sle_max_r_num MR_sle_exec_trace->MR_exec_max_r_num
+#define MR_sle_max_f_num MR_sle_exec_trace->MR_exec_max_f_num
#define MR_sle_maybe_from_full MR_sle_exec_trace->MR_exec_maybe_from_full
#define MR_sle_maybe_io_seq MR_sle_exec_trace->MR_exec_maybe_io_seq
#define MR_sle_maybe_trail MR_sle_exec_trace->MR_exec_maybe_trail
diff --git a/trace/mercury_trace.c b/trace/mercury_trace.c
index d1ca013..01a49bc 100644
--- a/trace/mercury_trace.c
+++ b/trace/mercury_trace.c
@@ -94,8 +94,8 @@ static const char *MR_undo_updates_of_maxfr(const MR_ProcLayout
MR_Word **maxfr_ptr);
static MR_Word MR_trace_find_input_arg(const MR_LabelLayout *label,
MR_Word *saved_regs, MR_Word *base_sp,
- MR_Word *base_curfr, MR_uint_least16_t var_num,
- MR_bool *succeeded);
+ MR_Word *base_curfr, MR_Float *saved_f_regs,
+ MR_uint_least16_t var_num, MR_bool *succeeded);
#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
static MR_RetryResult
@@ -203,23 +203,29 @@ MR_trace_real(const MR_LabelLayout *layout)
#ifdef MR_USE_EXTERNAL_DEBUGGER
MR_EventInfo event_info;
MR_Word *saved_regs = event_info.MR_saved_regs;
+ MR_Float *saved_f_regs = event_info.MR_saved_f_regs;
const char *path;
MR_bool stop_collecting = MR_FALSE;
int lineno = 0;
MR_compute_max_mr_num(event_info.MR_max_mr_num, layout);
+ event_info.MR_max_f_num =
+ layout->MR_sll_entry->MR_sle_max_f_num;
port = (MR_TracePort) layout->MR_sll_port;
path = MR_label_goal_path(layout);
- MR_copy_regs_to_saved_regs(event_info.MR_max_mr_num,
- saved_regs);
- MR_trace_init_point_vars(layout, saved_regs, port, MR_FALSE);
+ MR_copy_regs_to_saved_regs(
+ event_info.MR_max_mr_num, saved_regs,
+ event_info.MR_max_f_num, saved_f_regs);
+ MR_trace_init_point_vars(layout, saved_regs, saved_f_regs,
+ port, MR_FALSE);
lineno = MR_get_line_number(saved_regs, layout, port);
MR_COLLECT_filter(MR_trace_ctrl.MR_filter_ptr, seqno, depth,
port, layout, path, lineno, &stop_collecting);
- MR_copy_saved_regs_to_regs(event_info.MR_max_mr_num,
- saved_regs);
+ MR_copy_saved_regs_to_regs(
+ event_info.MR_max_mr_num, saved_regs,
+ event_info.MR_max_f_num, saved_f_regs);
if (stop_collecting) {
MR_trace_ctrl.MR_trace_cmd = MR_CMD_STEP;
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout,
@@ -533,6 +539,7 @@ MR_trace_interrupt_handler(void)
MR_Code *jumpaddr; \
MR_EventInfo event_info; \
MR_Word *saved_regs = event_info.MR_saved_regs; \
+ MR_Float *saved_f_regs = event_info.MR_saved_f_regs; \
\
event_info.MR_event_number = MR_trace_event_number; \
event_info.MR_call_seqno = seqno; \
@@ -542,8 +549,10 @@ MR_trace_interrupt_handler(void)
event_info.MR_event_path = MR_label_goal_path(layout); \
\
MR_compute_max_mr_num(event_info.MR_max_mr_num, layout); \
+ event_info.MR_max_f_num = layout->MR_sll_entry->MR_sle_max_f_num; \
/* This also saves the regs in MR_fake_regs. */ \
- MR_copy_regs_to_saved_regs(event_info.MR_max_mr_num, saved_regs);
+ MR_copy_regs_to_saved_regs(event_info.MR_max_mr_num, saved_regs, \
+ event_info.MR_max_f_num, saved_f_regs);
/*
** The MR_TRACE_EVENT_TEARDOWN macro is the final part of
@@ -567,7 +576,8 @@ MR_trace_interrupt_handler(void)
/* In case MR_global_hp is transient. */ \
MR_restore_transient_registers(); \
MR_saved_global_hp_word(saved_regs) = (MR_Word) MR_global_hp; \
- MR_copy_saved_regs_to_regs(event_info.MR_max_mr_num, saved_regs); \
+ MR_copy_saved_regs_to_regs(event_info.MR_max_mr_num, saved_regs, \
+ event_info.MR_max_f_num, saved_f_regs); \
return jumpaddr;
static MR_Code *
@@ -694,14 +704,18 @@ MR_trace_retry(MR_EventInfo *event_info,
const MR_ProcLayout *level_layout;
int call_all_var_count;
int call_long_var_count;
- MR_Word *args;
- int arg_max;
+ MR_Word *r_args;
+ int r_arg_max;
+ MR_Word *f_args;
+ int f_arg_max;
int arg_num;
MR_Word arg_value;
+ MR_bool reg_f;
MR_TypeInfoParams type_params;
int i;
MR_bool succeeded;
MR_Word *saved_regs;
+ MR_Float *saved_f_regs;
MR_Unsigned reused_frames;
MR_bool has_io_state;
MR_bool io_actions_were_performed;
@@ -717,10 +731,12 @@ MR_trace_retry(MR_EventInfo *event_info,
return MR_RETRY_ERROR;
#endif
- args = NULL;
+ r_args = NULL;
+ f_args = NULL;
MR_init_call_table_array();
saved_regs = event_info->MR_saved_regs;
+ saved_f_regs = event_info->MR_saved_f_regs;
#ifdef MR_DEBUG_RETRY
MR_print_stack_regs(stdout, saved_regs);
#endif
@@ -772,7 +788,8 @@ MR_trace_retry(MR_EventInfo *event_info,
** no native garbage collection can be triggered.
*/
- arg_max = 0;
+ r_arg_max = 0;
+ f_arg_max = 0;
/*
** Check if any of the (non-polymorphic) arguments are of type io.state.
@@ -811,7 +828,7 @@ MR_trace_retry(MR_EventInfo *event_info,
has_io_state = MR_TRUE;
} else {
arg_value = MR_trace_find_input_arg(return_label_layout,
- saved_regs, base_sp, base_curfr,
+ saved_regs, base_sp, base_curfr, saved_f_regs,
call_label->MR_sll_var_nums[i], &succeeded);
if (! succeeded) {
@@ -824,18 +841,29 @@ MR_trace_retry(MR_EventInfo *event_info,
MR_LongLval long_locn;
long_locn = MR_long_desc_var_locn(call_label, i);
+ reg_f = (MR_LONG_LVAL_TYPE(long_locn) == MR_LONG_LVAL_TYPE_F);
arg_num = MR_get_register_number_long(long_locn);
} else {
MR_ShortLval short_locn;
short_locn = MR_short_desc_var_locn(call_label,
i - call_long_var_count);
+ reg_f = MR_FALSE;
arg_num = MR_get_register_number_short(short_locn);
}
if (arg_num > 0) {
- MR_ensure_big_enough(arg_num, arg, MR_Word, MR_INIT_ARG_COUNT);
- args[arg_num] = arg_value;
+ if (reg_f) {
+ /* This sets f_arg, f_arg_max. */
+ MR_ensure_big_enough(arg_num, f_arg, MR_Word,
+ MR_INIT_ARG_COUNT);
+ f_args[arg_num] = arg_value;
+ } else {
+ /* This sets r_arg, r_arg_max. */
+ MR_ensure_big_enough(arg_num, r_arg, MR_Word,
+ MR_INIT_ARG_COUNT);
+ r_args[arg_num] = arg_value;
+ }
} else {
MR_fatal_error("illegal location for input argument");
}
@@ -1080,15 +1108,19 @@ MR_trace_retry(MR_EventInfo *event_info,
#endif
}
- for (i = 1; i < arg_max; i++) {
- MR_saved_reg_assign(saved_regs, i, args[i]);
+ for (i = 1; i < r_arg_max; i++) {
+ MR_saved_reg_assign(saved_regs, i, r_args[i]);
+ }
+ for (i = 1; i < f_arg_max; i++) {
+ MR_saved_reg_assign(saved_f_regs, i, MR_word_to_float(f_args[i]));
}
if (io_actions_were_performed && found_io_action_counter) {
MR_io_tabling_counter = saved_io_action_counter;
}
- event_info->MR_max_mr_num = MR_max(event_info->MR_max_mr_num, arg_max);
+ event_info->MR_max_mr_num = MR_max(event_info->MR_max_mr_num, r_arg_max);
+ event_info->MR_max_f_num = MR_max(event_info->MR_max_f_num, f_arg_max);
*jumpaddr = level_layout->MR_sle_code_addr;
#ifdef MR_DEBUG_RETRY
printf("jumpaddr is ");
@@ -1096,8 +1128,11 @@ MR_trace_retry(MR_EventInfo *event_info,
printf("\n");
#endif
- if (args != NULL) {
- MR_free(args);
+ if (r_args != NULL) {
+ MR_free(r_args);
+ }
+ if (f_args != NULL) {
+ MR_free(f_args);
}
MR_reset_call_table_array();
@@ -1107,8 +1142,11 @@ MR_trace_retry(MR_EventInfo *event_info,
return MR_RETRY_OK_DIRECT;
report_problem:
- if (args != NULL) {
- MR_free(args);
+ if (r_args != NULL) {
+ MR_free(r_args);
+ }
+ if (f_args != NULL) {
+ MR_free(f_args);
}
MR_abandon_call_table_array();
@@ -1376,7 +1414,7 @@ MR_undo_updates_of_maxfr(const MR_ProcLayout *level_layout,
static MR_Word
MR_trace_find_input_arg(const MR_LabelLayout *label_layout,
MR_Word *saved_regs, MR_Word *base_sp, MR_Word *base_curfr,
- MR_uint_least16_t var_num, MR_bool *succeeded)
+ MR_Float *saved_f_regs, MR_uint_least16_t var_num, MR_bool *succeeded)
{
int i;
int all_var_count;
@@ -1396,7 +1434,8 @@ MR_trace_find_input_arg(const MR_LabelLayout *label_layout,
long_locn = MR_long_desc_var_locn(label_layout, i);
return MR_lookup_long_lval_base(long_locn,
- saved_regs, base_sp, base_curfr, succeeded);
+ saved_regs, base_sp, base_curfr, saved_f_regs,
+ succeeded);
} else {
MR_ShortLval short_locn;
diff --git a/trace/mercury_trace.h b/trace/mercury_trace.h
index 11556d7..c2c7cc7 100644
--- a/trace/mercury_trace.h
+++ b/trace/mercury_trace.h
@@ -48,6 +48,8 @@ typedef struct MR_EventInfo_Struct {
const char *MR_event_path;
MR_Word MR_saved_regs[MR_MAX_FAKE_REG];
int MR_max_mr_num;
+ MR_Float MR_saved_f_regs[MR_MAX_VIRTUAL_F_REG];
+ int MR_max_f_num;
} MR_EventInfo;
/*
diff --git a/trace/mercury_trace_declarative.c b/trace/mercury_trace_declarative.c
index 11f992c..69c6138 100644
--- a/trace/mercury_trace_declarative.c
+++ b/trace/mercury_trace_declarative.c
@@ -403,7 +403,8 @@ static MR_bool MR_trace_same_construct(const char *p1,
static MR_bool MR_trace_single_component(const char *path);
static MR_Word MR_decl_make_atom_args(
const MR_LabelLayout *layout,
- MR_Word *saved_regs, MR_TracePort port);
+ MR_Word *saved_regs, MR_Float *saved_f_regs,
+ MR_TracePort port);
static MR_Word MR_decl_atom_args(const MR_LabelLayout *layout,
MR_Word *saved_regs);
static const char *MR_trace_start_collecting(MR_Unsigned event,
@@ -890,7 +891,7 @@ MR_trace_decl_call(MR_EventInfo *event_info, MR_TraceNode prev)
event_label_layout = event_info->MR_event_sll;
event_proc_layout = event_label_layout->MR_sll_entry;
atom_args = MR_decl_make_atom_args(event_label_layout,
- event_info->MR_saved_regs, MR_PORT_CALL);
+ event_info->MR_saved_regs, event_info->MR_saved_f_regs, MR_PORT_CALL);
base_sp = MR_saved_sp(event_info->MR_saved_regs);
base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
result = MR_stack_walk_step(event_proc_layout, &return_label_layout,
@@ -930,7 +931,7 @@ MR_trace_decl_exit(MR_EventInfo *event_info, MR_TraceNode prev)
MR_Word atom_args;
atom_args = MR_decl_make_atom_args(event_info->MR_event_sll,
- event_info->MR_saved_regs, MR_PORT_EXIT);
+ event_info->MR_saved_regs, event_info->MR_saved_f_regs, MR_PORT_EXIT);
call = MR_trace_matching_call(prev);
MR_decl_checkpoint_match(call);
@@ -1403,7 +1404,7 @@ MR_trace_single_component(const char *path)
static MR_Word
MR_decl_make_atom_args(const MR_LabelLayout *layout, MR_Word *saved_regs,
- MR_TracePort port)
+ MR_Float *saved_f_regs, MR_TracePort port)
{
MR_PredFunc pred_or_func;
int arity;
@@ -1414,7 +1415,7 @@ MR_decl_make_atom_args(const MR_LabelLayout *layout, MR_Word *saved_regs,
const MR_ProcLayout *entry;
entry = layout->MR_sll_entry;
- MR_trace_init_point_vars(layout, saved_regs, port, MR_TRUE);
+ MR_trace_init_point_vars(layout, saved_regs, saved_f_regs, port, MR_TRUE);
MR_proc_id_arity_addedargs_predfunc(entry, &arity, &num_added_args,
&pred_or_func);
diff --git a/trace/mercury_trace_external.c b/trace/mercury_trace_external.c
index ae75f0a..5115272 100644
--- a/trace/mercury_trace_external.c
+++ b/trace/mercury_trace_external.c
@@ -535,7 +535,8 @@ MR_trace_event_external(MR_TraceCmdInfo *cmd, MR_EventInfo *event_info)
MR_update_trace_func_enabled();
MR_trace_init_point_vars(event_info->MR_event_sll,
- event_info->MR_saved_regs, event_info->MR_trace_port, MR_FALSE);
+ event_info->MR_saved_regs, event_info->MR_saved_f_regs,
+ event_info->MR_trace_port, MR_FALSE);
switch(external_debugger_mode) {
case MR_searching:
diff --git a/trace/mercury_trace_internal.c b/trace/mercury_trace_internal.c
index 5c60e79..607ef70 100644
--- a/trace/mercury_trace_internal.c
+++ b/trace/mercury_trace_internal.c
@@ -238,8 +238,8 @@ MR_trace_event_internal(MR_TraceCmdInfo *cmd, MR_bool interactive,
MR_trace_maybe_sync_source_window(event_info, MR_FALSE);
MR_trace_init_point_vars(event_info->MR_event_sll,
- event_info->MR_saved_regs, event_info->MR_trace_port,
- MR_print_optionals);
+ event_info->MR_saved_regs, event_info->MR_saved_f_regs,
+ event_info->MR_trace_port, MR_print_optionals);
(void) MR_trace_var_print_list(print_list);
@@ -1379,8 +1379,8 @@ MR_trace_event_internal_report(MR_TraceCmdInfo *cmd,
if (print_list != NULL) {
MR_trace_init_point_vars(event_info->MR_event_sll,
- event_info->MR_saved_regs, event_info->MR_trace_port,
- MR_print_optionals);
+ event_info->MR_saved_regs, event_info->MR_saved_f_regs,
+ event_info->MR_trace_port, MR_print_optionals);
MR_scroll_next += MR_trace_var_print_list(print_list);
}
diff --git a/trace/mercury_trace_spy.c b/trace/mercury_trace_spy.c
index 407619c..b0d0468 100644
--- a/trace/mercury_trace_spy.c
+++ b/trace/mercury_trace_spy.c
@@ -529,6 +529,8 @@ MR_spy_cond_is_true(MR_SpyPoint *point, const MR_LabelLayout *label_layout)
{
int max_mr_num;
MR_Word saved_regs[MR_MAX_FAKE_REG];
+ int max_f_num;
+ MR_Float saved_f_regs[MR_MAX_VIRTUAL_F_REG];
MR_VarSpec var_spec;
char *path;
const char *problem;
@@ -562,9 +564,11 @@ MR_spy_cond_is_true(MR_SpyPoint *point, const MR_LabelLayout *label_layout)
retval = MR_TRUE;
MR_compute_max_mr_num(max_mr_num, label_layout);
+ max_f_num = label_layout->MR_sll_entry->MR_sle_max_f_num;
/* This also saves the regs in MR_fake_regs. */
- MR_copy_regs_to_saved_regs(max_mr_num, saved_regs);
- MR_trace_init_point_vars(label_layout, saved_regs,
+ MR_copy_regs_to_saved_regs(max_mr_num, saved_regs,
+ max_f_num, saved_f_regs);
+ MR_trace_init_point_vars(label_layout, saved_regs, saved_f_regs,
(MR_TracePort) label_layout->MR_sll_port, MR_FALSE);
problem = MR_lookup_unambiguous_var_spec(cond->MR_cond_var_spec,
@@ -643,7 +647,8 @@ MR_spy_cond_is_true(MR_SpyPoint *point, const MR_LabelLayout *label_layout)
}
end:
- MR_copy_saved_regs_to_regs(max_mr_num, saved_regs);
+ MR_copy_saved_regs_to_regs(max_mr_num, saved_regs,
+ max_f_num, saved_f_regs);
MR_save_transient_registers();
return retval;
}
diff --git a/trace/mercury_trace_vars.c b/trace/mercury_trace_vars.c
index bd39673..a8c8bb7 100644
--- a/trace/mercury_trace_vars.c
+++ b/trace/mercury_trace_vars.c
@@ -154,6 +154,7 @@ typedef struct {
typedef struct {
const MR_LabelLayout *MR_point_top_layout;
MR_Word *MR_point_top_saved_regs;
+ MR_Float *MR_point_top_saved_f_regs;
MR_TracePort MR_point_top_port;
const char *MR_point_problem;
int MR_point_level;
@@ -332,10 +333,12 @@ MR_trace_type_is_ignored(MR_PseudoTypeInfo pseudo_type_info,
void
MR_trace_init_point_vars(const MR_LabelLayout *top_layout,
- MR_Word *saved_regs, MR_TracePort port, MR_bool print_optionals)
+ MR_Word *saved_regs, MR_Float *saved_f_regs, MR_TracePort port,
+ MR_bool print_optionals)
{
MR_point.MR_point_top_layout = top_layout;
MR_point.MR_point_top_saved_regs = saved_regs;
+ MR_point.MR_point_top_saved_f_regs = saved_f_regs;
MR_point.MR_point_top_port = port;
MR_point.MR_point_level = 0;
MR_point.MR_point_problem = MR_trace_set_level(0, print_optionals);
@@ -385,6 +388,7 @@ MR_trace_set_level_from_layout(const MR_LabelLayout *level_layout,
const MR_UserEvent *user;
MR_UserEventSpec *user_spec;
MR_Word *valid_saved_regs;
+ MR_Float *valid_saved_f_regs;
int var_count;
int attr_count;
int total_count;
@@ -476,8 +480,10 @@ MR_trace_set_level_from_layout(const MR_LabelLayout *level_layout,
&& MR_point.MR_point_top_port != MR_PORT_EXCEPTION)
{
valid_saved_regs = MR_point.MR_point_top_saved_regs;
+ valid_saved_f_regs = MR_point.MR_point_top_saved_f_regs;
} else {
valid_saved_regs = NULL;
+ valid_saved_f_regs = NULL;
}
type_params = MR_materialize_type_params_base(level_layout,
@@ -534,7 +540,8 @@ MR_trace_set_level_from_layout(const MR_LabelLayout *level_layout,
} else {
succeeded = MR_FALSE;
value = MR_lookup_long_lval_base(user->MR_ue_attr_locns[i],
- valid_saved_regs, base_sp, base_curfr, &succeeded);
+ valid_saved_regs, base_sp, base_curfr, valid_saved_f_regs,
+ &succeeded);
if (! succeeded) {
MR_fatal_error("cannot look up value of attribute");
@@ -672,7 +679,8 @@ MR_trace_set_level_from_layout(const MR_LabelLayout *level_layout,
}
if (! MR_get_type_and_value_base(level_layout, i, valid_saved_regs,
- base_sp, base_curfr, type_params, &type_info, &value))
+ base_sp, base_curfr, valid_saved_f_regs, type_params, &type_info,
+ &value))
{
/* This value is not a variable. */
continue;
@@ -2277,6 +2285,8 @@ MR_trace_check_integrity(const MR_LabelLayout *layout, MR_TracePort port)
MR_bool saved_debug_enabled;
int MR_check_max_mr_num;
MR_Word MR_check_saved_regs[MR_MAX_FAKE_REG];
+ int MR_check_max_f_num;
+ MR_Float MR_check_saved_f_regs[MR_MAX_VIRTUAL_F_REG];
static int MR_check_integrity_seq_num = 0;
saved_debug_enabled = MR_debug_enabled;
@@ -2284,10 +2294,13 @@ MR_trace_check_integrity(const MR_LabelLayout *layout, MR_TracePort port)
MR_update_trace_func_enabled();
MR_compute_max_mr_num(MR_check_max_mr_num, layout);
+ MR_check_max_f_num = layout->MR_sll_entry->MR_sle_max_f_num;
MR_restore_transient_registers();
/* This also saves the regs in MR_fake_regs. */
- MR_copy_regs_to_saved_regs(MR_check_max_mr_num, MR_check_saved_regs);
- MR_trace_init_point_vars(layout, MR_check_saved_regs, port, MR_TRUE);
+ MR_copy_regs_to_saved_regs(MR_check_max_mr_num, MR_check_saved_regs,
+ MR_check_max_f_num, MR_check_saved_f_regs);
+ MR_trace_init_point_vars(layout, MR_check_saved_regs,
+ MR_check_saved_f_regs, port, MR_TRUE);
if (MR_point.MR_point_problem != NULL) {
MR_fatal_error(problem);
@@ -2311,7 +2324,8 @@ MR_trace_check_integrity(const MR_LabelLayout *layout, MR_TracePort port)
MR_restore_transient_registers();
MR_saved_global_hp(MR_check_saved_regs) = MR_global_hp;
- MR_copy_saved_regs_to_regs(MR_check_max_mr_num, MR_check_saved_regs);
+ MR_copy_saved_regs_to_regs(MR_check_max_mr_num, MR_check_saved_regs,
+ MR_check_max_f_num, MR_check_saved_f_regs);
MR_trace_report_msg = NULL;
MR_debug_enabled = saved_debug_enabled;
MR_update_trace_func_enabled();
diff --git a/trace/mercury_trace_vars.h b/trace/mercury_trace_vars.h
index fe048a5..7eb0cd5 100644
--- a/trace/mercury_trace_vars.h
+++ b/trace/mercury_trace_vars.h
@@ -99,8 +99,8 @@ extern void MR_print_var_spec(FILE *fp, MR_VarSpec *var_spec);
*/
extern void MR_trace_init_point_vars(const MR_LabelLayout *top_layout,
- MR_Word *saved_regs, MR_TracePort port,
- MR_bool print_optionals);
+ MR_Word *saved_regs, MR_Float *saved_f_regs,
+ MR_TracePort port, MR_bool print_optionals);
extern const char *MR_trace_set_level(int ancestor_level,
MR_bool print_optionals);
extern const char *MR_trace_set_level_from_layout(
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list