[m-rev.] diff: speed up base relations in the tabling benchmarks
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Sep 5 17:28:46 AEST 2005
Generate better code for base relations such as the ones in the transitive
closure benchmarkings in the paper on minimal model tabling. These improvements
yield speedups ranging from 5 to 25% on those benchmarks.
compiler/use_local_vars.m:
Make this optimization operate on extended basic blocks instead of
plain basic blocks. The greater length of extended basic blocks
allows the local variables to have maximum scope possible. The price
is that the test for whether assignment to a given lvalue can be
avoided or not is now dependent on which of the constituent basic
blocks of extended basic block contains the assignment, and thus the
test has to be evaluate once for each assignment we try to optimize
instead of once per block.
Don't allocate temporary variables if the optimization they are
intended for turns out not to be allowed. This change avoids having
declarations for unused temporary variables in the resulting C code.
If --auto-comments is set, insert use_local_vars.m's main data
structure, the livemap, into the generated LLDS code as a comment.
compiler/peephole.m:
Look for the pattern
mkframe(Size, Redoip)
<straight line instructions that don't use stack slots>
succeed
and optimize away the mkframe. This pattern always arises for
procedures that are actually semidet but are declared nondet (such
as the base relations in the tabling benchmarks), and may also arise
for semidet branches of nondet procedures.
compiler/llds.m:
Allow an existing peephole pattern to work better. The pattern is
mkframe(Seize, do_fail)
<straight line instructions>
redoip(curfr) = Redoip
Previously, if some compiler-generated C code was among the straight
line instructions, the pattern couldn't be applied, since peephole.m
couldn't know whether it branched away through the redoip slot of the
frame. This diff adds an extra slot to the relevant pragma_c component
that tells peephole.m (actually, the predicate in opt_util.m that
peephole relies on) whether this is the case.
compiler/basic_block.m:
Provide functionality for merging basic blocks into extended basic
blocks.
compiler/dupelim.m:
Conform to the change in basic_block.m's interface.
Convert to four-space indentation, and fix departures from our style
guidelines.
compiler/opt_util.m:
Provide extra information now needed by use_local_vars.
Convert to four-space indentation, and fix departures from our style
guidelines.
compiler/opt_debug.m:
Show the user friendly versions of label names when dumping livemaps
and instructions.
Shorten the dumped descriptions of registers and stack slots.
Dump instructions inside blocks.
compiler/frameopt.m:
Conform to the changes in opt_util and opt_debug's interfaces.
compiler/optimize.m:
Use the facilities of opt_debug instead of llds_out when dumping the
LLDS after each optimization, since these are now more compact and
thus reader friendly.
Print unmangled names when writing progress messages.
Put the dump files we generate with --opt-debug in a separate
subdirectory, since when compiling e.g. tree234.m, the process
can generate more than a thousand files. Give the dump files
minimally mangled names.
compiler/code_gen.m:
compiler/pragma_c_gen.m:
Convert to four-space indentation, and fix departures from our style
guidelines.
Conform to the change in llds.m.
compiler/code_info.m:
compiler/exprn_aux.m:
compiler/ite_gen.m:
compiler/jumpopt.m:
compiler/livemap.m:
compiler/llds_out.m:
compiler/middle_rec.m:
compiler/trace.m:
Conform to the change in llds.m.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/basic_block.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/basic_block.m,v
retrieving revision 1.21
diff -u -b -r1.21 basic_block.m
--- compiler/basic_block.m 25 Aug 2005 03:19:46 -0000 1.21
+++ compiler/basic_block.m 3 Sep 2005 08:23:34 -0000
@@ -26,6 +26,7 @@
:- import_module counter.
:- import_module list.
:- import_module map.
+:- import_module set.
:- import_module std_util.
:- type block_map == map(label, block_info).
@@ -55,10 +56,40 @@
% (if there is one).
).
+ % create_basic_blocks(ProcInstrs, Comments, ProcLabel, !C, NewLabels,
+ % LabelSeq, BlockMap):
+ %
+ % Given ProcInstrs, the instruction sequence of the procedure given by
+ % ProcLabel and whose label counter is currently !.C, create_basic_blocks
+ % will divide up ProcInstrs into a sequence of basic blocks, each
+ % identified by a label. The info on each basic block is returned in
+ % BlockMap, and the sequence of basic blocks is returned in LabelSeq.
+ % In the process, create_basic_blocks creates new labels for basic blocks
+ % that can be reached only by falling through. The set of these new labels
+ % is returned in NewLabels. Any initial comments are returned in Comments.
+ %
:- pred create_basic_blocks(list(instruction)::in, list(instruction)::out,
proc_label::in, counter::in, counter::out,
- list(label)::out, block_map::out) is det.
+ set(label)::out, list(label)::out, block_map::out) is det.
+ % extend_basic_blocks(!LabelSeq, !BlockMap, NewLabels):
+ %
+ % Given !.LabelSeq, a sequence of labels each referring to a basic block in
+ % !.BlockMap, and the set of labels NewLabels that are not the targets of
+ % gotos (e.g. because they were freshly created by create_basic_blocks),
+ % delete from !.LabelSeq each label in NewLabels, merging its basic block
+ % with the immediately previous basic block. As a result, in block in
+ % !:BlockMap is an extended basic block.
+ %
+:- pred extend_basic_blocks(list(label)::in, list(label)::out,
+ block_map::in, block_map::out, set(label)::in) is det.
+
+ % flatten_basic_blocks(LabelSeq, BlockMap, Instrs):
+ %
+ % Given LabelSeq, a sequence of labels each referring to a block in
+ % BlockMap, return the concatenation of the basic blocks referred to by
+ % the labels in LabelSeq.
+ %
:- pred flatten_basic_blocks(list(label)::in, block_map::in,
list(instruction)::out) is det.
@@ -70,11 +101,15 @@
:- import_module int.
:- import_module require.
+:- import_module svmap.
+:- import_module svset.
-create_basic_blocks(Instrs0, Comments, ProcLabel, !C, LabelSeq, BlockMap) :-
+create_basic_blocks(Instrs0, Comments, ProcLabel, !C, NewLabels, LabelSeq,
+ BlockMap) :-
opt_util__get_prologue(Instrs0, LabelInstr, Comments, AfterLabelInstrs),
Instrs1 = [LabelInstr | AfterLabelInstrs],
- build_block_map(Instrs1, LabelSeq, ProcLabel, no, map__init, BlockMap, !C).
+ build_block_map(Instrs1, LabelSeq, ProcLabel, no, map__init, BlockMap,
+ set__init, NewLabels, !C).
%-----------------------------------------------------------------------------%
@@ -83,11 +118,11 @@
%
:- pred build_block_map(list(instruction)::in, list(label)::out,
proc_label::in, bool::in, block_map::in, block_map::out,
- counter::in, counter::out) is det.
+ set(label)::in, set(label)::out, counter::in, counter::out) is det.
-build_block_map([], [], _, _, !BlockMap, !C).
+build_block_map([], [], _, _, !BlockMap, !NewLabels, !C).
build_block_map([OrigInstr0 | OrigInstrs0], LabelSeq, ProcLabel, FallInto,
- !BlockMap, !C) :-
+ !BlockMap, !NewLabels, !C) :-
( OrigInstr0 = label(OrigLabel) - _ ->
Label = OrigLabel,
LabelInstr = OrigInstr0,
@@ -95,16 +130,17 @@
;
counter__allocate(N, !C),
Label = internal(N, ProcLabel),
+ svset__insert(Label, !NewLabels),
LabelInstr = label(Label) - "",
RestInstrs = [OrigInstr0 | OrigInstrs0]
),
(
take_until_end_of_block(RestInstrs, BlockInstrs, Instrs1),
build_block_map(Instrs1, LabelSeq1, ProcLabel, NextFallInto, !BlockMap,
- !C),
+ !NewLabels, !C),
( list__last(BlockInstrs, LastInstr) ->
LastInstr = LastUinstr - _,
- opt_util__possible_targets(LastUinstr, SideLabels),
+ opt_util__possible_targets(LastUinstr, SideLabels, _SideCodeAddrs),
opt_util__can_instr_fall_through(LastUinstr, NextFallInto)
;
SideLabels = [],
@@ -151,6 +187,40 @@
MaybeFallThrough = yes(NextLabel)
;
MaybeFallThrough = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+extend_basic_blocks([], [], !BlockMap, _NewLabels).
+extend_basic_blocks([Label | Labels], LabelSeq, !BlockMap, NewLabels) :-
+ (
+ Labels = [NextLabel | RestLabels],
+ set__member(NextLabel, NewLabels)
+ ->
+ map__lookup(!.BlockMap, Label, BlockInfo),
+ map__lookup(!.BlockMap, NextLabel, NextBlockInfo),
+ BlockInfo = block_info(BlockLabel, BlockLabelInstr, BlockInstrs,
+ BlockFallInto, BlockSideLabels, BlockMaybeFallThrough),
+ NextBlockInfo = block_info(NextBlockLabel, _, NextBlockInstrs,
+ NextBlockFallInto, NextBlockSideLabels, NextBlockMaybeFallThrough),
+ require(unify(BlockLabel, Label),
+ "extend_basic_blocks: block label mismatch"),
+ require(unify(NextBlockLabel, NextLabel),
+ "extend_basic_blocks: next block label mismatch"),
+ require(unify(BlockMaybeFallThrough, yes(NextLabel)),
+ "extend_basic_blocks: fall through mismatch"),
+ require(unify(NextBlockFallInto, yes),
+ "extend_basic_blocks: fall into mismatch"),
+ NewBlockInfo = block_info(BlockLabel, BlockLabelInstr,
+ BlockInstrs ++ NextBlockInstrs, BlockFallInto,
+ BlockSideLabels ++ NextBlockSideLabels, NextBlockMaybeFallThrough),
+ svmap__det_update(Label, NewBlockInfo, !BlockMap),
+ svmap__delete(NextLabel, !BlockMap),
+ extend_basic_blocks([Label | RestLabels], LabelSeq, !BlockMap,
+ NewLabels)
+ ;
+ extend_basic_blocks(Labels, LabelSeqTail, !BlockMap, NewLabels),
+ LabelSeq = [Label | LabelSeqTail]
).
%-----------------------------------------------------------------------------%
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.138
diff -u -b -r1.138 code_gen.m
--- compiler/code_gen.m 1 Apr 2005 02:09:35 -0000 1.138
+++ compiler/code_gen.m 3 Sep 2005 13:12:01 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1994-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -42,26 +44,25 @@
:- import_module list.
% Translate a HLDS module to LLDS.
-
+ %
:- pred generate_code(module_info::in, global_data::in, global_data::out,
list(c_procedure)::out, io::di, io::uo) is det.
- % Translate a HLDS procedure to LLDS, threading through
- % the data structure that records information about layout
- % structures.
-
+ % Translate a HLDS procedure to LLDS, threading through the data structure
+ % that records information about layout structures.
+ %
:- pred generate_proc_code(pred_info::in, proc_info::in,
proc_id::in, pred_id::in, module_info::in,
global_data::in, global_data::out, c_procedure::out) is det.
% Translate a HLDS goal to LLDS.
-
+ %
:- pred code_gen__generate_goal(code_model::in, hlds_goal::in, code_tree::out,
code_info::in, code_info::out) is det.
% Return the message that identifies the procedure to pass to
% the incr_sp_push_msg macro in the generated C code.
-
+ %
:- func code_gen__push_msg(module_info, pred_id, proc_id) = string.
%---------------------------------------------------------------------------%
@@ -70,6 +71,7 @@
:- implementation.
% Parse tree modules
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
@@ -128,19 +130,17 @@
%---------------------------------------------------------------------------%
generate_code(ModuleInfo0, !GlobalData, Procedures, !IO) :-
- % get a list of all the predicate ids
- % for which we are going to generate code.
+ % Get a list of all the predicate ids for which we will generate code.
module_info_predids(ModuleInfo0, PredIds),
- % now generate the code for each predicate
+ % Now generate the code for each predicate.
generate_pred_list_code(ModuleInfo0, !GlobalData, PredIds,
Procedures, !IO).
% Translate a list of HLDS predicates to LLDS.
-
+ %
:- pred generate_pred_list_code(module_info::in,
global_data::in, global_data::out,
- list(pred_id)::in, list(c_procedure)::out,
- io::di, io::uo) is det.
+ list(pred_id)::in, list(c_procedure)::out, io::di, io::uo) is det.
generate_pred_list_code(_ModuleInfo, !GlobalData, [], [], !IO).
generate_pred_list_code(ModuleInfo, !GlobalData, [PredId | PredIds],
@@ -158,13 +158,10 @@
% Note that some of the logic of generate_maybe_pred_code is duplicated
% by mercury_compile__backend_pass_by_preds, so modifications here may
% also need to be repeated there.
-
+ %
generate_maybe_pred_code(ModuleInfo, !GlobalData, PredId, Predicates, !IO) :-
module_info_preds(ModuleInfo, PredInfos),
- % get the pred_info structure for this predicate
map__lookup(PredInfos, PredId, PredInfo),
- % extract a list of all the procedure ids for this
- % predicate and generate code for them
ProcIds = pred_info_non_imported_procids(PredInfo),
(
( ProcIds = []
@@ -174,15 +171,13 @@
Predicates = []
;
module_info_globals(ModuleInfo, Globals),
- globals__lookup_bool_option(Globals, very_verbose,
- VeryVerbose),
+ globals__lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = yes,
io__write_string("% Generating code for ", !IO),
hlds_out__write_pred_id(ModuleInfo, PredId, !IO),
io__write_string("\n", !IO),
- globals__lookup_bool_option(Globals, statistics,
- Statistics),
+ globals__lookup_bool_option(Globals, statistics, Statistics),
maybe_report_stats(Statistics, !IO)
;
VeryVerbose = no
@@ -192,7 +187,7 @@
).
% Translate a HLDS predicate to LLDS.
-
+ %
:- pred generate_pred_code(module_info::in, global_data::in, global_data::out,
pred_id::in, pred_info::in, list(proc_id)::in, list(c_procedure)::out)
is det.
@@ -202,7 +197,7 @@
!GlobalData, [], Code).
% Translate all the procedures of a HLDS predicate to LLDS.
-
+ %
:- pred generate_proc_list_code(list(proc_id)::in, pred_id::in, pred_info::in,
module_info::in, global_data::in, global_data::out,
list(c_procedure)::in, list(c_procedure)::out) is det.
@@ -240,7 +235,6 @@
generate_proc_code(PredInfo, ProcInfo0, ProcId, PredId, ModuleInfo0,
!GlobalData, Proc) :-
-
% The modified module_info and proc_info are both discarded
% on return from generate_proc_code.
maybe_set_trace_level(PredInfo, ModuleInfo0, ModuleInfo),
@@ -263,13 +257,11 @@
BasicStackLayout, ForceProcId),
SaveSuccip = BasicStackLayout,
- % Initialise the code_info structure. Generate_category_code
- % below will use the returned OutsideResumePoint as the
- % entry to the code that handles the failure of the procedure,
- % if such code is needed. It is never needed for model_det
- % procedures, always needed for model_semi procedures, and
- % needed for model_non procedures only if we are doing
- % execution tracing.
+ % Initialise the code_info structure. Generate_category_code below will use
+ % the returned OutsideResumePoint as the entry to the code that handles
+ % the failure of the procedure, if such code is needed. It is never needed
+ % for model_det procedures, always needed for model_semi procedures, and
+ % needed for model_non procedures only if we are doing execution tracing.
global_data_get_static_cell_info(!.GlobalData, StaticCellInfo0),
code_info__init(SaveSuccip, Globals, PredId, ProcId, PredInfo,
ProcInfo, FollowVars, ModuleInfo, StaticCellInfo0,
@@ -286,20 +278,17 @@
globals__get_trace_level(Globals, TraceLevel),
code_info__get_created_temp_frame(CodeInfo, CreatedTempFrame),
- EffTraceIsNone = eff_trace_level_is_none(PredInfo, ProcInfo,
- TraceLevel),
+ EffTraceIsNone = eff_trace_level_is_none(PredInfo, ProcInfo, TraceLevel),
(
EffTraceIsNone = no,
CreatedTempFrame = yes,
CodeModel \= model_non
->
- % If tracing is enabled, the procedure lives on
- % the det stack and the code created any temporary
- % nondet stack frames, then we must have reserved a
- % stack slot for storing the value of maxfr; if we
- % didn't, a retry command in the debugger from a point
- % in the middle of this procedure will do the wrong
- % thing.
+ % If tracing is enabled, the procedure lives on the det stack and the
+ % code created any temporary nondet stack frames, then we must have
+ % reserved a stack slot for storing the value of maxfr; if we didn't,
+ % a retry command in the debugger from a point in the middle of this
+ % procedure will do the wrong thing.
proc_info_get_need_maxfr_slot(ProcInfo, HaveMaxfrSlot),
require(unify(HaveMaxfrSlot, yes),
"should have reserved a slot for maxfr, but didn't")
@@ -315,10 +304,9 @@
FrameInfo = frame(TotalSlots, MaybeSuccipSlot, _),
(
MaybeSuccipSlot = yes(SuccipSlot),
- % The set of recorded live values at calls (for value
- % numbering) and returns (for accurate gc and execution
- % tracing) do not yet record the stack slot holding the
- % succip, so add it to those sets.
+ % The set of recorded live values at calls (for value numbering)
+ % and returns (for accurate gc and execution tracing) do not yet record
+ % the stack slot holding the succip, so add it to those sets.
code_gen__add_saved_succip(Instructions0,
SuccipSlot, Instructions)
;
@@ -366,8 +354,7 @@
MaybeHLDSDeepInfo = no,
MaybeDeepProfInfo = no
),
- EffTraceLevel = eff_trace_level(PredInfo, ProcInfo,
- TraceLevel),
+ EffTraceLevel = eff_trace_level(PredInfo, ProcInfo, TraceLevel),
ProcLayout = proc_layout_info(RttiProcLabel, EntryLabel,
Detism, TotalSlots, MaybeSuccipSlot, EvalMethod,
EffTraceLevel, MaybeTraceCallLabel, MaxTraceReg,
@@ -375,8 +362,8 @@
TraceSlotInfo, ForceProcId, VarSet, VarTypes,
InternalMap, MaybeTableInfo, NeedsAllNames,
MaybeDeepProfInfo),
- global_data_add_new_proc_layout(proc(PredId, ProcId),
- ProcLayout, !GlobalData)
+ global_data_add_new_proc_layout(proc(PredId, ProcId), ProcLayout,
+ !GlobalData)
;
true
),
@@ -401,9 +388,9 @@
globals__lookup_bool_option(Globals, generate_bytecode, GenBytecode),
(
- % XXX: There is a mass of calls above that the bytecode
- % doesn't need; work out which is and isn't needed and put
- % inside the else case below
+ % XXX: There is a mass of calls above that the bytecode doesn't need;
+ % work out which is and isn't needed and put % inside the else case
+ % below.
GenBytecode = yes,
% We don't generate bytecode for unify and compare preds.
% The automatically generated unify and compare predicates
@@ -418,12 +405,10 @@
code_gen__bytecode_stub(ModuleInfo, PredId, ProcId,
BytecodeInstructions),
Proc = c_procedure(Name, Arity, proc(PredId, ProcId),
- BytecodeInstructions, ProcLabel, EmptyLabelCounter,
- MayAlterRtti)
+ BytecodeInstructions, ProcLabel, EmptyLabelCounter, MayAlterRtti)
;
Proc = c_procedure(Name, Arity, proc(PredId, ProcId),
- Instructions, ProcLabel, LabelCounter,
- MayAlterRtti)
+ Instructions, ProcLabel, LabelCounter, MayAlterRtti)
).
:- pred maybe_set_trace_level(pred_info::in,
@@ -437,11 +422,10 @@
PredArity = pred_info_orig_arity(PredInfo),
no_type_info_builtin(PredModule, PredName, PredArity)
->
- % These predicates should never be traced,
- % since they do not obey typeinfo_liveness.
- % Since they may be opt_imported into other
- % modules, we must switch off the tracing
- % of such preds on a pred-by-pred basis.
+ % These predicates should never be traced, since they do not obey
+ % typeinfo_liveness. Since they may be opt_imported into other
+ % modules, we must switch off the tracing of such preds on a
+ % pred-by-pred basis.
globals__set_trace_level_none(Globals0, Globals1),
module_info_set_globals(Globals1, !ModuleInfo)
;
@@ -464,8 +448,8 @@
MaybeHLDSDeepLayout = yes(HLDSDeepLayout)
;
MaybeHLDSDeepLayout = no,
- error("generate_deep_prof_info: " ++
- "no HLDS deep profiling layout info")
+ unexpected(this_file,
+ "generate_deep_prof_info: no HLDS deep profiling layout info")
),
HLDSDeepLayout = hlds_deep_layout(HLDSProcStatic, HLDSExcpVars),
HLDSExcpVars = hlds_deep_excp_vars(TopCSDVar, MiddleCSDVar,
@@ -477,8 +461,7 @@
MiddleCSDSlotNum = stack_slot_num(MiddleCSDSlot),
(
MaybeOldOutermostVar = yes(OldOutermostVar),
- map__lookup(StackSlots, OldOutermostVar,
- OldOutermostSlot),
+ map__lookup(StackSlots, OldOutermostVar, OldOutermostSlot),
OldOutermostSlotNum = stack_slot_num(OldOutermostSlot)
;
MaybeOldOutermostVar = no,
@@ -500,14 +483,12 @@
maybe_add_tabling_pointer_var(ModuleInfo, PredId, ProcId, ProcInfo, ProcLabel,
!GlobalData) :-
proc_info_eval_method(ProcInfo, EvalMethod),
- HasTablingPointer =
- eval_method_has_per_proc_tabling_pointer(EvalMethod),
+ HasTablingPointer = eval_method_has_per_proc_tabling_pointer(EvalMethod),
(
HasTablingPointer = yes,
module_info_name(ModuleInfo, ModuleName),
Var = tabling_pointer_var(ModuleName, ProcLabel),
- global_data_add_new_proc_var(proc(PredId, ProcId), Var,
- !GlobalData)
+ global_data_add_new_proc_var(proc(PredId, ProcId), Var, !GlobalData)
;
HasTablingPointer = no
).
@@ -560,12 +541,11 @@
:- pred generate_category_code(code_model::in, hlds_goal::in,
resume_point_info::in, trace_slot_info::in, code_tree::out,
- maybe(label)::out, frame_info::out, code_info::in, code_info::out)
- is det.
+ maybe(label)::out, frame_info::out, code_info::in, code_info::out) is det.
generate_category_code(model_det, Goal, ResumePoint, TraceSlotInfo, Code,
MaybeTraceCallLabel, FrameInfo, !CI) :-
- % generate the code for the body of the clause
+ % Generate the code for the body of the procedure.
(
code_info__get_globals(!.CI, Globals),
globals__lookup_bool_option(Globals, middle_rec, yes),
@@ -584,12 +564,12 @@
BodyContext, MaybeCallExternalInfo, !CI),
(
MaybeCallExternalInfo = yes(CallExternalInfo),
- CallExternalInfo = external_event_info(
- TraceCallLabel, _, TraceCallCode)
+ CallExternalInfo = external_event_info(TraceCallLabel, _,
+ TraceCallCode)
;
MaybeCallExternalInfo = no,
- error("generate_category_code: " ++
- "call events suppressed")
+ unexpected(this_file,
+ "generate_category_code: call events suppressed")
),
MaybeTraceCallLabel = yes(TraceCallLabel)
;
@@ -602,8 +582,7 @@
FrameInfo, EntryCode),
code_gen__generate_exit(model_det, FrameInfo, TraceSlotInfo,
BodyContext, _, ExitCode, !CI),
- Code = tree_list([EntryCode, TraceCallCode, BodyCode,
- ExitCode])
+ Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode])
).
generate_category_code(model_semi, Goal, ResumePoint, TraceSlotInfo, Code,
@@ -617,16 +596,18 @@
Goal = _ - GoalInfo,
goal_info_get_context(GoalInfo, BodyContext),
code_info__get_maybe_trace_info(!.CI, MaybeTraceInfo),
- ( MaybeTraceInfo = yes(TraceInfo) ->
- trace__generate_external_event_code(call, TraceInfo,
- BodyContext, MaybeCallExternalInfo, !CI),
+ (
+ MaybeTraceInfo = yes(TraceInfo),
+ trace__generate_external_event_code(call, TraceInfo, BodyContext,
+ MaybeCallExternalInfo, !CI),
(
MaybeCallExternalInfo = yes(CallExternalInfo),
- CallExternalInfo = external_event_info(
- TraceCallLabel, _, TraceCallCode)
+ CallExternalInfo = external_event_info(TraceCallLabel, _,
+ TraceCallCode)
;
MaybeCallExternalInfo = no,
- error("generate_category_code: call events suppressed")
+ unexpected(this_file,
+ "generate_category_code: call events suppressed")
),
MaybeTraceCallLabel = yes(TraceCallLabel),
code_gen__generate_goal(model_semi, Goal, BodyCode, !CI),
@@ -641,20 +622,19 @@
code_info__set_forward_live_vars(ResumeVars, !CI),
% XXX A context that gives the end of the procedure
% definition would be better than BodyContext.
- trace__generate_external_event_code(fail, TraceInfo,
- BodyContext, MaybeFailExternalInfo, !CI),
+ trace__generate_external_event_code(fail, TraceInfo, BodyContext,
+ MaybeFailExternalInfo, !CI),
(
MaybeFailExternalInfo = yes(FailExternalInfo),
- FailExternalInfo = external_event_info(
- _, _, TraceFailCode)
+ FailExternalInfo = external_event_info(_, _, TraceFailCode)
;
MaybeFailExternalInfo = no,
TraceFailCode = empty
),
- Code = tree_list([EntryCode, TraceCallCode, BodyCode,
- ExitCode, ResumeCode, TraceFailCode,
- RestoreDeallocCode, FailCode])
+ Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode,
+ ResumeCode, TraceFailCode, RestoreDeallocCode, FailCode])
;
+ MaybeTraceInfo = no,
MaybeTraceCallLabel = no,
code_gen__generate_goal(model_semi, Goal, BodyCode, !CI),
code_gen__generate_entry(!.CI, model_semi, Goal, ResumePoint,
@@ -671,16 +651,18 @@
code_info__get_maybe_trace_info(!.CI, MaybeTraceInfo),
Goal = _ - GoalInfo,
goal_info_get_context(GoalInfo, BodyContext),
- ( MaybeTraceInfo = yes(TraceInfo) ->
- trace__generate_external_event_code(call, TraceInfo,
- BodyContext, MaybeCallExternalInfo, !CI),
+ (
+ MaybeTraceInfo = yes(TraceInfo),
+ trace__generate_external_event_code(call, TraceInfo, BodyContext,
+ MaybeCallExternalInfo, !CI),
(
MaybeCallExternalInfo = yes(CallExternalInfo),
- CallExternalInfo = external_event_info(
- TraceCallLabel, _, TraceCallCode)
+ CallExternalInfo = external_event_info(TraceCallLabel, _,
+ TraceCallCode)
;
MaybeCallExternalInfo = no,
- error("generate_category_code: call events suppressed")
+ unexpected(this_file,
+ "generate_category_code: call events suppressed")
),
MaybeTraceCallLabel = yes(TraceCallLabel),
code_gen__generate_goal(model_non, Goal, BodyCode, !CI),
@@ -695,12 +677,11 @@
code_info__set_forward_live_vars(ResumeVars, !CI),
% XXX A context that gives the end of the procedure
% definition would be better than BodyContext.
- trace__generate_external_event_code(fail, TraceInfo,
- BodyContext, MaybeFailExternalInfo, !CI),
+ trace__generate_external_event_code(fail, TraceInfo, BodyContext,
+ MaybeFailExternalInfo, !CI),
(
MaybeFailExternalInfo = yes(FailExternalInfo),
- FailExternalInfo = external_event_info(
- _, _, TraceFailCode)
+ FailExternalInfo = external_event_info(_, _, TraceFailCode)
;
MaybeFailExternalInfo = no,
TraceFailCode = empty
@@ -709,18 +690,13 @@
MaybeFromFull = TraceSlotInfo ^ slot_from_full,
(
MaybeFromFull = yes(FromFullSlot),
- %
- % Generate code which discards the ticket
- % only if it was allocated, i.e. only if
- % MR_trace_from_full was true on entry.
- %
+ % Generate code which discards the ticket only if it was
+ % allocated, i.e. only if MR_trace_from_full was true on entry.
FromFullSlotLval =
- llds__stack_slot_num_to_lval(
- model_non, FromFullSlot),
+ llds__stack_slot_num_to_lval(model_non, FromFullSlot),
code_info__get_next_label(SkipLabel, !CI),
DiscardTraceTicketCode = node([
- if_val(unop(not,
- lval(FromFullSlotLval)),
+ if_val(unop(not, lval(FromFullSlotLval)),
label(SkipLabel)) - "",
discard_ticket - "discard retry ticket",
label(SkipLabel) - ""
@@ -737,10 +713,10 @@
FailCode = node([
goto(do_fail) - "fail after fail trace port"
]),
- Code = tree_list([EntryCode, TraceCallCode, BodyCode,
- ExitCode, ResumeCode, TraceFailCode,
- DiscardTraceTicketCode, FailCode])
+ Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode,
+ ResumeCode, TraceFailCode, DiscardTraceTicketCode, FailCode])
;
+ MaybeTraceInfo = no,
MaybeTraceCallLabel = no,
code_gen__generate_goal(model_non, Goal, BodyCode, !CI),
code_gen__generate_entry(!.CI, model_non, Goal, ResumePoint,
@@ -787,8 +763,7 @@
code_info__get_pred_id(CI, PredId),
code_info__get_proc_id(CI, ProcId),
code_info__get_module_info(CI, ModuleInfo),
- code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, no,
- Entry),
+ code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, no, Entry),
LabelCode = node([
label(Entry) - "Procedure entry point"
]),
@@ -801,8 +776,7 @@
->
SuccipSlot = MainSlots + 1,
SaveSuccipCode = node([
- assign(stackvar(SuccipSlot), lval(succip)) -
- "Save the success ip"
+ assign(stackvar(SuccipSlot), lval(succip)) - "Save the success ip"
]),
TotalSlots = SuccipSlot,
MaybeSuccipSlot = yes(SuccipSlot)
@@ -833,40 +807,32 @@
PragmaCode = nondet(Fields, FieldsContext,
_, _, _, _, _, _, _)
->
- pragma_c_gen__struct_name(ModuleName, PredName,
- Arity, ProcId, StructName),
- Struct = pragma_c_struct(StructName,
- Fields, FieldsContext),
+ pragma_c_gen__struct_name(ModuleName, PredName, Arity, ProcId,
+ StructName),
+ Struct = pragma_c_struct(StructName, Fields, FieldsContext),
string__format("#define\tMR_ORDINARY_SLOTS\t%d\n",
[i(TotalSlots)], DefineStr),
DefineComponents = [pragma_c_raw_code(DefineStr,
- live_lvals_info(set__init))],
- NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots,
- yes(Struct)),
+ cannot_branch_away, live_lvals_info(set__init))],
+ NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, yes(Struct)),
AllocCode = node([
- mkframe(NondetFrameInfo,
- yes(OutsideResumeAddress))
+ mkframe(NondetFrameInfo, yes(OutsideResumeAddress))
- "Allocate stack frame",
- pragma_c([], DefineComponents,
- will_not_call_mercury, no, no, no, no,
- no, no)
- - ""
+ pragma_c([], DefineComponents, will_not_call_mercury,
+ no, no, no, no, no, no) - ""
]),
NondetPragma = yes
;
- NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots,
- no),
+ NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, no),
AllocCode = node([
- mkframe(NondetFrameInfo,
- yes(OutsideResumeAddress))
+ mkframe(NondetFrameInfo, yes(OutsideResumeAddress))
- "Allocate stack frame"
]),
NondetPragma = no
)
; TotalSlots > 0 ->
AllocCode = node([
- incr_sp(TotalSlots, PushMsg) -
- "Allocate stack frame"
+ incr_sp(TotalSlots, PushMsg) - "Allocate stack frame"
]),
NondetPragma = no
;
@@ -926,12 +892,11 @@
FrameInfo = frame(TotalSlots, MaybeSuccipSlot, NondetPragma),
( NondetPragma = yes ->
UndefStr = "#undef\tMR_ORDINARY_SLOTS\n",
- UndefComponents = [pragma_c_raw_code(UndefStr,
+ UndefComponents = [pragma_c_raw_code(UndefStr, cannot_branch_away,
live_lvals_info(set__init))],
UndefCode = node([
- pragma_c([], UndefComponents,
- will_not_call_mercury, no, no, no, no, no, no)
- - ""
+ pragma_c([], UndefComponents, will_not_call_mercury,
+ no, no, no, no, no, no) - ""
]),
RestoreDeallocCode = empty, % always empty for nondet code
ExitCode = tree_list([StartComment, UndefCode, EndComment])
@@ -939,8 +904,7 @@
code_info__get_instmap(!.CI, Instmap),
ArgModes = code_info__get_arginfo(!.CI),
HeadVars = code_info__get_headvars(!.CI),
- assoc_list__from_corresponding_lists(HeadVars, ArgModes,
- Args),
+ assoc_list__from_corresponding_lists(HeadVars, ArgModes, Args),
( instmap__is_unreachable(Instmap) ->
OutLvals = set__init,
FlushCode = empty
@@ -957,7 +921,11 @@
MaybeSuccipSlot = no,
RestoreSuccipCode = empty
),
- ( ( TotalSlots = 0 ; CodeModel = model_non ) ->
+ (
+ ( TotalSlots = 0
+ ; CodeModel = model_non
+ )
+ ->
DeallocCode = empty
;
DeallocCode = node([
@@ -971,33 +939,26 @@
MaybeFromFull = TraceSlotInfo ^ slot_from_full,
(
MaybeFromFull = yes(FromFullSlot),
+ % Generate code which prunes the ticket only if it was
+ % allocated, i.e. only if MR_trace_from_full was true on entry.
%
- % Generate code which prunes the ticket
- % only if it was allocated, i.e. only if
- % MR_trace_from_full was true on entry.
- %
- % Note that to avoid duplicating label names,
- % we need to generate two different copies
- % of this with different labels; this is
- % needed for semidet code, which will get one
- % copy in the success epilogue and one copy
- % in the failure epilogue
+ % Note that to avoid duplicating label names, we need to
+ % generate two different copies of this with different labels;
+ % this is needed for semidet code, which will get one copy
+ % in the success epilogue and one copy in the failure epilogue.
%
FromFullSlotLval =
- llds__stack_slot_num_to_lval(
- CodeModel, FromFullSlot),
+ llds__stack_slot_num_to_lval(CodeModel, FromFullSlot),
code_info__get_next_label(SkipLabel, !CI),
code_info__get_next_label(SkipLabelCopy, !CI),
PruneTraceTicketCode = node([
- if_val(unop(not,
- lval(FromFullSlotLval)),
+ if_val(unop(not, lval(FromFullSlotLval)),
label(SkipLabel)) - "",
prune_ticket - "prune retry ticket",
label(SkipLabel) - ""
]),
PruneTraceTicketCodeCopy = node([
- if_val(unop(not,
- lval(FromFullSlotLval)),
+ if_val(unop(not, lval(FromFullSlotLval)),
label(SkipLabelCopy)) - "",
prune_ticket - "prune retry ticket",
label(SkipLabelCopy) - ""
@@ -1007,8 +968,7 @@
PruneTraceTicketCode = node([
prune_ticket - "prune retry ticket"
]),
- PruneTraceTicketCodeCopy =
- PruneTraceTicketCode
+ PruneTraceTicketCodeCopy = PruneTraceTicketCode
)
;
PruneTraceTicketCode = empty,
@@ -1023,15 +983,14 @@
code_info__get_maybe_trace_info(!.CI, MaybeTraceInfo),
(
MaybeTraceInfo = yes(TraceInfo),
- % XXX A context that gives the end of the
- % procedure definition would be better than
- % CallContext.
- trace__generate_external_event_code(exit, TraceInfo,
- BodyContext, MaybeExitExternalInfo, !CI),
+ % XXX A context that gives the end of the procedure definition
+ % would be better than CallContext.
+ trace__generate_external_event_code(exit, TraceInfo, BodyContext,
+ MaybeExitExternalInfo, !CI),
(
MaybeExitExternalInfo = yes(ExitExternalInfo),
- ExitExternalInfo = external_event_info(
- _, TypeInfoDatas, TraceExitCode)
+ ExitExternalInfo = external_event_info(_, TypeInfoDatas,
+ TraceExitCode)
;
MaybeExitExternalInfo = no,
TypeInfoDatas = map__init,
@@ -1061,8 +1020,8 @@
livevals(LiveLvals) - "",
goto(succip) - "Return from procedure call"
]),
- AllSuccessCode = tree_list([TraceExitCode,
- RestoreDeallocCodeCopy, SuccessCode])
+ AllSuccessCode = tree_list([TraceExitCode, RestoreDeallocCodeCopy,
+ SuccessCode])
;
CodeModel = model_semi,
set__insert(LiveLvals, reg(r, 1), SuccessLiveRegs),
@@ -1071,22 +1030,20 @@
livevals(SuccessLiveRegs) - "",
goto(succip) - "Return from procedure call"
]),
- AllSuccessCode = tree_list([TraceExitCode,
- RestoreDeallocCodeCopy, SuccessCode])
+ AllSuccessCode = tree_list([TraceExitCode, RestoreDeallocCodeCopy,
+ SuccessCode])
;
CodeModel = model_non,
(
MaybeTraceInfo = yes(TraceInfo2),
- trace__maybe_setup_redo_event(TraceInfo2,
- SetupRedoCode)
+ trace__maybe_setup_redo_event(TraceInfo2, SetupRedoCode)
;
MaybeTraceInfo = no,
SetupRedoCode = empty
),
SuccessCode = node([
livevals(LiveLvals) - "",
- goto(do_succeed(no))
- - "Return from procedure call"
+ goto(do_succeed(no)) - "Return from procedure call"
]),
AllSuccessCode = tree_list([SetupRedoCode,
TraceExitCode, SuccessCode])
@@ -1097,11 +1054,11 @@
%---------------------------------------------------------------------------%
-% Generate a goal. This predicate arranges for the necessary updates of
-% the generic data structures before and after the actual code generation,
-% which is delegated to goal-specific predicates.
-
code_gen__generate_goal(ContextModel, Goal - GoalInfo, Code, !CI) :-
+ % Generate a goal. This predicate arranges for the necessary updates of
+ % the generic data structures before and after the actual code generation,
+ % which is delegated to goal-specific predicates.
+
% Make any changes to liveness before Goal
( goal_is_atomic(Goal) ->
IsAtomic = yes
@@ -1112,9 +1069,8 @@
code_info__get_instmap(!.CI, Instmap),
( instmap__is_reachable(Instmap) ->
goal_info_get_code_model(GoalInfo, CodeModel),
-
- % sanity check: code of some code models
- % should occur only in limited contexts
+ % Sanity check: code of some code models should occur
+ % only in limited contexts.
(
CodeModel = model_det
;
@@ -1132,69 +1088,60 @@
error("nondet model in det/semidet context")
)
),
-
- code_gen__generate_goal_2(Goal, GoalInfo, CodeModel, GoalCode,
- !CI),
+ code_gen__generate_goal_2(Goal, GoalInfo, CodeModel, GoalCode, !CI),
goal_info_get_features(GoalInfo, Features),
code_info__get_proc_info(!.CI, ProcInfo),
- % If the predicate's evaluation method is memo,
- % loopcheck or minimal model, the goal generated
- % the variable that represents the call table tip,
- % *and* tracing is enabled, then we save this variable
- % to its stack slot. This is necessary to enable
- % retries across this procedure to reset the call table
- % entry to uninitialized, effectively removing the
- % call table entry.
+ % If the predicate's evaluation method is memo, loopcheck or minimal
+ % model, the goal generated the variable that represents the call table
+ % tip, *and* tracing is enabled, then we save this variable to its
+ % stack slot. This is necessary to enable retries across this procedure
+ % to reset the call table entry to uninitialized, effectively removing
+ % the call table entry.
%
- % If tracing is not enabled, then CallTableVar isn't
- % guaranteed to have a stack slot.
+ % If tracing is not enabled, then CallTableVar isn't guaranteed
+ % to have a stack slot.
(
set__member(call_table_gen, Features),
code_info__get_proc_info(!.CI, ProcInfo),
- proc_info_get_call_table_tip(ProcInfo,
- MaybeCallTableVar),
+ proc_info_get_call_table_tip(ProcInfo, MaybeCallTableVar),
MaybeCallTableVar = yes(CallTableVar),
code_info__get_maybe_trace_info(!.CI, yes(_))
->
- code_info__save_variables_on_stack([CallTableVar],
- TipSaveCode, !CI),
+ code_info__save_variables_on_stack([CallTableVar], TipSaveCode,
+ !CI),
CodeUptoTip = tree(GoalCode, TipSaveCode)
;
CodeUptoTip = GoalCode
),
- % After the goal that generates the variables needed
- % at the exception port, on which deep_profiling.m puts
- % the save_deep_excp_vars feature, save those variables
- % in their stack slots. The procedure layout structure
- % gives the identity of their slots, and exception.m
+ % After the goal that generates the variables needed at the exception
+ % port, on which deep_profiling.m puts the save_deep_excp_vars feature,
+ % save those variables in their stack slots. The procedure layout
+ % structure gives the identity of their slots, and exception.m
% expects to find the variables in their stack slots.
%
- % These variables are computed by the call port code
- % and are needed by the exit and fail port codes, so
- % their lifetime is the entire procedure invocation.
- % If the procedure makes any calls other than the ones
- % inserted by deep profiling, then all the variables
- % will have stack slots, and we save them all on the
- % stack. If the procedure doesn't make any such calls,
- % then the variables won't have stack slots, but they
- % won't *need* stack slots either, since there is no
- % way for such a leaf procedure to throw an exception.
- % (Throwing requires calling exception__throw, directly
- % or indirectly.)
+ % These variables are computed by the call port code and are needed
+ % by the exit and fail port codes, so their lifetime is the entire
+ % procedure invocation. If the procedure makes any calls other than
+ % the ones inserted by deep profiling, then all the variables will have
+ % stack slots, and we save them all on the stack. If the procedure
+ % doesn't make any such calls, then the variables won't have stack
+ % slots, but they won't *need* stack slots either, since there is no
+ % way for such a leaf procedure to throw an exception. (Throwing
+ % requires calling exception__throw, directly or indirectly.)
(
set__member(save_deep_excp_vars, Features)
->
DeepSaveVars = compute_deep_save_excp_vars(ProcInfo),
- code_info__save_variables_on_stack(DeepSaveVars,
- DeepSaveCode, !CI),
+ code_info__save_variables_on_stack(DeepSaveVars, DeepSaveCode,
+ !CI),
Code = tree(CodeUptoTip, DeepSaveCode)
;
Code = CodeUptoTip
),
- % Make live any variables which subsequent goals
- % will expect to be live, but were not generated
+ % Make live any variables which subsequent goals will expect to be
+ % live, but were not generated.
code_info__set_instmap(Instmap, !CI),
code_info__post_goal_update(GoalInfo, !CI)
;
@@ -1215,12 +1162,11 @@
MaybeOldOutermostVar),
proc_info_stack_slots(ProcInfo, StackSlots),
( map__search(StackSlots, TopCSDVar, _) ->
- % If one of these variables has a stack
- % slot, the others must have one too.
+ % If one of these variables has a stack slot, the others must
+ % have one too.
(
MaybeOldOutermostVar = yes(OldOutermostVar),
- DeepSaveVars = [TopCSDVar, MiddleCSDVar,
- OldOutermostVar]
+ DeepSaveVars = [TopCSDVar, MiddleCSDVar, OldOutermostVar]
;
MaybeOldOutermostVar = no,
DeepSaveVars = [TopCSDVar, MiddleCSDVar]
@@ -1229,7 +1175,8 @@
DeepSaveVars = []
)
;
- error("compute_deep_save_excp_vars: inconsistent proc_info")
+ unexpected(this_file,
+ "compute_deep_save_excp_vars: inconsistent proc_info")
).
%---------------------------------------------------------------------------%
@@ -1250,8 +1197,7 @@
ite_gen__generate_negation(CodeModel, Goal, GoalInfo, Code, !CI).
code_gen__generate_goal_2(if_then_else(_Vars, Cond, Then, Else),
GoalInfo, CodeModel, Code, !CI) :-
- ite_gen__generate_ite(CodeModel, Cond, Then, Else, GoalInfo, Code,
- !CI).
+ ite_gen__generate_ite(CodeModel, Cond, Then, Else, GoalInfo, Code, !CI).
code_gen__generate_goal_2(switch(Var, CanFail, CaseList),
GoalInfo, CodeModel, Code, !CI) :-
switch_gen__generate_switch(CodeModel, Var, CanFail, CaseList,
@@ -1276,22 +1222,21 @@
GoalInfo, CodeModel, Code, !CI) :-
( c = foreign_language(Attributes) ->
pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, Args, ExtraArgs, GoalInfo, PragmaCode,
- Code, !CI)
+ PredId, ProcId, Args, ExtraArgs, GoalInfo, PragmaCode, Code, !CI)
;
- error("code_gen__generate_goal_2: " ++
- "foreign code other than C unexpected")
+ unexpected(this_file,
+ "code_gen__generate_goal_2: foreign code other than C unexpected")
).
code_gen__generate_goal_2(shorthand(_), _, _, _, !CI) :-
- % these should have been expanded out by now
- error("code_gen__generate_goal_2: unexpected shorthand").
+ % These should have been expanded out by now.
+ unexpected(this_file, "code_gen__generate_goal_2: unexpected shorthand").
%---------------------------------------------------------------------------%
-% Generate a conjoined series of goals.
-% Note of course, that with a conjunction, state information
-% flows directly from one conjunct to the next.
-
+ % Generate a conjoined series of goals. Note of course, that with a
+ % conjunction, state information flows directly from one conjunct
+ % to the next.
+ %
:- pred code_gen__generate_goals(hlds_goals::in, code_model::in,
code_tree::out, code_info::in, code_info::out) is det.
@@ -1308,10 +1253,10 @@
%---------------------------------------------------------------------------%
-% Add the succip to the livevals before and after calls.
-% Traverses the list of instructions looking for livevals and calls,
-% adding succip in the stackvar number given as an argument.
-
+ % Add the succip to the livevals before and after calls. Traverses the list
+ % of instructions looking for livevals and calls, adding succip in the
+ % stackvar number given as an argument.
+ %
:- pred code_gen__add_saved_succip(list(instruction)::in, int::in,
list(instruction)::out) is det.
@@ -1348,11 +1293,9 @@
module_info_pred_info(ModuleInfo, PredId, PredInfo),
ModuleSymName = pred_info_module(PredInfo),
- mdbcomp__prim_data__sym_name_to_string(ModuleSymName, "__",
- ModuleName),
+ sym_name_to_string(ModuleSymName, "__", ModuleName),
- code_util__make_local_entry_label(ModuleInfo, PredId,
- ProcId, no, Entry),
+ code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, no, Entry),
PredName = pred_info_name(PredInfo),
proc_id_to_int(ProcId, ProcNum),
@@ -1370,32 +1313,33 @@
"\t\t\t""", PredName, """,\n",
"\t\t\t", ProcStr, ",\n",
"\t\t\t", ArityStr, ",\n",
- "\t\t\t", (PredOrFunc = function -> "MR_TRUE" ; "MR_FALSE"),
- "\n",
+ "\t\t\t", (PredOrFunc = function -> "MR_TRUE" ; "MR_FALSE"), "\n",
"\t\t};\n"
], CallStruct),
append_list([
"\t\tMB_Native_Addr return_addr;\n",
"\t\tMR_save_registers();\n",
- "\t\treturn_addr = MB_bytecode_call_entry(",
- "&",CallStructName,");\n",
+ "\t\treturn_addr = MB_bytecode_call_entry(", "&",CallStructName,");\n",
"\t\tMR_restore_registers();\n",
"\t\tMR_GOTO(return_addr);\n"
], BytecodeCall),
BytecodeInstructionsComponents = [
- pragma_c_raw_code("\t{\n", live_lvals_info(set__init)),
- pragma_c_raw_code(CallStruct, live_lvals_info(set__init)),
- pragma_c_raw_code(BytecodeCall, no_live_lvals_info),
- pragma_c_raw_code("\t}\n", live_lvals_info(set__init))
+ pragma_c_raw_code("\t{\n", cannot_branch_away,
+ live_lvals_info(set__init)),
+ pragma_c_raw_code(CallStruct, cannot_branch_away,
+ live_lvals_info(set__init)),
+ pragma_c_raw_code(BytecodeCall, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code("\t}\n", cannot_branch_away,
+ live_lvals_info(set__init))
],
BytecodeInstructions = [
label(Entry) - "Procedure entry point",
- pragma_c([], BytecodeInstructionsComponents,
- may_call_mercury, no, no, no, no, no, no)
- - "Entry stub"
+ pragma_c([], BytecodeInstructionsComponents, may_call_mercury,
+ no, no, no, no, no, no) - "Entry stub"
].
%---------------------------------------------------------------------------%
@@ -1412,22 +1356,17 @@
( Origin = special_pred(SpecialId - TypeCtor) ->
code_gen__find_arg_type_ctor_name(TypeCtor, TypeName),
special_pred_name_arity(SpecialId, SpecialPredName, _),
- string__append_list([SpecialPredName, "_for_", TypeName],
- FullPredName)
+ FullPredName = SpecialPredName ++ "_for_" ++ TypeName
;
FullPredName = PredName
),
- PredOrFuncString = pred_or_func_to_str(PredOrFunc),
- mdbcomp__prim_data__sym_name_to_string(ModuleName, ModuleNameString),
- string__int_to_string(Arity, ArityStr),
- proc_id_to_int(ProcId, ProcNum),
- string__int_to_string(ProcNum, ProcNumStr),
- % XXX if ModuleNameString ends with [0-9] and/or
- % FullPredName starts with [0-9] then ideally we
- % should use "'.'" rather than just ".".
+ % XXX if ModuleNameString ends with [0-9] and/or FullPredName starts with
+ % [0-9] then ideally we should use "'.'" rather than just ".".
%
- string__append_list([PredOrFuncString, " ", ModuleNameString, ".",
- FullPredName, "/", ArityStr, "-", ProcNumStr], PushMsg).
+ PushMsg = pred_or_func_to_str(PredOrFunc) ++ " " ++
+ sym_name_to_string(ModuleName) ++ "." ++
+ FullPredName ++ "/" ++ int_to_string(Arity) ++ "-" ++
+ int_to_string(proc_id_to_int(ProcId)).
:- pred code_gen__find_arg_type_ctor_name((type_ctor)::in, string::out) is det.
@@ -1436,5 +1375,11 @@
mdbcomp__prim_data__sym_name_to_string(TypeCtorSymName, TypeCtorName),
string__int_to_string(TypeCtorArity, ArityStr),
string__append_list([TypeCtorName, "_", ArityStr], TypeName).
+
+%---------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "code_gen.m".
%---------------------------------------------------------------------------%
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.302
diff -u -b -r1.302 code_info.m
--- compiler/code_info.m 29 Aug 2005 15:44:19 -0000 1.302
+++ compiler/code_info.m 3 Sep 2005 13:05:30 -0000
@@ -1892,13 +1892,13 @@
Components = [
pragma_c_raw_code(
"\t\tMR_save_transient_registers();\n",
- live_lvals_info(set__init)),
+ cannot_branch_away, live_lvals_info(set__init)),
pragma_c_raw_code(
"\t\tMR_commit_mark();\n",
- live_lvals_info(set__init)),
+ cannot_branch_away, live_lvals_info(set__init)),
pragma_c_raw_code(
"\t\tMR_restore_transient_registers();\n",
- live_lvals_info(set__init))
+ cannot_branch_away, live_lvals_info(set__init))
],
MarkCode = node([
pragma_c([], Components, will_not_call_mercury,
@@ -1976,12 +1976,11 @@
% See the comment in prepare_for_semi_commit above.
Components = [
pragma_c_raw_code("\t\tMR_commit_cut();\n",
- live_lvals_info(set__init))
+ cannot_branch_away, live_lvals_info(set__init))
],
CutCode = node([
- pragma_c([], Components, will_not_call_mercury,
- no, no, no, no, no, yes)
- - "commit for temp frame hijack"
+ pragma_c([], Components, will_not_call_mercury, no, no, no,
+ no, no, yes) - "commit for temp frame hijack"
])
;
UseMinimalModel = no,
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.66
diff -u -b -r1.66 dupelim.m
--- compiler/dupelim.m 25 Aug 2005 03:19:46 -0000 1.66
+++ compiler/dupelim.m 2 Sep 2005 15:50:24 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -58,6 +60,7 @@
:- import_module ll_backend__basic_block.
:- import_module ll_backend__opt_util.
+:- import_module parse_tree__error_util.
:- import_module assoc_list.
:- import_module bool.
@@ -79,7 +82,7 @@
:- type cluster ---> cluster(label, list(label)).
dupelim_main(ProcLabel, !C, Instrs0, Instrs) :-
- create_basic_blocks(Instrs0, Comments, ProcLabel, !C,
+ create_basic_blocks(Instrs0, Comments, ProcLabel, !C, _NewLabels,
LabelSeq0, BlockMap0),
map__init(StdMap0),
set__init(Fixed0),
@@ -95,8 +98,8 @@
;
Clusters = [_ | _],
map__init(ReplMap0),
- process_clusters(Clusters, LabelSeq0, LabelSeq,
- BlockMap0, BlockMap, ReplMap0, ReplMap),
+ process_clusters(Clusters, LabelSeq0, LabelSeq, BlockMap0, BlockMap,
+ ReplMap0, ReplMap),
flatten_basic_blocks(LabelSeq, BlockMap, Instrs1),
opt_util__replace_labels_instruction_list(Instrs1,
ReplMap, yes, Instrs2),
@@ -105,10 +108,10 @@
%-----------------------------------------------------------------------------%
-% dupelim__build_maps builds up a map mapping standardized instruction
-% sequences to the label(s) that start basic blocks with that standardized
-% form, and a set showing which labels are fallen into.
-
+ % dupelim__build_maps builds up a map mapping standardized instruction
+ % sequences to the label(s) that start basic blocks with that standardized
+ % form, and a set showing which labels are fallen into.
+ %
:- pred dupelim__build_maps(list(label)::in, block_map::in,
std_map::in, std_map::out, set(label)::in, set(label)::out) is det.
@@ -163,19 +166,19 @@
true
).
-% For each set of labels that start basic blocks with identical standard forms,
-% find_clusters finds out whether we can eliminate some of those blocks;
-% if yes, it decides which blocks can be eliminated and which other block
-% should stand in their place.
-
-% If two or more blocks have the same standardized form, it may be possible
-% to eliminate all but one of the blocks. However, blocks that can be fallen
-% into cannot be eliminated. (Actually, they could, but only by inserting
-% a goto, and full jumpopt would then undo the elimination of the block.)
-% Similarly, blocks whose starting label is referred to by C code cannot
-% be eliminated. (Actually, they could, but only by doing surgery on C code
-% strings, which is not a good idea.)
-
+ % For each set of labels that start basic blocks with identical standard
+ % forms, find_clusters finds out whether we can eliminate some of those
+ % blocks; if yes, it decides which blocks can be eliminated and which
+ % other block should stand in their place.
+ %
+ % If two or more blocks have the same standardized form, it may be possible
+ % to eliminate all but one of the blocks. However, blocks that can be
+ % fallen into cannot be eliminated. (Actually, they could, but only by
+ % inserting a goto, and full jumpopt would then undo the elimination of
+ % the block.) Similarly, blocks whose starting label is referred to by C
+ % code cannot be eliminated. (Actually, they could, but only by doing
+ % surgery on C code strings, which is not a good idea.)
+ %
:- pred find_clusters(list(list(label))::in, set(label)::in,
list(cluster)::in, list(cluster)::out) is det.
@@ -183,14 +186,13 @@
find_clusters([Labels | LabelsList], Fixed, !Clusters) :-
(
Labels = [_, _ | _],
- % The rest of the condition is relatively expensive,
- % so don't do it if there aren't at least two labels
- % whose blocks have the same standardized form.
+ % The rest of the condition is relatively expensive, so don't do it
+ % if there aren't at least two labels whose blocks have the same
+ % standardized form.
IsFallenInto = (pred(Label::in) is semidet :-
set__member(Label, Fixed)
),
- list__filter(IsFallenInto, Labels,
- FixedLabels, NonFixedLabels),
+ list__filter(IsFallenInto, Labels, FixedLabels, NonFixedLabels),
NonFixedLabels = [FirstNonFixed | OtherNonFixed]
->
(
@@ -208,12 +210,12 @@
%-----------------------------------------------------------------------------%
-% For each cluster, a set of blocks in which all but one are to be eliminated
-% favor of the remaining one, find their most specific common generalization
-% (which must exist), and substitute this code for the code of the copy of
-% the block that is to be kept. Remove the eliminated labels from the
-% label sequence and map them to their replacements.
-
+ % For each cluster, a set of blocks in which all but one are to be
+ % eliminated favor of the remaining one, find their most specific common
+ % generalization (which must exist), and substitute this code for the code
+ % of the copy of the block that is to be kept. Remove the eliminated labels
+ % from the label sequence and map them to their replacements.
+ %
:- pred process_clusters(list(cluster)::in, list(label)::in, list(label)::out,
block_map::in, block_map::out,
map(label, label)::in, map(label, label)::out) is det.
@@ -233,16 +235,16 @@
map__det_update(!.BlockMap, Exemplar, ExemplarInfo, !:BlockMap),
process_clusters(Clusters, !LabelSeq, !BlockMap, !ReplMap).
-% Given the current form of a basic block (instructions and fallthrough),
-% compute its most specific generalization with the basic blocks headed
-% by the given labels, whose basic blocks are to be eliminated.
-%
-% On the same traversal of the list of to-be-eliminated labels, remove each
-% such label from the sequence of labels whose basic blocks will make up
-% the final code of the procedure, and add the mapping of the eliminated
-% label to the replacement (exemplar) label to the set of substitutions
-% that will need to be done.
-
+ % Given the current form of a basic block (instructions and fallthrough),
+ % compute its most specific generalization with the basic blocks headed
+ % by the given labels, whose basic blocks are to be eliminated.
+ %
+ % On the same traversal of the list of to-be-eliminated labels, remove each
+ % such label from the sequence of labels whose basic blocks will make up
+ % the final code of the procedure, and add the mapping of the eliminated
+ % label to the replacement (exemplar) label to the set of substitutions
+ % that will need to be done.
+ %
:- pred process_elim_labels(list(label)::in, list(instruction)::in,
list(label)::in, list(label)::out, block_map::in,
label::in, map(label, label)::in, map(label, label)::out,
@@ -257,9 +259,8 @@
_, _, ElimMaybeFallThrough),
require(unify(ElimLabel, ElimLabel2), "elim label mismatch"),
(
- most_specific_block(Instrs0, !.MaybeFallThrough,
- ElimInstrs, ElimMaybeFallThrough,
- Instrs1, !:MaybeFallThrough)
+ most_specific_block(Instrs0, !.MaybeFallThrough, ElimInstrs,
+ ElimMaybeFallThrough, Instrs1, !:MaybeFallThrough)
->
list__delete_all(!.LabelSeq, ElimLabel, !:LabelSeq),
map__det_insert(!.ReplMap, ElimLabel, Exemplar, !:ReplMap),
@@ -274,12 +275,12 @@
% The code of this section is concerned with computing the standard
% form (most general generalization) of a sequence of instructions.
-
+ %
% If a block can fall through, we add a goto to the following label
% at the end. This way, it will match with other blocks that have
% identical (standardized) content except for an explicit goto to our
% fallthrough label.
-
+ %
:- pred standardize_instr_block(list(instruction)::in, maybe(label)::in,
list(instr)::out) is det.
@@ -295,7 +296,7 @@
).
% Compute the standard form of a sequence of instructions.
-
+ %
:- pred standardize_instrs(list(instruction)::in, list(instr)::out) is det.
standardize_instrs([], []).
@@ -309,7 +310,7 @@
).
% Compute the standard form of an instruction.
-
+ %
:- pred standardize_instr(instr::in, instr::out) is det.
standardize_instr(Instr1, Instr) :-
@@ -415,7 +416,7 @@
).
% Compute the standard form of an lval.
-
+ %
:- pred standardize_lval(lval::in, lval::out) is det.
standardize_lval(Lval1, Lval) :-
@@ -473,7 +474,7 @@
).
% Compute the standard form of an rval.
-
+ %
:- pred standardize_rval(rval::in, rval::out) is det.
standardize_rval(Rval1, Rval) :-
@@ -509,12 +510,12 @@
% This predicate computes the most specific code sequence that
% generalizes both input sequences.
-
+ %
% If a block can fall through, we add a goto to the following label
% at the end. This way, it will match with other blocks that have
% identical (standardized) content except for an explicit goto to our
% fallthrough label.
-
+ %
:- pred standardize_block(list(instruction)::in, maybe(label)::in,
list(instruction)::out) is det.
@@ -609,7 +610,7 @@
% This predicate computes the most specific instruction that
% generalizes both input instructions.
-
+ %
:- pred most_specific_instr(instr::in, instr::in, instr::out) is semidet.
most_specific_instr(Instr1, Instr2, Instr) :-
@@ -721,7 +722,7 @@
% This predicate computes the most specific lval that
% generalizes both input lvals.
-
+ %
:- pred most_specific_lval(lval::in, lval::in, lval::out) is semidet.
most_specific_lval(Lval1, Lval2, Lval) :-
@@ -796,12 +797,12 @@
Lval = Lval1
;
Lval1 = lvar(_),
- error("lvar in most_specific_lval")
+ unexpected(this_file, "lvar in most_specific_lval")
).
% This predicate computes the most specific rval that
% generalizes both input rvals.
-
+ %
:- pred most_specific_rval(rval::in, rval::in, rval::out) is semidet.
most_specific_rval(Rval1, Rval2, Rval) :-
@@ -839,4 +840,9 @@
).
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "dupelim.m".
+
%-----------------------------------------------------------------------------%
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.58
diff -u -b -r1.58 exprn_aux.m
--- compiler/exprn_aux.m 29 Aug 2005 15:44:19 -0000 1.58
+++ compiler/exprn_aux.m 3 Sep 2005 13:05:50 -0000
@@ -496,10 +496,10 @@
Component0 = pragma_c_user_code(_, _),
Component = Component0
;
- Component0 = pragma_c_raw_code(Code, LvalSet0),
+ Component0 = pragma_c_raw_code(Code, CanBranchAway, LvalSet0),
exprn_aux__substitute_lval_in_live_lval_info(OldLval, NewLval,
LvalSet0, LvalSet, !N),
- Component = pragma_c_raw_code(Code, LvalSet)
+ Component = pragma_c_raw_code(Code, CanBranchAway, LvalSet)
;
Component0 = pragma_c_fail_to(_),
Component = Component0
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.91
diff -u -b -r1.91 frameopt.m
--- compiler/frameopt.m 25 Aug 2005 03:19:46 -0000 1.91
+++ compiler/frameopt.m 3 Sep 2005 09:36:40 -0000
@@ -779,7 +779,7 @@
list__last(BlockInstrs, LastInstr)
->
LastInstr = LastUinstr - _,
- possible_targets(LastUinstr, SideLabels),
+ possible_targets(LastUinstr, SideLabels, _SideCodeAddrs),
(
opt_util__can_instr_fall_through(LastUinstr, yes),
Labels = [NextLabel | _]
@@ -1698,7 +1698,7 @@
SideLabels, MaybeFallThrough, Type),
require(unify(Label, BlockLabel), "describe_block: label mismatch"),
LabelStr = dump_label(ProcLabel, Label),
- BlockInstrsStr = dump_fullinstrs(ProcLabel, BlockInstrs),
+ BlockInstrsStr = dump_fullinstrs(ProcLabel, yes, BlockInstrs),
Heading = "\nBLOCK " ++ LabelStr ++ "\n\n",
( map__search(PredMap, Label, PredLabel) ->
PredStr = "previous label " ++ dump_label(ProcLabel, PredLabel) ++ "\n"
@@ -1761,11 +1761,11 @@
"describe_block: teardown, MaybeFallThrough=yes(_)"),
TypeStr = "teardown\n"
++ "restore: "
- ++ dump_fullinstrs(ProcLabel, RestoreSuccip)
+ ++ dump_fullinstrs(ProcLabel, yes, RestoreSuccip)
++ "livevals: "
- ++ dump_fullinstrs(ProcLabel, Livevals)
+ ++ dump_fullinstrs(ProcLabel, yes, Livevals)
++ "goto: "
- ++ dump_fullinstr(ProcLabel, Goto),
+ ++ dump_fullinstr(ProcLabel, yes, Goto),
OrdNeedsFrameStr = ""
),
Comment = Heading ++ PredStr ++ FallIntoStr ++ SideStr ++ FallThroughStr
Index: compiler/ite_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ite_gen.m,v
retrieving revision 1.79
diff -u -b -r1.79 ite_gen.m
--- compiler/ite_gen.m 30 Aug 2005 04:11:52 -0000 1.79
+++ compiler/ite_gen.m 3 Sep 2005 13:06:21 -0000
@@ -408,17 +408,17 @@
PNegCondComponents = [
pragma_c_raw_code(
wrap_transient("\t\tMR_pneg_enter_cond();\n"),
- live_lvals_info(set__init))
+ cannot_branch_away, live_lvals_info(set__init))
],
PNegThenComponents = [
pragma_c_raw_code(
wrap_transient("\t\tMR_pneg_enter_then();\n"),
- live_lvals_info(set__init))
+ cannot_branch_away, live_lvals_info(set__init))
],
PNegElseComponents = [
pragma_c_raw_code(
wrap_transient("\t\tMR_pneg_enter_else();\n"),
- live_lvals_info(set__init))
+ cannot_branch_away, live_lvals_info(set__init))
],
PNegCondCode = node([
pragma_c([], PNegCondComponents, will_not_call_mercury,
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.77
diff -u -b -r1.77 jumpopt.m
--- compiler/jumpopt.m 8 Jul 2005 04:22:03 -0000 1.77
+++ compiler/jumpopt.m 3 Sep 2005 13:07:03 -0000
@@ -1091,31 +1091,26 @@
pragma_c_component::in, pragma_c_component::out,
bool::in, bool::out) is det.
-short_pragma_component(Instrmap, Component0, Component, !Redirect) :-
+short_pragma_component(Instrmap, !Component, !Redirect) :-
(
- Component0 = pragma_c_inputs(_),
- Component = Component0
+ !.Component = pragma_c_inputs(_)
;
- Component0 = pragma_c_outputs(_),
- Component = Component0
+ !.Component = pragma_c_outputs(_)
;
- Component0 = pragma_c_user_code(_, _),
- Component = Component0
+ !.Component = pragma_c_user_code(_, _)
;
- Component0 = pragma_c_raw_code(_, _),
- Component = Component0
+ !.Component = pragma_c_raw_code(_, _, _)
;
- Component0 = pragma_c_fail_to(Label0),
+ !.Component = pragma_c_fail_to(Label0),
short_label(Instrmap, Label0, Label),
- Component = pragma_c_fail_to(Label),
+ !:Component = pragma_c_fail_to(Label),
( Label = Label0 ->
true
;
!:Redirect = yes
)
;
- Component0 = pragma_c_noop,
- Component = Component0
+ !.Component = pragma_c_noop
).
%-----------------------------------------------------------------------------%
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.65
diff -u -b -r1.65 livemap.m
--- compiler/livemap.m 30 Aug 2005 04:11:53 -0000 1.65
+++ compiler/livemap.m 3 Sep 2005 13:07:12 -0000
@@ -299,7 +299,7 @@
Component = pragma_c_user_code(_, _),
!:ContainsUserCode = yes
;
- Component = pragma_c_raw_code(_, LiveLvalInfo),
+ Component = pragma_c_raw_code(_, _, LiveLvalInfo),
livemap__build_live_lval_info(LiveLvalInfo,
!Livevals, !ContainsUserCode)
;
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.315
diff -u -b -r1.315 llds.m
--- compiler/llds.m 29 Aug 2005 15:44:20 -0000 1.315
+++ compiler/llds.m 3 Sep 2005 12:26:51 -0000
@@ -529,9 +529,13 @@
---> pragma_c_inputs(list(pragma_c_input))
; pragma_c_outputs(list(pragma_c_output))
; pragma_c_user_code(maybe(prog_context), string)
- ; pragma_c_raw_code(string, c_code_live_lvals)
+ ; pragma_c_raw_code(string, can_branch_away, c_code_live_lvals)
; pragma_c_fail_to(label)
; pragma_c_noop.
+
+:- type can_branch_away
+ ---> can_branch_away
+ ; cannot_branch_away.
% A pragma_c_input represents the code that initializes one
% of the input variables for a pragma_c instruction.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.253
diff -u -b -r1.253 llds_out.m
--- compiler/llds_out.m 29 Aug 2005 15:44:20 -0000 1.253
+++ compiler/llds_out.m 3 Sep 2005 13:07:24 -0000
@@ -1872,7 +1872,7 @@
output_pragma_input_rval_decls(Inputs, !DeclSet, !IO).
output_pragma_c_component_decls(pragma_c_outputs(Outputs), !DeclSet, !IO) :-
output_pragma_output_lval_decls(Outputs, !DeclSet, !IO).
-output_pragma_c_component_decls(pragma_c_raw_code(_, _), !DeclSet, !IO).
+output_pragma_c_component_decls(pragma_c_raw_code(_, _, _), !DeclSet, !IO).
output_pragma_c_component_decls(pragma_c_user_code(_, _), !DeclSet, !IO).
output_pragma_c_component_decls(pragma_c_fail_to(_), !DeclSet, !IO).
output_pragma_c_component_decls(pragma_c_noop, !DeclSet, !IO).
@@ -2333,7 +2333,7 @@
io__write_string(";}\n", !IO)
)
).
-output_pragma_c_component(pragma_c_raw_code(C_Code, _), !IO) :-
+output_pragma_c_component(pragma_c_raw_code(C_Code, _, _), !IO) :-
io__write_string(C_Code, !IO).
output_pragma_c_component(pragma_c_fail_to(Label), !IO) :-
io__write_string("if (!" ++ pragma_succ_ind_name ++ ") MR_GOTO_LAB(", !IO),
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.103
diff -u -b -r1.103 middle_rec.m
--- compiler/middle_rec.m 20 Mar 2005 02:24:35 -0000 1.103
+++ compiler/middle_rec.m 3 Sep 2005 13:07:30 -0000
@@ -467,7 +467,7 @@
middle_rec__find_used_registers_component(pragma_c_outputs(Out), !Used) :-
insert_pragma_c_output_registers(Out, !Used).
middle_rec__find_used_registers_component(pragma_c_user_code(_, _), !Used).
-middle_rec__find_used_registers_component(pragma_c_raw_code(_, _), !Used).
+middle_rec__find_used_registers_component(pragma_c_raw_code(_, _, _), !Used).
middle_rec__find_used_registers_component(pragma_c_fail_to(_), !Used).
middle_rec__find_used_registers_component(pragma_c_noop, !Used).
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.153
diff -u -b -r1.153 opt_debug.m
--- compiler/opt_debug.m 29 Aug 2005 15:44:21 -0000 1.153
+++ compiler/opt_debug.m 4 Sep 2005 04:33:01 -0000
@@ -32,15 +32,19 @@
:- pred msg(bool::in, int::in, string::in, io::di, io::uo) is det.
-:- pred maybe_dump_instrs(bool::in, list(instruction)::in, io::di, io::uo)
- is det.
+:- pred maybe_dump_instrs(bool::in, proc_label::in, list(instruction)::in,
+ io::di, io::uo) is det.
:- func dump_intlist(list(int)) = string.
:- func dump_livemap(livemap) = string.
+:- func dump_livemap(proc_label, livemap) = string.
+
:- func dump_livemaplist(assoc_list(label, lvalset)) = string.
+:- func dump_livemaplist(proc_label, assoc_list(label, lvalset)) = string.
+
:- func dump_livevals(lvalset) = string.
:- func dump_livelist(list(lval)) = string.
@@ -101,11 +105,11 @@
:- func dump_bool(bool) = string.
-:- func dump_instr(proc_label, instr) = string.
+:- func dump_instr(proc_label, bool, instr) = string.
-:- func dump_fullinstr(proc_label, instruction) = string.
+:- func dump_fullinstr(proc_label, bool, instruction) = string.
-:- func dump_fullinstrs(proc_label, list(instruction)) = string.
+:- func dump_fullinstrs(proc_label, bool, list(instruction)) = string.
:- func dump_code_model(code_model) = string.
@@ -126,6 +130,7 @@
:- import_module parse_tree__prog_foreign.
:- import_module parse_tree__prog_out.
+:- import_module char.
:- import_module int.
:- import_module map.
:- import_module set.
@@ -147,23 +152,49 @@
OptDebug = no
).
-maybe_dump_instrs(OptDebug, Instrs, !IO) :-
+maybe_dump_instrs(OptDebug, ProcLabel, Instrs, !IO) :-
(
OptDebug = yes,
globals__io_lookup_bool_option(auto_comments, PrintComments,
!IO),
- dump_instrs_2(Instrs, PrintComments, !IO)
+ dump_instrs_2(Instrs, ProcLabel, PrintComments, !IO)
;
OptDebug = no
).
-:- pred dump_instrs_2(list(instruction)::in, bool::in,
+:- pred dump_instrs_2(list(instruction)::in, proc_label::in, bool::in,
io::di, io::uo) is det.
-dump_instrs_2([], _PrintComments, !IO).
-dump_instrs_2([Uinstr - Comment | Instrs], PrintComments, !IO) :-
- output_debug_instruction_and_comment(Uinstr, Comment, PrintComments, !IO),
- dump_instrs_2(Instrs, PrintComments, !IO).
+dump_instrs_2([], _ProcLabel, _PrintComments, !IO).
+dump_instrs_2([Uinstr - Comment | Instrs], ProcLabel, PrintComments, !IO) :-
+ ( Uinstr = label(_) ->
+ io__write_string(dump_instr(ProcLabel, PrintComments, Uinstr), !IO)
+ ; Uinstr = comment(InstrComment) ->
+ io__write_string("\t% ", !IO),
+ string__foldl(print_comment_char, InstrComment, !IO)
+ ;
+ io__write_string("\t", !IO),
+ io__write_string(dump_instr(ProcLabel, PrintComments, Uinstr), !IO)
+ ),
+ (
+ PrintComments = yes,
+ Comment \= ""
+ ->
+ io__write_string("\n\t\t" ++ Comment, !IO)
+ ;
+ true
+ ),
+ io__nl(!IO),
+ dump_instrs_2(Instrs, ProcLabel, PrintComments, !IO).
+
+:- pred print_comment_char(char::in, io::di, io::uo) is det.
+
+print_comment_char(C, !IO) :-
+ ( C = '\n' ->
+ io__write_string("\n\t% ", !IO)
+ ;
+ io__write_char(C, !IO)
+ ).
dump_intlist([]) = "".
dump_intlist([H | T]) =
@@ -172,29 +203,42 @@
dump_livemap(Livemap) =
dump_livemaplist(map__to_assoc_list(Livemap)).
+dump_livemap(ProcLabel, Livemap) =
+ dump_livemaplist(ProcLabel, map__to_assoc_list(Livemap)).
+
dump_livemaplist([]) = "".
dump_livemaplist([Label - Lvalset | Livemaplist]) =
dump_label(Label) ++ " ->" ++ dump_livevals(Lvalset) ++ "\n"
++ dump_livemaplist(Livemaplist).
+dump_livemaplist(_ProcLabel, []) = "".
+dump_livemaplist(ProcLabel, [Label - Lvalset | Livemaplist]) =
+ dump_label(ProcLabel, Label) ++ " ->" ++ dump_livevals(Lvalset) ++ "\n"
+ ++ dump_livemaplist(ProcLabel, Livemaplist).
+
dump_livevals(Lvalset) =
dump_livelist(set__to_sorted_list(Lvalset)).
-dump_livelist([]) = "".
-dump_livelist([Lval | Lvallist]) =
- " " ++ dump_lval(Lval) ++ dump_livelist(Lvallist).
+dump_livelist(Lvals) =
+ dump_livelist_2(Lvals, "").
+
+:- func dump_livelist_2(list(lval), string) = string.
+
+dump_livelist_2([], _) = "".
+dump_livelist_2([Lval | Lvallist], Prefix) =
+ Prefix ++ dump_lval(Lval) ++ dump_livelist_2(Lvallist, " ").
dump_reg(r, N) =
- "r(" ++ int_to_string(N) ++ ")".
+ "r" ++ int_to_string(N).
dump_reg(f, N) =
- "f(" ++ int_to_string(N) ++ ")".
+ "f" ++ int_to_string(N).
dump_lval(reg(Type, Num)) =
- "reg(" ++ dump_reg(Type, Num) ++ ")".
+ dump_reg(Type, Num).
dump_lval(stackvar(N)) =
- "stackvar(" ++ int_to_string(N) ++ ")".
+ "sv" ++ int_to_string(N).
dump_lval(framevar(N)) =
- "framevar(" ++ int_to_string(N) ++ ")".
+ "fv" ++ int_to_string(N).
dump_lval(succip) = "succip".
dump_lval(maxfr) = "maxfr".
dump_lval(curfr) = "curfr".
@@ -222,23 +266,31 @@
++ dump_rval(F) ++ ")".
dump_lval(lvar(_)) = "lvar(_)".
dump_lval(temp(Type, Num)) =
- "temp(" ++ dump_reg(Type, Num) ++ ")".
+ "temp_" ++ dump_reg(Type, Num).
dump_lval(mem_ref(R)) =
"mem_ref(" ++ dump_rval(R) ++ ")".
dump_rval(lval(Lval)) =
- "lval(" ++ dump_lval(Lval) ++ ")".
+ dump_lval(Lval).
dump_rval(var(_)) =
"var(_)".
dump_rval(mkword(T, N)) =
"mkword(" ++ int_to_string(T) ++ ", " ++ dump_rval(N) ++ ")".
dump_rval(const(C)) =
- "const(" ++ dump_const(C) ++ ")".
+ dump_const(C).
dump_rval(unop(O, N)) =
- "unop(" ++ dump_unop(O) ++ ", " ++ dump_rval(N) ++ ")".
+ dump_unop(O) ++ "(" ++ dump_rval(N) ++ ")".
dump_rval(binop(O, N1, N2)) =
+ (
+ ( N1 = binop(_, _, _)
+ ; N2 = binop(_, _, _)
+ )
+ ->
"binop(" ++ dump_binop(O) ++ ", "
- ++ dump_rval(N1) ++ ", " ++ dump_rval(N2) ++ ")".
+ ++ dump_rval(N1) ++ ", " ++ dump_rval(N2) ++ ")"
+ ;
+ dump_rval(N1) ++ " " ++ dump_binop(O) ++ " " ++ dump_rval(N2)
+ ).
dump_rval(mem_addr(M)) =
"mem_addr(" ++ dump_mem_ref(M) ++ ")".
@@ -505,7 +557,7 @@
++ dump_code_addrs(ProcLabel, Addrs).
dump_label(internal(N, ProcLabel)) =
- dump_proclabel(ProcLabel) ++ "_" ++ int_to_string(N).
+ dump_proclabel(ProcLabel) ++ "_i" ++ int_to_string(N).
dump_label(entry(_, ProcLabel)) =
dump_proclabel(ProcLabel).
@@ -570,7 +622,7 @@
dump_code_model(model_semi) = "model_semi".
dump_code_model(model_non) = "model_non".
-dump_instr(ProcLabel, Instr) = Str :-
+dump_instr(ProcLabel, PrintComments, Instr) = Str :-
(
Instr = comment(Comment),
Str = "comment(" ++ Comment ++ ")"
@@ -578,12 +630,14 @@
Instr = livevals(Livevals),
Str = "livevals(" ++ dump_livevals(Livevals) ++ ")"
;
- Instr = block(RTemps, FTemps, _),
+ Instr = block(RTemps, FTemps, Instrs),
Str = "block(" ++ int_to_string(RTemps) ++ ", "
- ++ int_to_string(FTemps) ++ ", ...)"
+ ++ int_to_string(FTemps) ++ ",\n"
+ ++ dump_fullinstrs(ProcLabel, PrintComments, Instrs)
+ ++ ")"
;
Instr = assign(Lval, Rval),
- Str = "assign(" ++ dump_lval(Lval) ++ ", " ++ dump_rval(Rval) ++ ")"
+ Str = dump_lval(Lval) ++ " := " ++ dump_rval(Rval)
;
Instr = call(Callee, ReturnLabel, _, _, _, _),
Str = "call(" ++ dump_code_addr(ProcLabel, Callee) ++ ", "
@@ -620,21 +674,21 @@
)
;
Instr = label(Label),
- Str = "label(" ++ dump_label(ProcLabel, Label) ++ ")"
+ Str = dump_label(ProcLabel, Label) ++ ":"
;
Instr = goto(CodeAddr),
- Str = "goto(" ++ dump_code_addr(ProcLabel, CodeAddr) ++ ")"
+ Str = "goto " ++ dump_code_addr(ProcLabel, CodeAddr)
;
Instr = computed_goto(Rval, Labels),
- Str = "computed_goto(" ++ dump_rval(Rval) ++ ", "
- ++ dump_labels(ProcLabel, Labels) ++ ")"
+ Str = "computed_goto " ++ dump_rval(Rval) ++ ":"
+ ++ dump_labels(ProcLabel, Labels)
;
Instr = c_code(Code, _),
Str = "c_code(" ++ Code ++ ")"
;
Instr = if_val(Rval, CodeAddr),
- Str = "if_val(" ++ dump_rval(Rval) ++ ", "
- ++ dump_code_addr(ProcLabel, CodeAddr) ++ ")"
+ Str = "if (" ++ dump_rval(Rval) ++ ") goto "
+ ++ dump_code_addr(ProcLabel, CodeAddr)
;
Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Size, _),
(
@@ -719,14 +773,22 @@
dump_component(_, pragma_c_inputs(_)) = "".
dump_component(_, pragma_c_outputs(_)) = "".
dump_component(_, pragma_c_user_code(_, Code)) = Code.
-dump_component(_, pragma_c_raw_code(Code, _)) = Code.
+dump_component(_, pragma_c_raw_code(Code, _, _)) = Code.
dump_component(ProcLabel, pragma_c_fail_to(Label)) =
"fail to " ++ dump_label(ProcLabel, Label).
dump_component(_, pragma_c_noop) = "".
-dump_fullinstr(ProcLabel, Uinstr - Comment) =
- dump_instr(ProcLabel, Uinstr) ++ " - " ++ Comment ++ "\n".
+dump_fullinstr(ProcLabel, PrintComments, Uinstr - Comment) = Str :-
+ (
+ PrintComments = no,
+ Str = dump_instr(ProcLabel, PrintComments, Uinstr) ++ "\n"
+ ;
+ PrintComments = yes,
+ Str = dump_instr(ProcLabel, PrintComments, Uinstr) ++
+ " - " ++ Comment ++ "\n"
+ ).
-dump_fullinstrs(_ProcLabel, []) = "".
-dump_fullinstrs(ProcLabel, [Instr | Instrs]) =
- dump_fullinstr(ProcLabel, Instr) ++ dump_fullinstrs(ProcLabel, Instrs).
+dump_fullinstrs(_ProcLabel, _PrintComments, []) = "".
+dump_fullinstrs(ProcLabel, PrintComments, [Instr | Instrs]) =
+ dump_fullinstr(ProcLabel, PrintComments, Instr)
+ ++ dump_fullinstrs(ProcLabel, PrintComments, Instrs).
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.132
diff -u -b -r1.132 opt_util.m
--- compiler/opt_util.m 29 Aug 2005 15:44:22 -0000 1.132
+++ compiler/opt_util.m 3 Sep 2005 13:13:06 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -15,6 +17,7 @@
:- interface.
:- import_module ll_backend__llds.
+:- import_module mdbcomp__prim_data.
:- import_module bool.
:- import_module list.
@@ -35,6 +38,9 @@
:- pred gather_comments_livevals(list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
+ % Given a list of instructions, skip past any comment instructions
+ % at the start and return the remaining instructions. We do this because
+ % comment instructions get in the way of peephole optimization.
:- pred skip_comments(list(instruction)::in, list(instruction)::out) is det.
:- pred skip_comments_livevals(list(instruction)::in,
@@ -60,8 +66,8 @@
%
:- pred touches_nondet_ctrl(list(instruction)::in, bool::out) is det.
- % Find the instructions up to and including
- % the next one that cannot fall through
+ % Find the instructions up to and including the next one that
+ % cannot fall through.
%
:- pred find_no_fallthrough(list(instruction)::in,
list(instruction)::out) is det.
@@ -121,16 +127,14 @@
:- pred is_forkproceed_next(list(instruction)::in, tailmap::in,
list(instruction)::out) is semidet.
- % Remove the assignment to r1 from the list returned by
- % is_sdproceed_next.
+ % Remove the assignment to r1 from the list returned by is_sdproceed_next.
%
:- pred filter_out_r1(list(instruction)::in, maybe(rval_const)::out,
list(instruction)::out) is det.
- % Does the following code consist of straighline instructions
- % that do not modify nondet frame linkages, plus possibly
- % if_val(..., dofail), and then a succeed?
- % If yes, then return all the instructions up to the succeed,
+ % Does the following code consist of straighline instructions that do not
+ % modify nondet frame linkages, plus possibly if_val(..., dofail), and then
+ % a succeed? If yes, then return all the instructions up to the succeed,
% and all the following instructions.
%
:- pred straight_alternative(list(instruction)::in,
@@ -164,8 +168,8 @@
:- pred filter_in_livevals(list(instruction)::in,
list(instruction)::out) is det.
- % See if the condition of an if-then-else is constant,
- % and if yes, whether the branch will be taken or not.
+ % See if the condition of an if-then-else is constant, and if yes,
+ % whether the branch will be taken or not.
%
:- pred is_const_condition(rval::in, bool::out) is semidet.
@@ -178,9 +182,9 @@
%
:- pred can_instr_fall_through(instr::in, bool::out) is det.
- % Check whether a code_addr, when the target of a goto, represents
- % either a call or a proceed/succeed; if so, it is the end of an
- % extended basic block and needs a livevals in front of it.
+ % Check whether a code_addr, when the target of a goto, represents either
+ % a call or a proceed/succeed; if so, it is the end of an extended basic
+ % block and needs a livevals in front of it.
%
:- pred livevals_addr(code_addr::in, bool::out) is det.
@@ -196,11 +200,12 @@
:- pred instr_list_labels(list(instruction)::in,
list(label)::out, list(code_addr)::out) is det.
- % Given an instruction, find the set of labels to which it can cause
- % control to transfer. In the case of calls, this includes transfer
- % via return from the called procedure.
+ % Given an instruction, find the set of labels and other code addresses
+ % to which it can cause control to transfer. In the case of calls, this
+ % includes transfer via return from the called procedure.
%
-:- pred possible_targets(instr::in, list(label)::out) is det.
+:- pred possible_targets(instr::in, list(label)::out, list(code_addr)::out)
+ is det.
% Find the maximum temp variable number used.
%
@@ -236,9 +241,10 @@
%
:- pred block_refers_stackvars(list(instruction)::in, bool::out) is det.
- % Format a label for verbose messages during compilation
+ % Format a label or proc_label for verbose messages during compilation.
%
-:- pred format_label(label::in, string::out) is det.
+:- func format_label(label) = string.
+:- func format_proc_label(proc_label) = string.
% Find out if an instruction sequence has both incr_sp and decr_sp.
%
@@ -260,23 +266,21 @@
%
:- pred count_incr_hp(list(instruction)::in, int::out) is det.
- % Whenever the input list of instructions contains two livevals
- % pseudo-ops without an intervening no-fall-through instruction,
- % ensure that the first of these registers as live every lval
- % that is live in the second, except those that are assigned to
- % by intervening instructions. This makes the shadowing of the
- % second livevals by the first benign.
+ % Whenever the input list of instructions contains two livevals pseudo-ops
+ % without an intervening no-fall-through instruction, ensure that the
+ % first of these registers as live every lval that is live in the second,
+ % except those that are assigned to by intervening instructions. This makes
+ % the shadowing of the second livevals by the first benign.
%
:- pred propagate_livevals(list(instruction)::in, list(instruction)::out)
is det.
- % Replace references to one set of local labels with references
- % to another set, in one instruction or a list of instructions.
- % Control references (those that can cause a transfer of control
- % from the instruction they occur in to the replaced label, either
- % directly or via return from a called procedure) are always replaced;
- % references that treat the label as data are replaced iff the third
- % argument is set to "yes".
+ % Replace references to one set of local labels with references to another
+ % set, in one instruction or a list of instructions. Control references
+ % (those that can cause a transfer of control from the instruction they
+ % occur in to the replaced label, either directly or via return from a
+ % called procedure) are always replaced; references that treat the label
+ % as data are replaced iff the third argument is set to "yes".
%
:- pred replace_labels_instr(instr::in, map(label, label)::in,
bool::in, instr::out) is det.
@@ -297,7 +301,7 @@
:- import_module hlds__special_pred.
:- import_module ll_backend__exprn_aux.
:- import_module ll_backend__llds_out.
-:- import_module mdbcomp__prim_data.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module int.
@@ -315,7 +319,7 @@
gather_comments(Instrs2, Comments2, Instrs),
list__append(Comments1, Comments2, Comments)
;
- error("procedure does not begin with label")
+ unexpected(this_file, "procedure does not begin with label")
).
gather_comments(Instrs0, Comments, Instrs) :-
@@ -342,11 +346,6 @@
Comments = []
).
- % Given a list of instructions, skip past any comment instructions
- % at the start and return the remaining instructions.
- % We do this because comment instructions get in the way of
- % peephole optimization.
-
skip_comments(Instrs0, Instrs) :-
( Instrs0 = [comment(_) - _ | Instrs1] ->
skip_comments(Instrs1, Instrs)
@@ -383,12 +382,11 @@
Instrs = Instrs0
).
-next_assign_to_redoip([Instr | Instrs], AllowedBases,
- RevSkip, Redoip, Skip, Rest) :-
+next_assign_to_redoip([Instr | Instrs], AllowedBases, RevSkip,
+ Redoip, Skip, Rest) :-
Instr = Uinstr - _Comment,
(
- Uinstr = assign(redoip(lval(Fr)),
- const(code_addr_const(Redoip0))),
+ Uinstr = assign(redoip(lval(Fr)), const(code_addr_const(Redoip0))),
list__member(Fr, AllowedBases)
->
Redoip = Redoip0,
@@ -399,11 +397,13 @@
->
fail
;
- can_instr_branch_away(Uinstr, Canbranchaway),
- ( Canbranchaway = no ->
- next_assign_to_redoip(Instrs, AllowedBases,
- [Instr | RevSkip], Redoip, Skip, Rest)
+ can_instr_branch_away(Uinstr, CanBranchAway),
+ (
+ CanBranchAway = no,
+ next_assign_to_redoip(Instrs, AllowedBases, [Instr | RevSkip],
+ Redoip, Skip, Rest)
;
+ CanBranchAway = yes,
fail
)
).
@@ -421,7 +421,7 @@
).
find_first_label([], _) :-
- error("cannot find first label").
+ unexpected(this_file, "cannot find first label").
find_first_label([Instr0 | Instrs0], Label) :-
( Instr0 = label(LabelPrime) - _ ->
Label = LabelPrime
@@ -589,15 +589,15 @@
fail
).
-no_stack_straight_line(Instrs0, Shuffle, Instrs) :-
- no_stack_straight_line_2(Instrs0, [], RevShuffle, Instrs),
- list__reverse(RevShuffle, Shuffle).
+no_stack_straight_line(Instrs0, StraightLine, Instrs) :-
+ no_stack_straight_line_2(Instrs0, [], RevStraightLine, Instrs),
+ list__reverse(RevStraightLine, StraightLine).
:- pred no_stack_straight_line_2(list(instruction)::in, list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
-no_stack_straight_line_2([], After, After, []).
-no_stack_straight_line_2([Instr0 | Instrs0], After0, After, Instrs) :-
+no_stack_straight_line_2([], !RevStraightLine, []).
+no_stack_straight_line_2([Instr0 | Instrs0], !RevStraightLine, Instrs) :-
Instr0 = Uinstr - _,
(
(
@@ -610,10 +610,9 @@
rval_refers_stackvars(Rval, no)
)
->
- After1 = [Instr0 | After0],
- no_stack_straight_line_2(Instrs0, After1, After, Instrs)
+ !:RevStraightLine = [Instr0 | !.RevStraightLine],
+ no_stack_straight_line_2(Instrs0, !RevStraightLine, Instrs)
;
- After = After0,
Instrs = [Instr0 | Instrs0]
).
@@ -640,7 +639,7 @@
rval_refers_stackvars(FieldNum, Refers2),
bool__or(Refers1, Refers2, Refers).
lval_refers_stackvars(lvar(_), _) :-
- error("found lvar in lval_refers_stackvars").
+ unexpected(this_file, "found lvar in lval_refers_stackvars").
lval_refers_stackvars(temp(_, _), no).
lval_refers_stackvars(mem_ref(Rval), Refers) :-
rval_refers_stackvars(Rval, Refers).
@@ -655,7 +654,7 @@
rval_refers_stackvars(lval(Lval), Refers) :-
lval_refers_stackvars(Lval, Refers).
rval_refers_stackvars(var(_), _) :-
- error("found var in rval_refers_stackvars").
+ unexpected(this_file, "found var in rval_refers_stackvars").
rval_refers_stackvars(mkword(_, Rval), Refers) :-
rval_refers_stackvars(Rval, Refers).
rval_refers_stackvars(const(_), no).
@@ -684,8 +683,7 @@
Refers = yes
).
-no_stackvars_til_decr_sp([Instr0 | Instrs0], FrameSize,
- Between, Remain) :-
+no_stackvars_til_decr_sp([Instr0 | Instrs0], FrameSize, Between, Remain) :-
Instr0 = Uinstr0 - _,
(
Uinstr0 = comment(_),
@@ -701,8 +699,7 @@
Lval = stackvar(_),
rval_refers_stackvars(Rval, no)
->
- no_stackvars_til_decr_sp(Instrs0, FrameSize,
- Between, Remain)
+ no_stackvars_til_decr_sp(Instrs0, FrameSize, Between, Remain)
;
Lval = succip,
Rval = lval(stackvar(FrameSize)),
@@ -714,8 +711,7 @@
;
lval_refers_stackvars(Lval, no),
rval_refers_stackvars(Rval, no),
- no_stackvars_til_decr_sp(Instrs0, FrameSize,
- Between0, Remain),
+ no_stackvars_til_decr_sp(Instrs0, FrameSize, Between0, Remain),
Between = [Instr0 | Between0]
)
;
@@ -897,14 +893,13 @@
% We recognize only a subset of all constant conditions.
% The time to extend this predicate is when the rest of the compiler
% generates more complicated constant conditions.
-
is_const_condition(const(Const), Taken) :-
( Const = true ->
Taken = yes
; Const = false ->
Taken = no
;
- error("non-boolean constant as if-then-else condition")
+ unexpected(this_file, "non-boolean constant as if-then-else condition")
).
is_const_condition(unop(Op, Rval1), Taken) :-
Op = (not),
@@ -959,8 +954,6 @@
can_components_branch_away(Components, BranchAway)
).
-:- pred can_component_branch_away(pragma_c_component::in, bool::out) is det.
-
% The input and output components get expanded to straight line code.
% Some of the raw_code components we generate for nondet pragma C codes
% invoke succeed(), which definitely does branch away.
@@ -973,10 +966,19 @@
% but we are careful to preserve a declarative interface, and that
% is incompatible with branching away.)
%
+:- pred can_component_branch_away(pragma_c_component::in, bool::out) is det.
+
can_component_branch_away(pragma_c_inputs(_), no).
can_component_branch_away(pragma_c_outputs(_), no).
-can_component_branch_away(pragma_c_raw_code(Code, _), CanBranchAway) :-
- ( Code = "" -> CanBranchAway = no ; CanBranchAway = yes ).
+can_component_branch_away(pragma_c_raw_code(_, CanBranchAway, _),
+ CanBranchAwayBool) :-
+ (
+ CanBranchAway = can_branch_away,
+ CanBranchAwayBool = yes
+ ;
+ CanBranchAway = cannot_branch_away,
+ CanBranchAwayBool = no
+ ).
can_component_branch_away(pragma_c_user_code(_, _), no).
can_component_branch_away(pragma_c_fail_to(_), yes).
can_component_branch_away(pragma_c_noop, no).
@@ -1078,9 +1080,9 @@
),
find_label_code_addrs(Rest, Labels1, Labels).
- % Determine all the labels and code_addresses that are directly
- % referenced by an instruction (not counting ones referenced indirectly
- % via rvals or lvals).
+ % Determine all the labels and code_addresses that are directly referenced
+ % by an instruction (not counting ones referenced indirectly via rvals or
+ % lvals).
%
:- pred instr_labels_2(instr::in, list(label)::out, list(code_addr)::out)
is det.
@@ -1119,51 +1121,57 @@
pragma_c_labels(MaybeFixLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, Labels).
-possible_targets(comment(_), []).
-possible_targets(livevals(_), []).
-possible_targets(block(_, _, _), _) :-
- error("block in possible_targets").
-possible_targets(assign(_, _), []).
-possible_targets(call(_, ReturnAddr, _, _, _, _), Labels) :-
- ( ReturnAddr = label(Label) ->
- Labels = [Label]
- ;
- Labels = []
- ).
-possible_targets(mkframe(_, _), []).
-possible_targets(label(_), []).
-possible_targets(goto(CodeAddr), Targets) :-
+possible_targets(comment(_), [], []).
+possible_targets(livevals(_), [], []).
+possible_targets(block(_, _, _), _, _) :-
+ unexpected(this_file, "block in possible_targets").
+possible_targets(assign(_, _), [], []).
+possible_targets(call(_, Return, _, _, _, _), Labels, CodeAddrs) :-
+ ( Return = label(ReturnLabel) ->
+ Labels = [ReturnLabel],
+ CodeAddrs = []
+ ;
+ Labels = [],
+ CodeAddrs = [Return]
+ ).
+possible_targets(mkframe(_, _), [], []).
+possible_targets(label(_), [], []).
+possible_targets(goto(CodeAddr), Labels, CodeAddrs) :-
( CodeAddr = label(Label) ->
- Targets = [Label]
+ Labels = [Label],
+ CodeAddrs = []
;
- Targets = []
+ Labels = [],
+ CodeAddrs = [CodeAddr]
).
-possible_targets(computed_goto(_, Targets), Targets).
-possible_targets(c_code(_, _), []).
-possible_targets(if_val(_, CodeAddr), Targets) :-
+possible_targets(computed_goto(_, Labels), Labels, []).
+possible_targets(c_code(_, _), [], []).
+possible_targets(if_val(_, CodeAddr), Labels, CodeAddrs) :-
( CodeAddr = label(Label) ->
- Targets = [Label]
+ Labels = [Label],
+ CodeAddrs = []
;
- Targets = []
+ Labels = [],
+ CodeAddrs = [CodeAddr]
).
-possible_targets(incr_hp(_, _, _, _, _), []).
-possible_targets(mark_hp(_), []).
-possible_targets(restore_hp(_), []).
-possible_targets(free_heap(_), []).
-possible_targets(store_ticket(_), []).
-possible_targets(reset_ticket(_, _), []).
-possible_targets(discard_ticket, []).
-possible_targets(prune_ticket, []).
-possible_targets(mark_ticket_stack(_), []).
-possible_targets(prune_tickets_to(_), []).
-possible_targets(incr_sp(_, _), []).
-possible_targets(decr_sp(_), []).
-possible_targets(init_sync_term(_, _), []).
-possible_targets(fork(Child, Parent, _), [Child, Parent]).
-possible_targets(join_and_terminate(_), []).
-possible_targets(join_and_continue(_, L), [L]).
+possible_targets(incr_hp(_, _, _, _, _), [], []).
+possible_targets(mark_hp(_), [], []).
+possible_targets(restore_hp(_), [], []).
+possible_targets(free_heap(_), [], []).
+possible_targets(store_ticket(_), [], []).
+possible_targets(reset_ticket(_, _), [], []).
+possible_targets(discard_ticket, [], []).
+possible_targets(prune_ticket, [], []).
+possible_targets(mark_ticket_stack(_), [], []).
+possible_targets(prune_tickets_to(_), [], []).
+possible_targets(incr_sp(_, _), [], []).
+possible_targets(decr_sp(_), [], []).
+possible_targets(init_sync_term(_, _), [], []).
+possible_targets(fork(Child, Parent, _), [Child, Parent], []).
+possible_targets(join_and_terminate(_), [], []).
+possible_targets(join_and_continue(_, L), [L], []).
possible_targets(pragma_c(_, _, _, MaybeFixedLabel, MaybeLayoutLabel,
- _, MaybeSubLabel, _, _), Labels) :-
+ _, MaybeSubLabel, _, _), Labels, []) :-
pragma_c_labels(MaybeFixedLabel, MaybeLayoutLabel,
no, MaybeSubLabel, Labels).
@@ -1241,34 +1249,32 @@
list(rval)::out, list(lval)::out) is det.
pragma_c_components_get_rvals_and_lvals([], [], []).
-pragma_c_components_get_rvals_and_lvals([Comp | Comps], Rvals, Lvals) :-
- pragma_c_components_get_rvals_and_lvals(Comps, Rvals1, Lvals1),
- pragma_c_component_get_rvals_and_lvals(Comp,
- Rvals1, Rvals, Lvals1, Lvals).
+pragma_c_components_get_rvals_and_lvals([Comp | Comps], !:Rvals, !:Lvals) :-
+ pragma_c_components_get_rvals_and_lvals(Comps, !:Rvals, !:Lvals),
+ pragma_c_component_get_rvals_and_lvals(Comp, !Rvals, !Lvals).
% Extract the rvals and lvals from the pragma_c_component
% and add them to the list.
%
:- pred pragma_c_component_get_rvals_and_lvals(pragma_c_component::in,
- list(rval)::in, list(rval)::out, list(lval)::in, list(lval)::out)
- is det.
+ list(rval)::in, list(rval)::out, list(lval)::in, list(lval)::out) is det.
pragma_c_component_get_rvals_and_lvals(pragma_c_inputs(Inputs),
- Rvals0, Rvals, Lvals, Lvals) :-
- pragma_c_inputs_get_rvals(Inputs, Rvals1),
- list__append(Rvals1, Rvals0, Rvals).
+ !Rvals, !Lvals) :-
+ pragma_c_inputs_get_rvals(Inputs, NewRvals),
+ list__append(NewRvals, !Rvals).
pragma_c_component_get_rvals_and_lvals(pragma_c_outputs(Outputs),
- Rvals, Rvals, Lvals0, Lvals) :-
- pragma_c_outputs_get_lvals(Outputs, Lvals1),
- list__append(Lvals1, Lvals0, Lvals).
+ !Rvals, !Lvals) :-
+ pragma_c_outputs_get_lvals(Outputs, NewLvals),
+ list__append(NewLvals, !Lvals).
pragma_c_component_get_rvals_and_lvals(pragma_c_user_code(_, _),
- Rvals, Rvals, Lvals, Lvals).
-pragma_c_component_get_rvals_and_lvals(pragma_c_raw_code(_, _),
- Rvals, Rvals, Lvals, Lvals).
+ !Rvals, !Lvals).
+pragma_c_component_get_rvals_and_lvals(pragma_c_raw_code(_, _, _),
+ !Rvals, !Lvals).
pragma_c_component_get_rvals_and_lvals(pragma_c_fail_to(_),
- Rvals, Rvals, Lvals, Lvals).
+ !Rvals, !Lvals).
pragma_c_component_get_rvals_and_lvals(pragma_c_noop,
- Rvals, Rvals, Lvals, Lvals).
+ !Rvals, !Lvals).
% Extract the rvals from the pragma_c_input.
%
@@ -1276,7 +1282,7 @@
is det.
pragma_c_inputs_get_rvals([], []).
-pragma_c_inputs_get_rvals([I|Inputs], [R|Rvals]) :-
+pragma_c_inputs_get_rvals([I | Inputs], [R | Rvals]) :-
I = pragma_c_input(_Name, _VarType, _OrigType, R, _),
pragma_c_inputs_get_rvals(Inputs, Rvals).
@@ -1286,18 +1292,17 @@
is det.
pragma_c_outputs_get_lvals([], []).
-pragma_c_outputs_get_lvals([O|Outputs], [L|Lvals]) :-
+pragma_c_outputs_get_lvals([O | Outputs], [L | Lvals]) :-
O = pragma_c_output(L, _VarType, _OrigType, _Name, _),
pragma_c_outputs_get_lvals(Outputs, Lvals).
- % Determine all the rvals and lvals referenced by a list of
- % instructions.
+ % Determine all the rvals and lvals referenced by a list of instructions.
%
:- pred instr_list_rvals_and_lvals(list(pair(instr, string))::in,
list(rval)::out, list(lval)::out) is det.
instr_list_rvals_and_lvals([], [], []).
-instr_list_rvals_and_lvals([Instr - _|Instrs], Rvals, Lvals) :-
+instr_list_rvals_and_lvals([Instr - _ | Instrs], Rvals, Lvals) :-
instr_rvals_and_lvals(Instr, Rvals0, Lvals0),
instr_list_rvals_and_lvals(Instrs, Rvals1, Lvals1),
list__append(Rvals0, Rvals1, Rvals),
@@ -1405,25 +1410,17 @@
% that uses a temp var without defining it.
count_temps_rval(_, !R, !F).
-format_label(internal(_, ProcLabel), Str) :-
- format_proclabel(ProcLabel, Str).
-format_label(entry(_, ProcLabel), Str) :-
- format_proclabel(ProcLabel, Str).
-
-:- pred format_proclabel(proc_label::in, string::out) is det.
-
-format_proclabel(proc(_Module, _PredOrFunc, _, Name, Arity, Mode), Str) :-
- string__int_to_string(Arity, ArityStr),
- string__int_to_string(Mode, ModeStr),
- string__append_list([Name, "/", ArityStr, " mode ", ModeStr], Str).
-format_proclabel(special_proc(_Module, SpecialPredId, TypeModule,
- TypeName, TypeArity, Mode), Str) :-
- string__int_to_string(TypeArity, TypeArityStr),
- string__int_to_string(Mode, ModeStr),
+format_label(internal(_, ProcLabel)) = format_proc_label(ProcLabel).
+format_label(entry(_, ProcLabel)) = format_proc_label(ProcLabel).
+
+format_proc_label(proc(_Module, _PredOrFunc, _, Name, Arity, Mode)) =
+ Name ++ "/" ++ int_to_string(Arity) ++ " mode " ++ int_to_string(Mode).
+format_proc_label(special_proc(_Module, SpecialPredId, TypeModule,
+ TypeName, TypeArity, Mode)) =
+ PredName ++ "_" ++ TypeName ++ "/" ++ int_to_string(TypeArity)
+ ++ " mode " ++ int_to_string(Mode) :-
TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
- PredName = special_pred_name(SpecialPredId, TypeCtor),
- string__append_list([PredName, "_", TypeName, "/", TypeArityStr,
- " mode ", ModeStr], Str).
+ PredName = special_pred_name(SpecialPredId, TypeCtor).
has_both_incr_decr_sp(Instrs) :-
has_both_incr_decr_sp_2(Instrs, no, yes, no, yes).
@@ -1534,19 +1531,18 @@
touches_nondet_ctrl_components(Cs, Touch2),
bool__or(Touch1, Touch2, Touch).
- % The inputs and outputs components get emitted as simple
- % straight-line code that do not refer to control slots.
- % The compiler does not generate raw_code that refers to control slots.
- % User code shouldn't either, but until we have prohibited the
- % use of ordinary pragma C codes for model_non procedures,
- % some user code will need to ignore this restriction.
+ % The inputs and outputs components get emitted as simple straight-line
+ % code that do not refer to control slots. The compiler does not generate
+ % raw_code that refers to control slots. User code shouldn't either, but
+ % until we have prohibited the use of ordinary pragma C codes for model_non
+ % procedures, some user code will need to ignore this restriction.
%
:- pred touches_nondet_ctrl_component(pragma_c_component::in, bool::out)
is det.
touches_nondet_ctrl_component(pragma_c_inputs(_), no).
touches_nondet_ctrl_component(pragma_c_outputs(_), no).
-touches_nondet_ctrl_component(pragma_c_raw_code(_, _), no).
+touches_nondet_ctrl_component(pragma_c_raw_code(_, _, _), no).
touches_nondet_ctrl_component(pragma_c_user_code(_, _), yes).
touches_nondet_ctrl_component(pragma_c_fail_to(_), no).
touches_nondet_ctrl_component(pragma_c_noop, no).
@@ -1569,7 +1565,7 @@
lval_access_rvals(field(_, Rval1, Rval2), [Rval1, Rval2]).
lval_access_rvals(temp(_, _), []).
lval_access_rvals(lvar(_), _) :-
- error("lvar detected in lval_access_rvals").
+ unexpected(this_file, "lvar detected in lval_access_rvals").
lval_access_rvals(mem_ref(Rval), [Rval]).
%-----------------------------------------------------------------------------%
@@ -1584,7 +1580,7 @@
lval_access_rvals(Lval, Rvals),
rvals_free_of_lval(Rvals, Forbidden).
rval_free_of_lval(var(_), _) :-
- error("found var in rval_free_of_lval").
+ unexpected(this_file, "found var in rval_free_of_lval").
rval_free_of_lval(mkword(_, Rval), Forbidden) :-
rval_free_of_lval(Rval, Forbidden).
rval_free_of_lval(const(_), _).
@@ -1641,16 +1637,15 @@
propagate_livevals_2(Instrs0, Livevals, Instrs).
%-----------------------------------------------------------------------------%
-
- % The code in this section is concerned with replacing all references
- % to one given label with a reference to another given label.
+%
+% The code in this section is concerned with replacing all references
+% to one given label with a reference to another given label.
replace_labels_instruction_list([], _, _, []).
-replace_labels_instruction_list([Instr0 | Instrs0], ReplMap,
- ReplData, [Instr | Instrs]) :-
+replace_labels_instruction_list([Instr0 | Instrs0], ReplMap, ReplData,
+ [Instr | Instrs]) :-
replace_labels_instruction(Instr0, ReplMap, ReplData, Instr),
- replace_labels_instruction_list(Instrs0, ReplMap, ReplData,
- Instrs).
+ replace_labels_instruction_list(Instrs0, ReplMap, ReplData, Instrs).
replace_labels_instruction(Instr0 - Comment, ReplMap, ReplData,
Instr - Comment) :-
@@ -1660,8 +1655,7 @@
replace_labels_instr(livevals(Livevals), _, _, livevals(Livevals)).
replace_labels_instr(block(R, F, Instrs0), ReplMap, ReplData,
block(R, F, Instrs)) :-
- replace_labels_instruction_list(Instrs0, ReplMap, ReplData,
- Instrs).
+ replace_labels_instruction_list(Instrs0, ReplMap, ReplData, Instrs).
replace_labels_instr(assign(Lval0, Rval0), ReplMap, ReplData,
assign(Lval, Rval)) :-
(
@@ -1682,8 +1676,7 @@
ReplData = yes,
(
MaybeRedoip0 = yes(Redoip0),
- replace_labels_code_addr(Redoip0, ReplMap,
- Redoip),
+ replace_labels_code_addr(Redoip0, ReplMap, Redoip),
MaybeRedoip = yes(Redoip)
;
MaybeRedoip0 = no,
@@ -1695,11 +1688,10 @@
).
replace_labels_instr(label(Label), ReplMap, _, label(Label)) :-
( map__search(ReplMap, Label, _) ->
- % The reason why we are replacing references to this label
- % is that it is being eliminated, and in fact should have been
- % already eliminated by the time replace_labels_instr
- % is called.
- error("eliminated label in replace_labels_instr")
+ % The reason why we are replacing references to this label is that
+ % it is being eliminated, and in fact should have been already
+ % eliminated by the time replace_labels_instr is called.
+ unexpected(this_file, "eliminated label in replace_labels_instr")
;
true
).
@@ -1826,8 +1818,7 @@
;
MaybeFix = yes(FixLabel0),
replace_labels_label(FixLabel0, ReplMap, FixLabel),
- % We cannot replace the label in the C code string
- % itself.
+ % We cannot replace the label in the C code string itself.
require(unify(FixLabel0, FixLabel),
"trying to replace Mercury label in C code")
),
@@ -1835,10 +1826,8 @@
MaybeLayout = no
;
MaybeLayout = yes(LayoutLabel0),
- replace_labels_label(LayoutLabel0, ReplMap,
- LayoutLabel),
- % We cannot replace a label that has a layout
- % structure.
+ replace_labels_label(LayoutLabel0, ReplMap, LayoutLabel),
+ % We cannot replace a label that has a layout structure.
require(unify(LayoutLabel0, LayoutLabel),
"trying to replace Mercury label with layout")
),
@@ -1846,10 +1835,8 @@
MaybeOnlyLayout = no
;
MaybeOnlyLayout = yes(OnlyLayoutLabel0),
- replace_labels_label(OnlyLayoutLabel0, ReplMap,
- OnlyLayoutLabel),
- % We cannot replace a label that has a layout
- % structure.
+ replace_labels_label(OnlyLayoutLabel0, ReplMap, OnlyLayoutLabel),
+ % We cannot replace a label that has a layout structure.
require(unify(OnlyLayoutLabel0, OnlyLayoutLabel),
"trying to replace Mercury label with layout")
),
@@ -1879,8 +1866,8 @@
replace_labels_comp(pragma_c_outputs(A), _, pragma_c_outputs(A)).
replace_labels_comp(pragma_c_user_code(A, B), _,
pragma_c_user_code(A, B)).
-replace_labels_comp(pragma_c_raw_code(A, B), _,
- pragma_c_raw_code(A, B)).
+replace_labels_comp(pragma_c_raw_code(A, B, C), _,
+ pragma_c_raw_code(A, B, C)).
replace_labels_comp(pragma_c_fail_to(Label0), ReplMap,
pragma_c_fail_to(Label)) :-
replace_labels_label(Label0, ReplMap, Label).
@@ -1999,4 +1986,9 @@
).
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "opt_util.m".
+
%-----------------------------------------------------------------------------%
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.47
diff -u -b -r1.47 optimize.m
--- compiler/optimize.m 25 Aug 2005 03:19:47 -0000 1.47
+++ compiler/optimize.m 4 Sep 2005 04:47:32 -0000
@@ -56,7 +56,9 @@
:- import_module parse_tree__prog_out.
:- import_module bool.
+:- import_module char.
:- import_module counter.
+:- import_module dir.
:- import_module int.
:- import_module map.
:- import_module require.
@@ -71,7 +73,7 @@
some [!OptDebugInfo, !C, !Instrs] (
CProc0 = c_procedure(Name, Arity, PredProcId, !:Instrs,
ProcLabel, !:C, MayAlterRtti),
- optimize__init_opt_debug_info(Name, Arity, PredProcId,
+ optimize__init_opt_debug_info(Name, Arity, PredProcId, ProcLabel,
!.Instrs, !.C, !:OptDebugInfo, !IO),
globals__io_lookup_int_option(optimize_repeat, Repeat, !IO),
(
@@ -92,7 +94,8 @@
!OptDebugInfo, !Instrs, !IO),
optimize__middle(yes, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
!OptDebugInfo, !Instrs, !IO),
- optimize__last(LayoutLabelSet, !.C, !.OptDebugInfo, !Instrs, !IO),
+ optimize__last(LayoutLabelSet, ProcLabel, !.C, !.OptDebugInfo, !Instrs,
+ !IO),
CProc = c_procedure(Name, Arity, PredProcId, !.Instrs, ProcLabel,
!.C, MayAlterRtti)
).
@@ -105,17 +108,22 @@
:- type opt_debug_info
---> opt_debug_info(
- string, % base file name
- int % last file number written
+ string, % Base file name for the dump files.
+ int, % The number of the last dump file written.
+ int, % The number of the last dump file written
+ % that has the instruction sequence in it.
+ list(instruction)
+ % The instruction sequence at the time the
+ % last dump file was written.
)
; no_opt_debug_info.
:- pred optimize__init_opt_debug_info(string::in, int::in, pred_proc_id::in,
- list(instruction)::in, counter::in, opt_debug_info::out,
+ proc_label::in, list(instruction)::in, counter::in, opt_debug_info::out,
io::di, io::uo) is det.
-optimize__init_opt_debug_info(Name, Arity, PredProcId, Instrs0, Counter,
- OptDebugInfo, !IO) :-
+optimize__init_opt_debug_info(Name, Arity, PredProcId, ProcLabel, Instrs0,
+ Counter, OptDebugInfo, !IO) :-
globals__io_lookup_bool_option(debug_opt, DebugOpt, !IO),
globals__io_lookup_int_option(debug_opt_pred_id, DebugOptPredId, !IO),
PredProcId = proc(PredId, ProcId),
@@ -125,43 +133,56 @@
DebugOpt = yes,
( DebugOptPredId >= 0 => DebugOptPredId = PredIdInt )
->
- MangledName = name_mangle(Name),
- string__int_to_string(Arity, ArityStr),
- string__int_to_string(PredIdInt, PredIdStr),
- string__int_to_string(ProcIdInt, ProcIdStr),
- BaseName = MangledName ++ "_" ++ ArityStr ++ ".pred" ++ PredIdStr
- ++ ".proc" ++ ProcIdStr,
- OptDebugInfo = opt_debug_info(BaseName, 0),
+ BaseName = opt_subdir_name ++ "/"
+ ++ mangle_name_as_filename(Name) ++ "_" ++ int_to_string(Arity)
+ ++ ".pred" ++ int_to_string(PredIdInt)
+ ++ ".proc" ++ int_to_string(ProcIdInt),
+ OptDebugInfo = opt_debug_info(BaseName, 0, 0, Instrs0),
- string__append_list([BaseName, ".opt0"], FileName),
+ io__call_system("mkdir -p " ++ opt_subdir_name, MkdirRes, !IO),
+ ( MkdirRes = ok(0) ->
+ true
+ ;
+ error("cannot make " ++ opt_subdir_name)
+ ),
+ FileName = BaseName ++ ".opt0",
io__open_output(FileName, Res, !IO),
( Res = ok(FileStream) ->
io__set_output_stream(FileStream, OutputStream, !IO),
counter__allocate(NextLabel, Counter, _),
opt_debug__msg(yes, NextLabel, "before optimization", !IO),
- opt_debug__maybe_dump_instrs(yes, Instrs0, !IO),
+ opt_debug__maybe_dump_instrs(yes, ProcLabel, Instrs0, !IO),
io__set_output_stream(OutputStream, _, !IO),
io__close_output(FileStream, !IO)
;
- string__append("cannot open ", FileName, ErrorMsg),
- error(ErrorMsg)
+ error("cannot open " ++ FileName)
)
;
OptDebugInfo = no_opt_debug_info
).
+:- func opt_subdir_name = string.
+
+opt_subdir_name = "OptSubdir".
+
:- pred optimize__maybe_opt_debug(list(instruction)::in, counter::in,
- string::in, opt_debug_info::in, opt_debug_info::out, io::di, io::uo)
- is det.
+ string::in, proc_label::in, opt_debug_info::in, opt_debug_info::out,
+ io::di, io::uo) is det.
-optimize__maybe_opt_debug(Instrs, Counter, Msg, OptDebugInfo0, OptDebugInfo,
+optimize__maybe_opt_debug(Instrs, Counter, Msg, ProcLabel, !OptDebugInfo,
!IO) :-
(
- OptDebugInfo0 = opt_debug_info(BaseName, OptNum0),
+ !.OptDebugInfo = opt_debug_info(BaseName, OptNum0, PrevNum,
+ PrevInstrs),
+ ( Instrs = PrevInstrs ->
+ Same = yes
+ ;
+ Same = no
+ ),
OptNum = OptNum0 + 1,
- string__int_to_string(OptNum0, OptNum0Str),
+ string__int_to_string(PrevNum, PrevNumStr),
string__int_to_string(OptNum, OptNumStr),
- OptFileName0 = BaseName ++ ".opt" ++ OptNum0Str,
+ PrevFileName = BaseName ++ ".opt" ++ PrevNumStr,
OptFileName = BaseName ++ ".opt" ++ OptNumStr,
DiffFileName = BaseName ++ ".diff" ++ OptNumStr,
io__open_output(OptFileName, Res, !IO),
@@ -169,23 +190,34 @@
io__set_output_stream(FileStream, OutputStream, !IO),
counter__allocate(NextLabel, Counter, _),
opt_debug__msg(yes, NextLabel, Msg, !IO),
- opt_debug__maybe_dump_instrs(yes, Instrs, !IO),
+ (
+ Same = yes,
+ io__write_string("same as previous version\n", !IO)
+ ;
+ Same = no,
+ opt_debug__maybe_dump_instrs(yes, ProcLabel, Instrs, !IO)
+ ),
io__set_output_stream(OutputStream, _, !IO),
io__close_output(FileStream, !IO)
;
ErrorMsg = "cannot open " ++ OptFileName,
error(ErrorMsg)
),
+ (
+ Same = yes,
+ !:OptDebugInfo = opt_debug_info(BaseName, OptNum, PrevNum, Instrs)
+ ;
+ Same = no,
% Although the -u is not fully portable, it is available
% on all the systems we intend to use it on, and the main user
% of --debug-opt (zs) strongly prefers -u to -c.
- DiffCommand = "diff -u " ++ OptFileName0 ++ " " ++ OptFileName
- ++ " > " ++ DiffFileName,
+ DiffCommand = "diff -u '" ++ PrevFileName ++ "' '" ++ OptFileName
+ ++ "' > '" ++ DiffFileName ++ "'",
io__call_system(DiffCommand, _, !IO),
- OptDebugInfo = opt_debug_info(BaseName, OptNum)
+ !:OptDebugInfo = opt_debug_info(BaseName, OptNum, OptNum, Instrs)
+ )
;
- OptDebugInfo0 = no_opt_debug_info,
- OptDebugInfo = no_opt_debug_info
+ !.OptDebugInfo = no_opt_debug_info
).
%-----------------------------------------------------------------------------%
@@ -197,8 +229,7 @@
optimize__initial(LayoutLabelSet, ProcLabel, MayAlterRtti, !C, !OptDebugInfo,
!Instrs, !IO) :-
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
- opt_util__find_first_label(!.Instrs, Label),
- opt_util__format_label(Label, LabelStr),
+ LabelStr = opt_util__format_proc_label(ProcLabel),
globals__io_lookup_bool_option(optimize_frames, FrameOpt, !IO),
(
@@ -214,7 +245,7 @@
frameopt_nondet(ProcLabel, LayoutLabelSet, MayAlterRtti, !C, !Instrs,
_Mod),
optimize__maybe_opt_debug(!.Instrs, !.C, "after nondet frame opt",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
FrameOpt = no
).
@@ -260,8 +291,7 @@
optimize__repeated(Final, LayoutLabelSet, ProcLabel, MayAlterRtti,
!C, !OptDebugInfo, !Instrs, Mod, !IO) :-
InstrsAtStart = !.Instrs,
- opt_util__find_first_label(!.Instrs, Label),
- proc_label_to_c_string(get_proc_label(Label), no) = LabelStr,
+ LabelStr = opt_util__format_proc_label(ProcLabel),
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
globals__io_lookup_bool_option(optimize_jumps, Jumpopt, !IO),
globals__io_lookup_bool_option(optimize_fulljumps, FullJumpopt, !IO),
@@ -283,7 +313,7 @@
Final, PessimizeTailCalls, CheckedNondetTailCalls, !C, !Instrs,
Mod1),
optimize__maybe_opt_debug(!.Instrs, !.C, "after jump opt",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
Jumpopt = no,
Mod1 = no
@@ -302,7 +332,7 @@
globals__io_get_gc_method(GC_Method, !IO),
peephole__optimize(GC_Method, !Instrs, Mod2),
optimize__maybe_opt_debug(!.Instrs, !.C, "after peephole",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
Peephole = no,
Mod2 = no
@@ -320,7 +350,7 @@
),
labelopt_main(Final, LayoutLabelSet, !Instrs, Mod3),
optimize__maybe_opt_debug(!.Instrs, !.C, "after label opt",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
LabelElim = no,
Mod3 = no
@@ -338,7 +368,7 @@
),
dupelim_main(ProcLabel, !C, !Instrs),
optimize__maybe_opt_debug(!.Instrs, !.C, "after duplicates",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
DupElim = no
),
@@ -358,8 +388,7 @@
optimize__middle(Final, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
!OptDebugInfo, !Instrs, !IO) :-
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
- opt_util__find_first_label(!.Instrs, Label),
- opt_util__format_label(Label, LabelStr),
+ LabelStr = opt_util__format_proc_label(ProcLabel),
globals__io_lookup_bool_option(optimize_frames, FrameOpt, !IO),
(
@@ -375,7 +404,7 @@
globals__io_get_globals(Globals, !IO),
frameopt_main(ProcLabel, !C, !Instrs, Globals, Mod1),
optimize__maybe_opt_debug(!.Instrs, !.C, "after frame opt",
- !OptDebugInfo, !IO),
+ ProcLabel, !OptDebugInfo, !IO),
globals__io_lookup_bool_option(optimize_fulljumps, FullJumpopt, !IO),
globals__io_lookup_bool_option(pessimize_tailcalls,
PessimizeTailCalls, !IO),
@@ -398,7 +427,7 @@
Final, PessimizeTailCalls, CheckedNondetTailCalls, !C, !Instrs,
_Mod2),
optimize__maybe_opt_debug(!.Instrs, !.C, "after jumps",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
true
),
@@ -414,7 +443,7 @@
),
labelopt_main(Final, LayoutLabelSet, !Instrs, _Mod3),
optimize__maybe_opt_debug(!.Instrs, !.C, "after labels",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
Mod1 = no
)
@@ -435,21 +464,22 @@
globals__io_lookup_int_option(num_real_r_regs, NumRealRRegs, !IO),
globals__io_lookup_int_option(local_var_access_threshold,
AccessThreshold, !IO),
- use_local_vars__main(!Instrs, ProcLabel, NumRealRRegs,
- AccessThreshold, !C),
- optimize__maybe_opt_debug(!.Instrs, !.C,
- "after use_local_vars", !OptDebugInfo, !IO)
+ globals__io_lookup_bool_option(auto_comments, AutoComments, !IO),
+ use_local_vars__main(!Instrs, NumRealRRegs, AccessThreshold,
+ AutoComments, ProcLabel, !C),
+ optimize__maybe_opt_debug(!.Instrs, !.C, "after use_local_vars",
+ ProcLabel, !OptDebugInfo, !IO)
;
UseLocalVars = no
).
-:- pred optimize__last(set(label)::in, counter::in, opt_debug_info::in,
- list(instruction)::in, list(instruction)::out, io::di, io::uo) is det.
+:- pred optimize__last(set(label)::in, proc_label::in, counter::in,
+ opt_debug_info::in, list(instruction)::in, list(instruction)::out,
+ io::di, io::uo) is det.
-optimize__last(LayoutLabelSet, C, !.OptDebugInfo, !Instrs, !IO) :-
+optimize__last(LayoutLabelSet, ProcLabel, C, !.OptDebugInfo, !Instrs, !IO) :-
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
- opt_util__find_first_label(!.Instrs, Label),
- opt_util__format_label(Label, LabelStr),
+ LabelStr = opt_util__format_proc_label(ProcLabel),
globals__io_lookup_bool_option(optimize_reassign, Reassign, !IO),
globals__io_lookup_bool_option(optimize_delay_slot, DelaySlot, !IO),
@@ -472,7 +502,7 @@
),
labelopt_main(no, LayoutLabelSet, !Instrs, _Mod1),
optimize__maybe_opt_debug(!.Instrs, C, "after label opt",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
true
),
@@ -488,7 +518,7 @@
),
remove_reassign(!Instrs),
optimize__maybe_opt_debug(!.Instrs, C, "after reassign",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
Reassign = no
),
@@ -504,7 +534,7 @@
),
fill_branch_delay_slot(!Instrs),
optimize__maybe_opt_debug(!.Instrs, C, "after delay slots",
- !OptDebugInfo, !IO)
+ ProcLabel, !OptDebugInfo, !IO)
;
DelaySlot = no
),
@@ -520,7 +550,28 @@
),
wrap_blocks(!Instrs),
optimize__maybe_opt_debug(!.Instrs, C, "after wrap blocks",
- !.OptDebugInfo, _OptDebugInfo, !IO)
+ ProcLabel, !.OptDebugInfo, _OptDebugInfo, !IO)
;
UseLocalVars = no
).
+
+%-----------------------------------------------------------------------------%
+
+ % Mangle the given name just sufficiently to make it acceptable as a
+ % filename.
+ %
+:- func mangle_name_as_filename(string) = string.
+
+mangle_name_as_filename(Str0) = Str :-
+ string__foldl(escape_dir_char, Str0, "", Str).
+
+:- pred escape_dir_char(char::in, string::in, string::out) is det.
+
+escape_dir_char(Char, !Str) :-
+ ( dir__is_directory_separator(Char) ->
+ !:Str = !.Str ++ "_slash_"
+ ;
+ !:Str = !.Str ++ char_to_string(Char)
+ ).
+
+%-----------------------------------------------------------------------------%
Index: compiler/peephole.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/peephole.m,v
retrieving revision 1.83
diff -u -b -r1.83 peephole.m
--- compiler/peephole.m 25 Aug 2005 03:19:48 -0000 1.83
+++ compiler/peephole.m 2 Sep 2005 09:27:02 -0000
@@ -225,6 +225,13 @@
% These two classes of patterns are mutually exclusive because if_val
% is not straight-line code.
%
+ % We also look for the following pattern, which can happen when predicates
+ % that are actually semidet are declared to be nondet:
+ %
+ % mkframe(NFI, dofail)
+ % <straight,nostack instrs> => <straight,nostack instrs>
+ % succeed proceed
+ %
peephole__match(mkframe(NondetFrameInfo, yes(Redoip1)), Comment, _,
Instrs0, Instrs) :-
(
@@ -239,7 +246,7 @@
Skipped, Rest),
opt_util__touches_nondet_ctrl(Skipped, no)
->
- list__append(Skipped, Rest, Instrs1),
+ Instrs1 = Skipped ++ Rest,
Instrs = [mkframe(NondetFrameInfo, yes(Redoip2)) - Comment | Instrs1]
;
opt_util__skip_comments_livevals(Instrs0, Instrs1),
@@ -249,7 +256,7 @@
Redoip1 = do_fail,
( Target = do_redo ; Target = do_fail)
->
- Instrs = [
+ InstrsPrime = [
if_val(Test, do_redo) - Comment2,
mkframe(NondetFrameInfo, yes(do_fail)) - Comment
| Instrs2
@@ -260,7 +267,7 @@
(
Target = do_fail
->
- Instrs = [
+ InstrsPrime = [
if_val(Test, do_redo) - Comment2,
mkframe(NondetFrameInfo, yes(Redoip1)) - Comment
| Instrs2
@@ -268,7 +275,7 @@
;
Target = do_redo
->
- Instrs = [
+ InstrsPrime = [
mkframe(NondetFrameInfo, yes(Redoip1)) - Comment,
if_val(Test, Redoip1) - Comment2
| Instrs2
@@ -279,6 +286,18 @@
;
fail
)
+ ->
+ Instrs = InstrsPrime
+ ;
+ Redoip1 = do_fail,
+ no_stack_straight_line(Instrs0, Straight, Instrs1),
+ Instrs1 = [Instr1 | Instrs2],
+ Instr1 = goto(do_succeed(_)) - _
+ ->
+ GotoSuccip = goto(succip) - "return from optimized away mkframe",
+ Instrs = Straight ++ [GotoSuccip | Instrs2]
+ ;
+ fail
).
% If a `store_ticket' is followed by a `reset_ticket',
@@ -314,7 +333,7 @@
Skipped, Rest),
opt_util__touches_nondet_ctrl(Skipped, no)
->
- list__append(Skipped, Rest, Instrs1),
+ Instrs1 = Skipped ++ Rest,
Instrs = [assign(redoip(lval(Base)),
const(code_addr_const(Redoip2))) - Comment | Instrs1]
;
@@ -346,7 +365,7 @@
peephole__match(incr_sp(N, _), _, InvalidPatterns, Instrs0, Instrs) :-
\+ list__member(incr_sp, InvalidPatterns),
( opt_util__no_stackvars_til_decr_sp(Instrs0, N, Between, Remain) ->
- list__append(Between, Remain, Instrs)
+ Instrs = Between ++ Remain
;
fail
).
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.79
diff -u -b -r1.79 pragma_c_gen.m
--- compiler/pragma_c_gen.m 29 Jun 2005 05:24:00 -0000 1.79
+++ compiler/pragma_c_gen.m 3 Sep 2005 13:19:25 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1996-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -303,55 +305,50 @@
%
% Notes:
%
-% (1) These parts are only emitted if the C code may call Mercury.
-% If a pragma c_code(will_not_call_mercury, ...) declaration was used,
-% they will not be emitted.
-%
-% (2) The call to MR_save_registers() is needed so that if the
-% C code calls Mercury code, we can call MR_restore_registers()
-% on entry to the Mercury code (see export.m) to get the
-% right values of `sp', `hp', `curfr' and `maxfr' for the
-% recursive invocation of Mercury.
-%
-% (3) The call to MR_restore_registers() is needed in case the
-% C code calls Mercury code which allocates some data
-% on the heap, and this data is returned from Mercury
-% through C back to Mercury. In that case, we need to
-% keep the value of `hp' that was set by the recursive
-% invocation of Mercury. The Mercury calling convention
-% guarantees that when calling det or semidet code, the values
-% of `sp', `curfr', and `maxfr' will be preserved, so if we're
-% using conservative gc, there is nothing that needs restoring.
-%
-% When calling nondet code, maxfr may be changed. This is why
-% we must call MR_restore_registers() from the code we generate for
-% nondet pragma C codes even if we are not using conservative gc.
-%
-% (4) These labels and the code following them can be optimized away
-% by the C compiler if the macro that branches to them is not invoked
-% in the preceding body of included C code. We cannot optimize them
-% away ourselves, since these macros can be invoked from other macros,
-% and thus we do not have a sure test of whether the code fragments
-% invoke the macros.
-%
-% (5) We insert a #define for MR_PROC_LABEL, so that the C code in the
-% Mercury standard library that allocates memory manually can use
-% MR_PROC_LABEL as the procname argument to incr_hp_msg(), for memory
-% profiling. Hard-coding the procname argument in the C code would
-% be wrong, since it wouldn't handle the case where the original
-% pragma c_code procedure gets inlined and optimized away.
-% Of course we also need to #undef it afterwards.
+% 1 These parts are only emitted if the C code may call Mercury. If the pragma
+% foreign_proc had a will_not_call_mercury annotation, they will not be
+% emitted.
+%
+% 2 The call to MR_save_registers() is needed so that if the C code calls
+% Mercury code, we can call MR_restore_registers() on entry to the Mercury
+% code (see export.m) to get the right values of `sp', `hp', `curfr' and
+% `maxfr' for the recursive invocation of Mercury.
+%
+% 3 The call to MR_restore_registers() is needed in case the C code calls
+% Mercury code which allocates some data on the heap, and this data is
+% returned from Mercury through C back to Mercury. In that case, we need
+% to keep the value of `hp' that was set by the recursive invocation of
+% Mercury. The Mercury calling convention guarantees that when calling det
+% or semidet code, the values of `sp', `curfr', and `maxfr' will be
+% preserved, so if we're using conservative gc, there is nothing that
+% needs restoring.
+%
+% When calling nondet code, maxfr may be changed. This is why we must call
+% MR_restore_registers() from the code we generate for nondet pragma C codes
+% even if we are not using conservative gc.
+%
+% 4 These labels and the code following them can be optimized away by the C
+% compiler if the macro that branches to them is not invoked in the preceding
+% body of included C code. We cannot optimize them away ourselves, since
+% these macros can be invoked from other macros, and thus we do not have
+% a sure test of whether the code fragments invoke the macros.
+%
+% 5 We insert a #define for MR_PROC_LABEL, so that the C code in the Mercury
+% standard library that allocates memory manually can use MR_PROC_LABEL as
+% the procname argument to incr_hp_msg(), for memory profiling. Hard-coding
+% the procname argument in the C code would be wrong, since it wouldn't
+% handle the case where the original pragma c_code procedure gets inlined
+% and optimized away. Of course we also need to #undef it afterwards.
pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes, PredId, ProcId,
Args, ExtraArgs, GoalInfo, PragmaImpl, Code, !CI) :-
(
PragmaImpl = ordinary(C_Code, Context),
pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, Args, ExtraArgs, C_Code, Context,
- GoalInfo, Code, !CI)
+ PredId, ProcId, Args, ExtraArgs, C_Code, Context, GoalInfo,
+ Code, !CI)
;
- PragmaImpl = nondet(
- Fields, FieldsContext, First, FirstContext,
+ PragmaImpl = nondet(Fields, FieldsContext, First, FirstContext,
Later, LaterContext, Treat, Shared, SharedContext),
require(unify(ExtraArgs, []),
"generate_pragma_c_code: extra args nondet"),
@@ -363,11 +360,10 @@
PragmaImpl = import(Name, HandleReturn, Vars, Context),
require(unify(ExtraArgs, []),
"generate_pragma_c_code: extra args import"),
- C_Code = string__append_list([HandleReturn, " ",
- Name, "(", Vars, ");"]),
+ C_Code = HandleReturn ++ " " ++ Name ++ "(" ++ Vars ++ ");",
pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, Args, ExtraArgs, C_Code, Context,
- GoalInfo, Code, !CI)
+ PredId, ProcId, Args, ExtraArgs, C_Code, Context, GoalInfo,
+ Code, !CI)
).
%---------------------------------------------------------------------------%
@@ -380,25 +376,23 @@
pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes, PredId, ProcId,
Args, ExtraArgs, C_Code, Context, GoalInfo, Code, !CI) :-
-
- %
- % Extract the attributes
- %
+ % Extract the attributes.
MayCallMercury = may_call_mercury(Attributes),
ThreadSafe = thread_safe(Attributes),
%
% The maybe_thread_safe attribute should have been changed
% to the real value by now.
%
- ( ThreadSafe = maybe_thread_safe ->
- unexpected(this_file, "ordinary_pragma_c_code/12: " ++
- "maybe_thread_safe encountered.")
+ (
+ ThreadSafe = thread_safe
;
- true
+ ThreadSafe = maybe_thread_safe,
+ unexpected(this_file,
+ "ordinary_pragma_c_code: maybe_thread_safe encountered.")
+ ;
+ ThreadSafe = not_thread_safe
),
- %
- % First we need to get a list of input and output arguments
- %
+ % First we need to get a list of input and output arguments.
ArgInfos = code_info__get_pred_proc_arginfo(!.CI, PredId, ProcId),
make_c_arg_list(Args, ArgInfos, OrigCArgs),
code_info__get_module_info(!.CI, ModuleInfo),
@@ -469,50 +463,40 @@
%
(
MayCallMercury = will_not_call_mercury,
- SaveRegsComp = pragma_c_raw_code("",
+ SaveRegsComp = pragma_c_raw_code("", cannot_branch_away,
live_lvals_info(set__init))
;
MayCallMercury = may_call_mercury,
- SaveRegsComp = pragma_c_raw_code(
- "\tMR_save_registers();\n",
- live_lvals_info(set__init))
+ SaveRegsComp = pragma_c_raw_code("\tMR_save_registers();\n",
+ cannot_branch_away, live_lvals_info(set__init))
),
- %
- % Code fragments to obtain and release the global lock
- %
+ % Code fragments to obtain and release the global lock.
(
ThreadSafe = thread_safe,
- ObtainLock = pragma_c_raw_code("", live_lvals_info(set__init)),
- ReleaseLock = pragma_c_raw_code("", live_lvals_info(set__init))
+ ObtainLock = pragma_c_raw_code("", cannot_branch_away,
+ live_lvals_info(set__init)),
+ ReleaseLock = pragma_c_raw_code("", cannot_branch_away,
+ live_lvals_info(set__init))
;
ThreadSafe = not_thread_safe,
module_info_pred_info(ModuleInfo, PredId, PredInfo),
Name = pred_info_name(PredInfo),
c_util__quote_string(Name, MangledName),
- string__append_list(["\tMR_OBTAIN_GLOBAL_LOCK(""",
- MangledName, """);\n"], ObtainLockStr),
- ObtainLock = pragma_c_raw_code(ObtainLockStr,
+ ObtainLockStr = "\tMR_OBTAIN_GLOBAL_LOCK("""
+ ++ MangledName ++ """);\n",
+ ObtainLock = pragma_c_raw_code(ObtainLockStr, cannot_branch_away,
live_lvals_info(set__init)),
- string__append_list(["\tMR_RELEASE_GLOBAL_LOCK(""",
- MangledName, """);\n"], ReleaseLockStr),
- ReleaseLock = pragma_c_raw_code(ReleaseLockStr,
+ ReleaseLockStr = "\tMR_RELEASE_GLOBAL_LOCK("""
+ ++ MangledName ++ """);\n",
+ ReleaseLock = pragma_c_raw_code(ReleaseLockStr, cannot_branch_away,
live_lvals_info(set__init))
-
- ;
- ThreadSafe = maybe_thread_safe,
- unexpected(this_file, "ordinary_pragma_c_code/12: " ++
- "maybe_thread_safe encountered.")
),
- %
% <The C code itself>
- %
C_Code_Comp = pragma_c_user_code(Context, C_Code),
- %
% <for semidet code, check of SUCCESS_INDICATOR>
- %
goal_info_get_determinism(GoalInfo, Detism),
( CodeModel = model_semi ->
( Detism = failure ->
@@ -528,25 +512,23 @@
"#undef SUCCESS_INDICATOR\n" ++
"#define SUCCESS_INDICATOR " ++
pragma_succ_ind_name ++ "\n",
- live_lvals_info(set__init)),
+ cannot_branch_away, live_lvals_info(set__init)),
UndefSuccessComp = pragma_c_raw_code(
"#undef SUCCESS_INDICATOR\n" ++
"#define SUCCESS_INDICATOR MR_r1\n",
- live_lvals_info(set__init))
+ cannot_branch_away, live_lvals_info(set__init))
;
CheckSuccess_Comp = pragma_c_noop,
MaybeFailLabel = no,
- DefSuccessComp = pragma_c_raw_code("",
+ DefSuccessComp = pragma_c_raw_code("", cannot_branch_away,
live_lvals_info(set__init)),
- UndefSuccessComp = pragma_c_raw_code("",
+ UndefSuccessComp = pragma_c_raw_code("", cannot_branch_away,
live_lvals_info(set__init))
),
- %
% #ifndef MR_CONSERVATIVE_GC
% MR_restore_registers(); /* see notes (1) and (3) above */
% #endif
- %
(
MayCallMercury = will_not_call_mercury,
RestoreRegsComp = pragma_c_noop
@@ -555,15 +537,13 @@
RestoreRegsComp = pragma_c_raw_code(
"#ifndef MR_CONSERVATIVE_GC\n\t" ++
"MR_restore_registers();\n#endif\n",
- live_lvals_info(set__init)
+ cannot_branch_away, live_lvals_info(set__init)
)
),
- %
% The C code may have called Mercury code which clobbered the regs,
% in which case we need to tell the code_info that they have been
% clobbered.
- %
(
MayCallMercury = will_not_call_mercury
;
@@ -577,16 +557,12 @@
code_info__clear_all_registers(OkToDelete, !CI)
),
- %
% <assignment of the output values from local variables to registers>
- %
pragma_acquire_regs(OutCArgs, Regs, !CI),
place_pragma_output_args_in_regs(OutCArgs, Regs, OutputDescs, !CI),
OutputComp = pragma_c_outputs(OutputDescs),
- %
- % join all the components of the pragma_c together
- %
+ % Join all the components of the pragma_c together.
Components = [ProcLabelHashDefine, DefSuccessComp, InputComp,
SaveRegsComp, ObtainLock, C_Code_Comp, ReleaseLock,
CheckSuccess_Comp, RestoreRegsComp,
@@ -604,7 +580,6 @@
- "Pragma C inclusion"
]),
- %
% for semidet code, we need to insert the failure handling code here:
%
% goto skip_label;
@@ -616,7 +591,7 @@
% handling code here:
%
% <code to fail>
- %
+
( MaybeFailLabel = yes(TheFailLabel) ->
code_info__get_next_label(SkipLabel, !CI),
code_info__generate_failure(FailCode, !CI),
@@ -633,11 +608,8 @@
FailureCode = empty
),
- %
- % join all code fragments together
- %
- Code = tree_list([SaveVarsCode, InputVarsCode, PragmaCCode,
- FailureCode]).
+ % Join all code fragments together.
+ Code = tree_list([SaveVarsCode, InputVarsCode, PragmaCCode, FailureCode]).
:- pred make_proc_label_hash_define(module_info::in, pred_id::in, proc_id::in,
pragma_c_component::out, pragma_c_component::out) is det.
@@ -647,9 +619,9 @@
ProcLabelHashDef = pragma_c_raw_code(string__append_list([
"#define\tMR_PROC_LABEL\t",
make_proc_label_string(ModuleInfo, PredId, ProcId), "\n"]),
- live_lvals_info(set__init)),
+ cannot_branch_away, live_lvals_info(set__init)),
ProcLabelHashUndef = pragma_c_raw_code("#undef\tMR_PROC_LABEL\n",
- live_lvals_info(set__init)).
+ cannot_branch_away, live_lvals_info(set__init)).
:- func make_proc_label_string(module_info, pred_id, proc_id) = string.
@@ -660,7 +632,7 @@
; CodeAddr = label(Label) ->
ProcLabelString = label_to_c_string(Label, yes)
;
- error("unexpected code_addr in make_proc_label_hash_define")
+ unexpected(this_file, "code_addr in make_proc_label_hash_define")
).
%-----------------------------------------------------------------------------%
@@ -680,30 +652,22 @@
SharedContext, Code, !CI) :-
require(unify(CodeModel, model_non),
"inappropriate code model for nondet pragma C code"),
- %
- % Extract the may_call_mercury attribute
- %
+ % Extract the may_call_mercury attribute.
MayCallMercury = may_call_mercury(Attributes),
- %
% Generate #define MR_PROC_LABEL <procedure label> /* see note (5) */
- % and #undef MR_PROC_LABEL
- %
+ % and #undef MR_PROC_LABEL.
code_info__get_module_info(!.CI, ModuleInfo),
code_info__get_pred_id(!.CI, CallerPredId),
code_info__get_proc_id(!.CI, CallerProcId),
make_proc_label_hash_define(ModuleInfo, CallerPredId, CallerProcId,
ProcLabelDefine, ProcLabelUndef),
- %
- % Generate a unique prefix for the C labels that we will define
- %
+ % Generate a unique prefix for the C labels that we will define.
ProcLabelString = make_proc_label_string(ModuleInfo,
PredId, ProcId),
- %
- % Get a list of input and output arguments
- %
+ % Get a list of input and output arguments.
ArgInfos = code_info__get_pred_proc_arginfo(!.CI, PredId, ProcId),
make_c_arg_list(Args, ArgInfos, CArgs),
pragma_select_in_args(CArgs, InCArgs),
@@ -729,13 +693,11 @@
code_info__get_next_label(RetryLabel, !CI),
ModFrameCode = node([
- assign(redoip(lval(curfr)),
- const(code_addr_const(label(RetryLabel))))
+ assign(redoip(lval(curfr)), const(code_addr_const(label(RetryLabel))))
- "Set up backtracking to retry label"
]),
RetryLabelCode = node([
- label(RetryLabel) -
- "Start of the retry block"
+ label(RetryLabel) - "Start of the retry block"
]),
code_info__get_globals(!.CI, Globals),
@@ -748,9 +710,7 @@
globals__lookup_bool_option(Globals, use_trail, UseTrail),
code_info__maybe_save_ticket(UseTrail, SaveTicketCode, MaybeTicketSlot,
!CI),
- code_info__maybe_reset_ticket(MaybeTicketSlot, undo,
- RestoreTicketCode),
-
+ code_info__maybe_reset_ticket(MaybeTicketSlot, undo, RestoreTicketCode),
(
FirstContext = yes(ActualFirstContext)
;
@@ -768,18 +728,12 @@
trace__maybe_generate_pragma_event_code(nondet_pragma_later,
ActualLaterContext, LaterTraceCode, !CI),
- FirstDisjunctCode =
- tree(SaveHeapCode,
- tree(SaveTicketCode,
- FirstTraceCode)),
- LaterDisjunctCode =
- tree(RestoreHeapCode,
- tree(RestoreTicketCode,
- LaterTraceCode)),
+ FirstDisjunctCode = tree_list([SaveHeapCode, SaveTicketCode,
+ FirstTraceCode]),
+ LaterDisjunctCode = tree_list([RestoreHeapCode, RestoreTicketCode,
+ LaterTraceCode]),
- %
% MR_save_registers(); /* see notes (1) and (2) above */
- %
(
MayCallMercury = will_not_call_mercury,
SaveRegs = ""
@@ -788,9 +742,7 @@
SaveRegs = "\tMR_save_registers();\n"
),
- %
% MR_restore_registers(); /* see notes (1) and (3) above */
- %
( MayCallMercury = will_not_call_mercury ->
RestoreRegs = ""
;
@@ -827,27 +779,23 @@
Undef3 = "#undef\tFAIL\n",
(
- % Use the form that duplicates the common code
- % if the programmer asked for it, or if the code
- % is small enough for its duplication not to have
- % a significant effect on code size. (This form
- % generates slightly faster code.)
- % However, if `pragma no_inline' is specified,
- % then we don't duplicate the code unless the
- % programmer asked for it -- the code may contain
- % static variable declarations, so duplicating it
- % could change the semantics.
-
- % We use the number of semicolons in the code
- % as an indication how many C statements it has
- % and thus how big its object code is likely to be.
+ % Use the form that duplicates the common code if the programmer
+ % asked for it, or if the code is small enough for its duplication
+ % not to have a significant effect on code size. (This form generates
+ % slightly faster code.) However, if `pragma no_inline' is specified,
+ % then we don't duplicate the code unless the programmer asked for it
+ % -- the code may contain static variable declarations, so duplicating
+ % it could change the semantics.
+
+ % We use the number of semicolons in the code as an indication of
+ % how many C statements it has and thus how big its object code
+ % is likely to be.
(
Treat = duplicate
;
Treat = automatic,
\+ pred_info_requested_no_inlining(PredInfo),
- CountSemis = (pred(Char::in, Count0::in, Count::out)
- is det :-
+ CountSemis = (pred(Char::in, Count0::in, Count::out) is det :-
( Char = (;) ->
Count = Count0 + 1
;
@@ -861,26 +809,35 @@
CallDecls = [SaveStructDecl | Decls],
CallComponents = [
pragma_c_inputs(InputDescs),
- pragma_c_raw_code(InitSaveStruct, no_live_lvals_info),
- pragma_c_raw_code(SaveRegs, no_live_lvals_info),
+ pragma_c_raw_code(InitSaveStruct, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SaveRegs, cannot_branch_away,
+ no_live_lvals_info),
ProcLabelDefine,
- pragma_c_raw_code(CallDef1, no_live_lvals_info),
- pragma_c_raw_code(CallDef2, no_live_lvals_info),
- pragma_c_raw_code(CallDef3, no_live_lvals_info),
+ pragma_c_raw_code(CallDef1, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(CallDef2, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(CallDef3, cannot_branch_away,
+ no_live_lvals_info),
pragma_c_user_code(FirstContext, First),
pragma_c_user_code(SharedContext, Shared),
- pragma_c_raw_code(CallSuccessLabel, no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
+ pragma_c_raw_code(CallSuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
+ no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(Succeed, no_live_lvals_info),
- pragma_c_raw_code(CallLastSuccessLabel,
+ pragma_c_raw_code(Succeed, can_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(CallLastSuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(SucceedDiscard, no_live_lvals_info),
- pragma_c_raw_code(Undef1, no_live_lvals_info),
- pragma_c_raw_code(Undef2, no_live_lvals_info),
- pragma_c_raw_code(Undef3, no_live_lvals_info),
+ pragma_c_raw_code(SucceedDiscard, can_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(Undef1, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef2, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef3, cannot_branch_away, no_live_lvals_info),
ProcLabelUndef
],
CallBlockCode = node([
@@ -891,27 +848,35 @@
RetryDecls = [SaveStructDecl | OutDecls],
RetryComponents = [
- pragma_c_raw_code(InitSaveStruct, no_live_lvals_info),
- pragma_c_raw_code(SaveRegs, no_live_lvals_info),
+ pragma_c_raw_code(InitSaveStruct, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SaveRegs, cannot_branch_away,
+ no_live_lvals_info),
ProcLabelDefine,
- pragma_c_raw_code(RetryDef1, no_live_lvals_info),
- pragma_c_raw_code(RetryDef2, no_live_lvals_info),
- pragma_c_raw_code(RetryDef3, no_live_lvals_info),
+ pragma_c_raw_code(RetryDef1, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RetryDef2, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RetryDef3, cannot_branch_away,
+ no_live_lvals_info),
pragma_c_user_code(LaterContext, Later),
pragma_c_user_code(SharedContext, Shared),
- pragma_c_raw_code(RetrySuccessLabel,
+ pragma_c_raw_code(RetrySuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(Succeed, no_live_lvals_info),
- pragma_c_raw_code(RetryLastSuccessLabel,
+ pragma_c_raw_code(Succeed, can_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(RetryLastSuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(SucceedDiscard, no_live_lvals_info),
- pragma_c_raw_code(Undef1, no_live_lvals_info),
- pragma_c_raw_code(Undef2, no_live_lvals_info),
- pragma_c_raw_code(Undef3, no_live_lvals_info),
+ pragma_c_raw_code(SucceedDiscard, can_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(Undef1, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef2, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef3, cannot_branch_away, no_live_lvals_info),
ProcLabelUndef
],
RetryBlockCode = node([
@@ -920,18 +885,12 @@
- "Retry and shared pragma C inclusion"
]),
- Code =
- tree(ModFrameCode,
- tree(FirstDisjunctCode,
- tree(CallBlockCode,
- tree(RetryLabelCode,
- tree(LaterDisjunctCode,
- RetryBlockCode)))))
+ Code = tree_list([ModFrameCode, FirstDisjunctCode, CallBlockCode,
+ RetryLabelCode, LaterDisjunctCode, RetryBlockCode])
;
code_info__get_next_label(SharedLabel, !CI),
SharedLabelCode = node([
- label(SharedLabel) -
- "Start of the shared block"
+ label(SharedLabel) - "Start of the shared block"
]),
SharedDef1 =
@@ -954,27 +913,36 @@
CallDecls = [SaveStructDecl | Decls],
CallComponents = [
pragma_c_inputs(InputDescs),
- pragma_c_raw_code(InitSaveStruct, no_live_lvals_info),
- pragma_c_raw_code(SaveRegs, no_live_lvals_info),
+ pragma_c_raw_code(InitSaveStruct, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SaveRegs, cannot_branch_away,
+ no_live_lvals_info),
ProcLabelDefine,
- pragma_c_raw_code(CallDef1, no_live_lvals_info),
- pragma_c_raw_code(CallDef2, no_live_lvals_info),
- pragma_c_raw_code(CallDef3, no_live_lvals_info),
+ pragma_c_raw_code(CallDef1, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(CallDef2, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(CallDef3, cannot_branch_away,
+ no_live_lvals_info),
pragma_c_user_code(FirstContext, First),
- pragma_c_raw_code(GotoSharedLabel, no_live_lvals_info),
- pragma_c_raw_code(CallSuccessLabel,
+ pragma_c_raw_code(GotoSharedLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(CallSuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(Succeed, no_live_lvals_info),
- pragma_c_raw_code(CallLastSuccessLabel,
+ pragma_c_raw_code(Succeed, can_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(CallLastSuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(SucceedDiscard, no_live_lvals_info),
- pragma_c_raw_code(Undef1, no_live_lvals_info),
- pragma_c_raw_code(Undef2, no_live_lvals_info),
- pragma_c_raw_code(Undef3, no_live_lvals_info),
+ pragma_c_raw_code(SucceedDiscard, can_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(Undef1, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef2, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef3, cannot_branch_away, no_live_lvals_info),
ProcLabelUndef
],
CallBlockCode = node([
@@ -985,27 +953,36 @@
RetryDecls = [SaveStructDecl | OutDecls],
RetryComponents = [
- pragma_c_raw_code(InitSaveStruct, no_live_lvals_info),
- pragma_c_raw_code(SaveRegs, no_live_lvals_info),
+ pragma_c_raw_code(InitSaveStruct, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SaveRegs, cannot_branch_away,
+ no_live_lvals_info),
ProcLabelDefine,
- pragma_c_raw_code(RetryDef1, no_live_lvals_info),
- pragma_c_raw_code(RetryDef2, no_live_lvals_info),
- pragma_c_raw_code(RetryDef3, no_live_lvals_info),
+ pragma_c_raw_code(RetryDef1, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RetryDef2, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RetryDef3, cannot_branch_away,
+ no_live_lvals_info),
pragma_c_user_code(LaterContext, Later),
- pragma_c_raw_code(GotoSharedLabel, no_live_lvals_info),
- pragma_c_raw_code(RetrySuccessLabel,
+ pragma_c_raw_code(GotoSharedLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RetrySuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(Succeed, no_live_lvals_info),
- pragma_c_raw_code(RetryLastSuccessLabel,
+ pragma_c_raw_code(Succeed, can_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(RetryLastSuccessLabel, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(SucceedDiscard, no_live_lvals_info),
- pragma_c_raw_code(Undef1, no_live_lvals_info),
- pragma_c_raw_code(Undef2, no_live_lvals_info),
- pragma_c_raw_code(Undef3, no_live_lvals_info),
+ pragma_c_raw_code(SucceedDiscard, can_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(Undef1, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef2, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef3, cannot_branch_away, no_live_lvals_info),
ProcLabelUndef
],
RetryBlockCode = node([
@@ -1016,26 +993,34 @@
SharedDecls = [SaveStructDecl | OutDecls],
SharedComponents = [
- pragma_c_raw_code(InitSaveStruct, no_live_lvals_info),
- pragma_c_raw_code(SaveRegs, no_live_lvals_info),
+ pragma_c_raw_code(InitSaveStruct, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SaveRegs, cannot_branch_away,
+ no_live_lvals_info),
ProcLabelDefine,
- pragma_c_raw_code(SharedDef1, no_live_lvals_info),
- pragma_c_raw_code(SharedDef2, no_live_lvals_info),
- pragma_c_raw_code(SharedDef3, no_live_lvals_info),
+ pragma_c_raw_code(SharedDef1, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SharedDef2, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(SharedDef3, cannot_branch_away,
+ no_live_lvals_info),
pragma_c_user_code(SharedContext, Shared),
pragma_c_raw_code(SharedSuccessLabel,
+ cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, cannot_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(Succeed, no_live_lvals_info),
+ pragma_c_raw_code(Succeed, can_branch_away, no_live_lvals_info),
pragma_c_raw_code(SharedLastSuccessLabel,
+ cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(RestoreRegs, can_branch_away,
no_live_lvals_info),
- pragma_c_raw_code(RestoreRegs, no_live_lvals_info),
pragma_c_outputs(OutputDescs),
- pragma_c_raw_code(SucceedDiscard, no_live_lvals_info),
- pragma_c_raw_code(Undef1, no_live_lvals_info),
- pragma_c_raw_code(Undef2, no_live_lvals_info),
- pragma_c_raw_code(Undef3, no_live_lvals_info),
+ pragma_c_raw_code(SucceedDiscard, cannot_branch_away,
+ no_live_lvals_info),
+ pragma_c_raw_code(Undef1, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef2, cannot_branch_away, no_live_lvals_info),
+ pragma_c_raw_code(Undef3, cannot_branch_away, no_live_lvals_info),
ProcLabelUndef
],
SharedBlockCode = node([
@@ -1044,15 +1029,9 @@
- "Shared pragma C inclusion"
]),
- Code =
- tree(ModFrameCode,
- tree(FirstDisjunctCode,
- tree(CallBlockCode,
- tree(RetryLabelCode,
- tree(LaterDisjunctCode,
- tree(RetryBlockCode,
- tree(SharedLabelCode,
- SharedBlockCode)))))))
+ Code = tree_list([ModFrameCode, FirstDisjunctCode, CallBlockCode,
+ RetryLabelCode, LaterDisjunctCode, RetryBlockCode, SharedLabelCode,
+ SharedBlockCode])
).
%---------------------------------------------------------------------------%
@@ -1064,8 +1043,7 @@
type, % original type before
% inlining/specialization
% (the actual type may be an instance
- % of this type, if this type is
- % polymorphic).
+ % of this type, if this type is polymorphic).
arg_info
).
@@ -1085,9 +1063,9 @@
CArg = c_arg(Var, MaybeName, Type, ArgInfo),
make_c_arg_list(ArgTail, ArgInfoTail, CArgTail).
make_c_arg_list([], [_|_], _) :-
- error("pragma_c_gen__make_c_arg_list length mismatch").
+ unexpected(this_file, "pragma_c_gen__make_c_arg_list length mismatch").
make_c_arg_list([_|_], [], _) :-
- error("pragma_c_gen__make_c_arg_list length mismatch").
+ unexpected(this_file, "pragma_c_gen__make_c_arg_list length mismatch").
%---------------------------------------------------------------------------%
@@ -1096,8 +1074,7 @@
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).
+ make_extra_c_arg_list_seq(ExtraArgs, ModuleInfo, MaxArgNum, ExtraCArgs).
:- pred get_highest_arg_num(list(arg_info)::in, int::in, int::out) is det.
@@ -1138,8 +1115,8 @@
%---------------------------------------------------------------------------%
% pragma_select_out_args returns the list of variables
- % which are outputs for a procedure
-
+ % which are outputs for a procedure.
+ %
:- pred pragma_select_out_args(list(c_arg)::in, list(c_arg)::out) is det.
pragma_select_out_args([], []).
@@ -1153,9 +1130,9 @@
Out = OutTail
).
- % pragma_select_in_args returns the list of variables
- % which are inputs for a procedure
-
+ % Pragma_select_in_args returns the list of variables
+ % which are inputs for a procedure.
+ %
:- pred pragma_select_in_args(list(c_arg)::in, list(c_arg)::out) is det.
pragma_select_in_args([], []).
@@ -1171,17 +1148,16 @@
%---------------------------------------------------------------------------%
-% var_is_not_singleton determines whether or not a given pragma_c variable
-% is singleton (i.e. starts with an underscore) or anonymous (in which case
-% it's singleton anyway, it just doesn't necessarily have a singleton name).
-%
-% Singleton vars should be ignored when generating the declarations for
-% pragma_c arguments because:
-%
-% - they should not appear in the C code
-% - they could clash with the system name space
-%
-
+ % var_is_not_singleton determines whether or not a given pragma_c variable
+ % is singleton (i.e. starts with an underscore) or anonymous (in which case
+ % it's singleton anyway, it just doesn't necessarily have a singleton name).
+ %
+ % Singleton vars should be ignored when generating the declarations for
+ % pragma_c arguments because:
+ %
+ % - they should not appear in the C code
+ % - they could clash with the system name space
+ %
:- pred var_is_not_singleton(maybe(string)::in, string::out) is semidet.
var_is_not_singleton(yes(Name), Name) :-
@@ -1189,10 +1165,10 @@
%---------------------------------------------------------------------------%
-% make_pragma_decls returns the list of pragma_decls for the pragma_c
-% data structure in the LLDS. It is essentially a list of pairs of type and
-% variable name, so that declarations of the form "Type Name;" can be made.
-
+ % make_pragma_decls returns the list of pragma_decls for the pragma_c
+ % data structure in the LLDS. It is essentially a list of pairs of type and
+ % variable name, so that declarations of the form "Type Name;" can be made.
+ %
:- pred make_pragma_decls(list(c_arg)::in, module_info::in,
list(pragma_c_decl)::out) is det.
@@ -1227,10 +1203,10 @@
%---------------------------------------------------------------------------%
-% get_pragma_input_vars returns a list of pragma_c_inputs for the pragma_c
-% data structure in the LLDS. It is essentially a list of the input variables,
-% and the corresponding rvals assigned to those (C) variables.
-
+ % get_pragma_input_vars returns a list of pragma_c_inputs for the pragma_c
+ % data structure in the LLDS. It is essentially a list of the input
+ % variables, and the corresponding rvals assigned to those (C) variables.
+ %
:- pred get_pragma_input_vars(list(c_arg)::in, list(pragma_c_input)::out,
code_tree::out, code_info::in, code_info::out) is det.
@@ -1241,14 +1217,13 @@
VarType = variable_type(!.CI, Var),
code_info__produce_variable(Var, FirstCode, Rval, !CI),
MaybeForeign = get_maybe_foreign_type_info(!.CI, OrigType),
- Input = pragma_c_input(Name, VarType, OrigType, Rval,
- MaybeForeign),
+ Input = pragma_c_input(Name, VarType, OrigType, Rval, MaybeForeign),
get_pragma_input_vars(Args, Inputs1, RestCode, !CI),
Inputs = [Input | Inputs1],
Code = tree(FirstCode, RestCode)
;
- % if the variable doesn't occur in the ArgNames list,
- % it can't be used, so we just ignore it
+ % If the variable doesn't occur in the ArgNames list, it can't be used,
+ % so we just ignore it.
get_pragma_input_vars(Args, Inputs, Code, !CI)
).
@@ -1258,25 +1233,22 @@
get_maybe_foreign_type_info(CI, Type) = MaybeForeignTypeInfo :-
code_info__get_module_info(CI, Module),
module_info_types(Module, Types),
-
(
type_to_ctor_and_args(Type, TypeId, _SubTypes),
map__search(Types, TypeId, Defn),
hlds_data__get_type_defn_body(Defn, Body),
- Body = foreign_type(foreign_type_body(_MaybeIL, MaybeC,
- _MaybeJava))
+ Body = foreign_type(foreign_type_body(_MaybeIL, MaybeC, _MaybeJava))
->
(
MaybeC = yes(Data),
Data = foreign_type_lang_data(c(Name), _, Assertions),
- MaybeForeignTypeInfo = yes(
- pragma_c_foreign_type(Name, Assertions))
+ MaybeForeignTypeInfo = yes(pragma_c_foreign_type(Name, Assertions))
;
MaybeC = no,
% This is ensured by check_foreign_type in
% make_hlds.
- unexpected(this_file, "get_maybe_foreign_type_name: "
- ++ "no c foreign type")
+ unexpected(this_file,
+ "get_maybe_foreign_type_name: no c foreign type")
)
;
MaybeForeignTypeInfo = no
@@ -1284,9 +1256,9 @@
%---------------------------------------------------------------------------%
-% pragma_acquire_regs acquires a list of registers in which to place each
-% of the given arguments.
-
+ % pragma_acquire_regs acquires a list of registers in which to place each
+ % of the given arguments.
+ %
:- pred pragma_acquire_regs(list(c_arg)::in, list(lval)::out,
code_info::in, code_info::out) is det.
@@ -1298,10 +1270,10 @@
%---------------------------------------------------------------------------%
-% place_pragma_output_args_in_regs returns a list of pragma_c_outputs, which
-% are pairs of names of output registers and (C) variables which hold the
-% output value.
-
+ % place_pragma_output_args_in_regs returns a list of pragma_c_outputs,
+ % which are pairs of names of output registers and (C) variables which
+ % hold the output value.
+ %
:- pred place_pragma_output_args_in_regs(list(c_arg)::in, list(lval)::in,
list(pragma_c_output)::out, code_info::in, code_info::out) is det.
@@ -1315,8 +1287,8 @@
MaybeForeign = get_maybe_foreign_type_info(!.CI, OrigType),
( var_is_not_singleton(MaybeName, Name) ->
VarType = variable_type(!.CI, Var),
- PragmaCOutput = pragma_c_output(Reg, VarType, OrigType,
- Name, MaybeForeign),
+ PragmaCOutput = pragma_c_output(Reg, VarType, OrigType, Name,
+ MaybeForeign),
Outputs = [PragmaCOutput | OutputsTail]
;
Outputs = OutputsTail
@@ -1325,15 +1297,15 @@
Outputs = OutputsTail
).
place_pragma_output_args_in_regs([_|_], [], _, !CI) :-
- error("place_pragma_output_args_in_regs: length mismatch").
+ unexpected(this_file, "place_pragma_output_args_in_regs: length mismatch").
place_pragma_output_args_in_regs([], [_|_], _, !CI) :-
- error("place_pragma_output_args_in_regs: length mismatch").
+ unexpected(this_file, "place_pragma_output_args_in_regs: length mismatch").
%---------------------------------------------------------------------------%
-% input_descs_from_arg_info returns a list of pragma_c_inputs, which
-% are pairs of rvals and (C) variables which receive the input value.
-
+ % input_descs_from_arg_info returns a list of pragma_c_inputs, which
+ % are pairs of rvals and (C) variables which receive the input value.
+ %
:- pred input_descs_from_arg_info(code_info::in, list(c_arg)::in,
list(pragma_c_input)::out) is det.
@@ -1355,10 +1327,10 @@
%---------------------------------------------------------------------------%
-% output_descs_from_arg_info returns a list of pragma_c_outputs, which
-% are pairs of names of output registers and (C) variables which hold the
-% output value.
-
+ % output_descs_from_arg_info returns a list of pragma_c_outputs, which
+ % are pairs of names of output registers and (C) variables which hold the
+ % output value.
+ %
:- pred output_descs_from_arg_info(code_info::in, list(c_arg)::in,
list(pragma_c_output)::out) is det.
@@ -1371,8 +1343,7 @@
ArgInfo = arg_info(N, _),
Reg = reg(r, N),
MaybeForeign = get_maybe_foreign_type_info(CI, OrigType),
- Output = pragma_c_output(Reg, VarType, OrigType, Name,
- MaybeForeign),
+ Output = pragma_c_output(Reg, VarType, OrigType, Name, MaybeForeign),
Outputs = [Output | OutputsTail]
;
Outputs = OutputsTail
@@ -1381,19 +1352,16 @@
%---------------------------------------------------------------------------%
pragma_c_gen__struct_name(ModuleName, PredName, Arity, ProcId, StructName) :-
- MangledModuleName = sym_name_mangle(ModuleName),
- MangledPredName = name_mangle(PredName),
- proc_id_to_int(ProcId, ProcNum),
- string__int_to_string(Arity, ArityStr),
- string__int_to_string(ProcNum, ProcNumStr),
- string__append_list(["mercury_save__", MangledModuleName, "__",
- MangledPredName, "__", ArityStr, "_", ProcNumStr], StructName).
+ StructName = "mercury_save__" ++ sym_name_mangle(ModuleName) ++ "__" ++
+ name_mangle(PredName) ++ "__" ++ int_to_string(Arity) ++ "_" ++
+ int_to_string(proc_id_to_int(ProcId)).
pragma_succ_ind_name = "MercurySuccessIndicator".
%---------------------------------------------------------------------------%
:- func this_file = string.
+
this_file = "pragma_c_gen.m".
%---------------------------------------------------------------------------%
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.72
diff -u -b -r1.72 trace.m
--- compiler/trace.m 27 Aug 2005 09:41:59 -0000 1.72
+++ compiler/trace.m 3 Sep 2005 13:10:17 -0000
@@ -596,20 +596,19 @@
MaybeFromFullSlot = yes(CallFromFullSlot),
trace__stackref_to_string(CallFromFullSlot,
CallFromFullSlotStr),
- string__append_list([
- "\t\t", CallFromFullSlotStr, " = MR_trace_from_full;\n",
- "\t\tif (MR_trace_from_full) {\n",
- FillSlotsUptoTrail,
- "\t\t} else {\n",
- "\t\t\t", CallDepthStr, " = MR_trace_call_depth;\n",
+ TraceStmt1 =
+ "\t\t" ++ CallFromFullSlotStr ++ " = MR_trace_from_full;\n" ++
+ "\t\tif (MR_trace_from_full) {\n" ++
+ FillSlotsUptoTrail ++
+ "\t\t} else {\n" ++
+ "\t\t\t" ++ CallDepthStr ++ " = MR_trace_call_depth;\n" ++
"\t\t}\n"
- ], TraceStmt1)
;
MaybeFromFullSlot = no,
TraceStmt1 = FillSlotsUptoTrail
),
TraceCode1 = node([
- pragma_c([], [pragma_c_raw_code(TraceStmt1,
+ pragma_c([], [pragma_c_raw_code(TraceStmt1, cannot_branch_away,
live_lvals_info(set__init))], will_not_call_mercury,
no, no, MaybeLayoutLabel, no, yes, no)
- ""
@@ -628,10 +627,9 @@
trace__stackref_to_string(CallTableLval, CallTableLvalStr),
TraceStmt3 = "\t\t" ++ CallTableLvalStr ++ " = 0;\n",
TraceCode3 = node([
- pragma_c([], [pragma_c_raw_code(TraceStmt3,
+ pragma_c([], [pragma_c_raw_code(TraceStmt3, cannot_branch_away,
live_lvals_info(set__init))],
- will_not_call_mercury, no, no, no, no, yes, no)
- - ""
+ will_not_call_mercury, no, no, no, no, yes, no) - ""
])
;
MaybeCallTableLval = no,
@@ -656,8 +654,7 @@
),
ResetStmt = MacroStr ++ "(" ++ CallDepthStr ++ ");\n",
TraceCode = node([
- c_code(ResetStmt, live_lvals_info(set__init))
- - ""
+ c_code(ResetStmt, live_lvals_info(set__init)) - ""
])
;
MaybeTraceInfo = no,
@@ -883,11 +880,9 @@
% because sometimes this pair is preceded
% by another label, and this way we can
% eliminate this other label.
- pragma_c([], [pragma_c_raw_code(TraceStmt,
+ pragma_c([], [pragma_c_raw_code(TraceStmt, cannot_branch_away,
live_lvals_info(LiveLvalSet))],
- may_call_mercury, no, no, yes(Label), no, yes,
- no)
- - ""
+ may_call_mercury, no, no, yes(Label), no, yes, no) - ""
]),
Code = tree(ProduceCode, TraceCode).
Index: compiler/use_local_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/use_local_vars.m,v
retrieving revision 1.14
diff -u -b -r1.14 use_local_vars.m
--- compiler/use_local_vars.m 25 Aug 2005 03:19:48 -0000 1.14
+++ compiler/use_local_vars.m 3 Sep 2005 10:00:58 -0000
@@ -66,11 +66,13 @@
:- import_module ll_backend__llds.
:- import_module mdbcomp__prim_data.
+:- import_module bool.
:- import_module counter.
:- import_module list.
:- pred use_local_vars__main(list(instruction)::in, list(instruction)::out,
- proc_label::in, int::in, int::in, counter::in, counter::out) is det.
+ int::in, int::in, bool::in, proc_label::in, counter::in, counter::out)
+ is det.
:- implementation.
@@ -78,20 +80,24 @@
:- import_module ll_backend__code_util.
:- import_module ll_backend__exprn_aux.
:- import_module ll_backend__livemap.
+:- import_module ll_backend__opt_debug.
:- import_module ll_backend__opt_util.
+:- import_module parse_tree__error_util.
:- import_module int.
:- import_module map.
:- import_module require.
:- import_module set.
:- import_module std_util.
+:- import_module string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-use_local_vars__main(Instrs0, Instrs, ProcLabel, NumRealRRegs, AccessThreshold,
- !C) :-
- create_basic_blocks(Instrs0, Comments, ProcLabel, !C, LabelSeq, BlockMap0),
+use_local_vars__main(Instrs0, Instrs, NumRealRRegs, AccessThreshold,
+ AutoComments, ProcLabel, !C) :-
+ create_basic_blocks(Instrs0, Comments0, ProcLabel, !C, NewLabels,
+ LabelSeq, BlockMap0),
flatten_basic_blocks(LabelSeq, BlockMap0, TentativeInstrs),
livemap__build(TentativeInstrs, MaybeLiveMap),
(
@@ -100,10 +106,20 @@
Instrs = Instrs0
;
MaybeLiveMap = yes(LiveMap),
+ extend_basic_blocks(LabelSeq, EBBLabelSeq, BlockMap0, EBBBlockMap0,
+ NewLabels),
list__foldl(use_local_vars_block(LiveMap, NumRealRRegs,
- AccessThreshold), LabelSeq, BlockMap0, BlockMap),
- flatten_basic_blocks(LabelSeq, BlockMap, Instrs1),
- list__append(Comments, Instrs1, Instrs)
+ AccessThreshold), EBBLabelSeq, EBBBlockMap0, EBBBlockMap),
+ flatten_basic_blocks(EBBLabelSeq, EBBBlockMap, Instrs1),
+ (
+ AutoComments = yes,
+ NewComment = comment("\n" ++ dump_livemap(LiveMap)) - "",
+ Comments = Comments0 ++ [NewComment]
+ ;
+ AutoComments = no,
+ Comments = Comments0
+ ),
+ Instrs = Comments ++ Instrs1
).
:- pred use_local_vars_block(livemap::in, int::in, int::in, label::in,
@@ -114,25 +130,9 @@
map__lookup(!.BlockMap, Label, BlockInfo0),
BlockInfo0 = block_info(BlockLabel, LabelInstr, RestInstrs0,
FallInto, JumpLabels, MaybeFallThrough),
- ( can_branch_to_unknown_label(RestInstrs0) ->
- MaybeEndLiveLvals = no
- ;
- (
- MaybeFallThrough = yes(FallThrough),
- EndLabels = [FallThrough | JumpLabels]
- ;
- MaybeFallThrough = no,
- EndLabels = JumpLabels
- ),
- list__foldl(find_live_lvals_at_end_labels(LiveMap), EndLabels,
- set__init, EndLiveLvals0),
- list__foldl(find_live_lvals_in_annotations, RestInstrs0,
- EndLiveLvals0, EndLiveLvals),
- MaybeEndLiveLvals = yes(EndLiveLvals)
- ),
counter__init(1, TempCounter0),
use_local_vars_instrs(RestInstrs0, RestInstrs, TempCounter0, TempCounter,
- NumRealRRegs, AccessThreshold, MaybeEndLiveLvals),
+ NumRealRRegs, AccessThreshold, LiveMap, MaybeFallThrough),
( TempCounter = TempCounter0 ->
true
;
@@ -141,60 +141,16 @@
map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap)
).
-:- pred can_branch_to_unknown_label(list(instruction)::in) is semidet.
-
-can_branch_to_unknown_label([Uinstr - _ | Instrs]) :-
- (
- opt_util__instr_labels(Uinstr, _, CodeAddrs),
- some_code_addr_is_not_label(CodeAddrs)
- ;
- can_branch_to_unknown_label(Instrs)
- ).
-
-:- pred some_code_addr_is_not_label(list(code_addr)::in) is semidet.
-
-some_code_addr_is_not_label([CodeAddr | CodeAddrs]) :-
- (
- CodeAddr \= label(_Label)
- ;
- some_code_addr_is_not_label(CodeAddrs)
- ).
-
-:- pred find_live_lvals_at_end_labels(livemap::in, label::in,
- lvalset::in, lvalset::out) is det.
-
-find_live_lvals_at_end_labels(LiveMap, Label, !LiveLvals) :-
- ( map__search(LiveMap, Label, LabelLiveLvals) ->
- set__union(LabelLiveLvals, !LiveLvals)
- ; Label = internal(_, _) ->
- error("find_live_lvals_at_end_labels: local label not found")
- ;
- % Non-local labels can be found only through call instructions,
- % which must be preceded by livevals instructions. The
- % variables live at the label will be included when we process
- % the livevals instruction.
- true
- ).
-
-:- pred find_live_lvals_in_annotations(instruction::in,
- lvalset::in, lvalset::out) is det.
-
-find_live_lvals_in_annotations(Uinstr - _, !LiveLvals) :-
- ( Uinstr = livevals(InstrLiveLvals) ->
- set__union(InstrLiveLvals, !LiveLvals)
- ;
- true
- ).
-
%-----------------------------------------------------------------------------%
:- pred use_local_vars_instrs(list(instruction)::in, list(instruction)::out,
- counter::in, counter::out, int::in, int::in, maybe(lvalset)::in)
+ counter::in, counter::out, int::in, int::in, livemap::in, maybe(label)::in)
is det.
use_local_vars_instrs(!RestInstrs, !TempCounter,
- NumRealRRegs, AccessThreshold, MaybeEndLiveLvals) :-
- opt_assign(!RestInstrs, !TempCounter, NumRealRRegs, MaybeEndLiveLvals),
+ NumRealRRegs, AccessThreshold, LiveMap, MaybeFallThrough) :-
+ opt_assign(!RestInstrs, !TempCounter, NumRealRRegs, LiveMap,
+ MaybeFallThrough),
( AccessThreshold >= 1 ->
opt_access(!RestInstrs, !TempCounter, NumRealRRegs,
set__init, AccessThreshold)
@@ -205,11 +161,11 @@
%-----------------------------------------------------------------------------%
:- pred opt_assign(list(instruction)::in, list(instruction)::out,
- counter::in, counter::out, int::in, maybe(lvalset)::in) is det.
+ counter::in, counter::out, int::in, livemap::in, maybe(label)::in) is det.
-opt_assign([], [], !TempCounter, _, _).
+opt_assign([], [], !TempCounter, _, _, _).
opt_assign([Instr0 | TailInstrs0], Instrs, !TempCounter, NumRealRRegs,
- MaybeEndLiveLvals) :-
+ LiveMap, MaybeFallThrough) :-
Instr0 = Uinstr0 - _Comment0,
(
( Uinstr0 = assign(ToLval, _FromRval)
@@ -217,21 +173,25 @@
),
base_lval_worth_replacing(NumRealRRegs, ToLval)
->
- counter__allocate(TempNum, !TempCounter),
- NewLval = temp(r, TempNum),
(
ToLval = reg(_, _),
- MaybeEndLiveLvals = yes(EndLiveLvals),
- not set__member(ToLval, EndLiveLvals)
+ find_compulsory_lvals(TailInstrs0, LiveMap, MaybeFallThrough,
+ no, MaybeCompulsoryLvals),
+ MaybeCompulsoryLvals = known(CompulsoryLvals),
+ not set__member(ToLval, CompulsoryLvals)
->
+ counter__allocate(TempNum, !TempCounter),
+ NewLval = temp(r, TempNum),
substitute_lval_in_defn(ToLval, NewLval, Instr0, Instr),
list__map_foldl(
exprn_aux__substitute_lval_in_instr(ToLval, NewLval),
TailInstrs0, TailInstrs1, 0, _),
opt_assign(TailInstrs1, TailInstrs, !TempCounter, NumRealRRegs,
- MaybeEndLiveLvals),
+ LiveMap, MaybeFallThrough),
Instrs = [Instr | TailInstrs]
;
+ counter__allocate(TempNum, !TempCounter),
+ NewLval = temp(r, TempNum),
substitute_lval_in_instr_until_defn(ToLval, NewLval,
TailInstrs0, TailInstrs1, 0, NumSubst),
NumSubst > 1
@@ -239,21 +199,100 @@
substitute_lval_in_defn(ToLval, NewLval, Instr0, Instr),
CopyInstr = assign(ToLval, lval(NewLval)) - "",
opt_assign(TailInstrs1, TailInstrs, !TempCounter, NumRealRRegs,
- MaybeEndLiveLvals),
+ LiveMap, MaybeFallThrough),
Instrs = [Instr, CopyInstr | TailInstrs]
;
opt_assign(TailInstrs0, TailInstrs, !TempCounter, NumRealRRegs,
- MaybeEndLiveLvals),
+ LiveMap, MaybeFallThrough),
Instrs = [Instr0 | TailInstrs]
)
;
opt_assign(TailInstrs0, TailInstrs, !TempCounter, NumRealRRegs,
- MaybeEndLiveLvals),
+ LiveMap, MaybeFallThrough),
Instrs = [Instr0 | TailInstrs]
).
%-----------------------------------------------------------------------------%
+:- type maybe_compulsory_lvals
+ ---> known(lvalset)
+ ; unknown_must_assume_all.
+
+:- pred find_compulsory_lvals(list(instruction)::in, livemap::in,
+ maybe(label)::in, bool::in, maybe_compulsory_lvals::out) is det.
+
+find_compulsory_lvals([], LiveMap, MaybeFallThrough, _PrevLivevals,
+ MaybeCompulsoryLvals) :-
+ (
+ MaybeFallThrough = yes(FallThrough),
+ map__lookup(LiveMap, FallThrough, CompulsoryLvals),
+ MaybeCompulsoryLvals = known(CompulsoryLvals)
+ ;
+ MaybeFallThrough = no,
+ MaybeCompulsoryLvals = unknown_must_assume_all
+ ).
+find_compulsory_lvals([Instr | Instrs], LiveMap, MaybeFallThrough,
+ PrevLivevals, !:MaybeCompulsoryLvals) :-
+ Instr = Uinstr - _,
+ (
+ Uinstr = livevals(LiveLvals)
+ ->
+ find_compulsory_lvals(Instrs, LiveMap, MaybeFallThrough,
+ yes, !:MaybeCompulsoryLvals),
+ union_maybe_compulsory_lvals(LiveLvals, !MaybeCompulsoryLvals)
+ ;
+ Uinstr = call(_, _, _, _, _, _)
+ ->
+ require(unify(PrevLivevals, yes),
+ "find_compulsory_lvals: call without livevals"),
+ % The livevals instruction will include all the live lvals
+ % in MaybeCompulsoryLvals after we return.
+ !:MaybeCompulsoryLvals = known(set__init)
+ ;
+ Uinstr = goto(_Target),
+ PrevLivevals = yes
+ ->
+ % The livevals instruction will include all the live lvals
+ % in MaybeCompulsoryLvals after we return.
+ !:MaybeCompulsoryLvals = known(set__init)
+ ;
+ possible_targets(Uinstr, Labels, NonLabelCodeAddrs),
+ (
+ NonLabelCodeAddrs = [],
+ (
+ Labels = [],
+ % Optimize the common case
+ find_compulsory_lvals(Instrs, LiveMap, MaybeFallThrough,
+ no, !:MaybeCompulsoryLvals)
+ ;
+ Labels = [_ | _],
+ list__map(map__lookup(LiveMap), Labels, LabelsLiveLvals),
+ AllLabelsLiveLvals = set__union_list(LabelsLiveLvals),
+ find_compulsory_lvals(Instrs, LiveMap, MaybeFallThrough,
+ no, !:MaybeCompulsoryLvals),
+ union_maybe_compulsory_lvals(AllLabelsLiveLvals,
+ !MaybeCompulsoryLvals)
+ )
+ ;
+ NonLabelCodeAddrs = [_ | _],
+ !:MaybeCompulsoryLvals = unknown_must_assume_all
+ )
+ ).
+
+:- pred union_maybe_compulsory_lvals(lvalset::in,
+ maybe_compulsory_lvals::in, maybe_compulsory_lvals::out) is det.
+
+union_maybe_compulsory_lvals(New, !MaybeCompulsoryLvals) :-
+ (
+ !.MaybeCompulsoryLvals = known(OldCompulsoryLvals),
+ set__union(New, OldCompulsoryLvals, AllCompulsoryLvals),
+ !:MaybeCompulsoryLvals = known(AllCompulsoryLvals)
+ ;
+ !.MaybeCompulsoryLvals = unknown_must_assume_all
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred opt_access(list(instruction)::in, list(instruction)::out,
counter::in, counter::out, int::in, lvalset::in, int::in) is det.
@@ -271,6 +310,7 @@
SubLvals, ReplaceableSubLvals),
ReplaceableSubLvals = [ChosenLval | ChooseableRvals]
->
+ OrigTempCounter = !.TempCounter,
counter__allocate(TempNum, !TempCounter),
TempLval = temp(r, TempNum),
lvals_in_lval(ChosenLval, SubChosenLvals),
@@ -286,9 +326,11 @@
opt_access(Instrs2, Instrs, !TempCounter, NumRealRRegs,
AlreadyTried1, AccessThreshold)
; ChooseableRvals = [_ | _] ->
+ !:TempCounter = OrigTempCounter,
opt_access([Instr0 | TailInstrs0], Instrs, !TempCounter,
NumRealRRegs, AlreadyTried1, AccessThreshold)
;
+ !:TempCounter = OrigTempCounter,
opt_access(TailInstrs0, TailInstrs, !TempCounter, NumRealRRegs,
set__init, AccessThreshold),
Instrs = [Instr0 | TailInstrs]
@@ -478,3 +520,9 @@
;
Uinstr0 = pragma_c(_, _, _, _, _, _, _, _, _)
).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "use_local_vars.m".
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list