for review: a big step towards the trace-based debugger (part 1 of 3)

Zoltan Somogyi zs at cs.mu.OZ.AU
Fri Mar 20 19:55:13 AEDT 1998


Tyson, Fergus, please review this.

This change makes the tracer a lot more useful. The major points are:

- you can now print the values of live variables at all trace ports,
  not just at entry and exit ports;

- you can now print the values of polymorphic variables;

- the implementation now longer saves and restores a thousand pseudo-registers
  unnecessarily;

- you can now execute programs compiled with tracing without user intervention
  if that is what you want.

The last change makes bootstrapping with --generate-trace possible in theory,
although this has not yet been done.

The three major things remaining to be done to make the tracer an adequate
replacement for Prolog debugging are

- a real term browser;

- spy points and other controls;

- being able to trace different modules at different levels
  (full/interface/none).

Two less important things to do are making the representation of typeinfos
themselves type correct :-( and not including (partially) clobbered variables
in trace events.

compiler/arg_info.m:
compiler/code_info.m:
	Move some code that always belonged in arg_info.m to arg_info.m
	from code_info.m.

compiler/code_exprn.m:
	Add a predicate to find out which registers are in use, so the tracer
	can avoid saving and restoring registers that are not use.

compiler/code_gen.m:
	Reorganize the handling of epilogs. Whereas epilogs used to generate
	the failure handling code, this is now done in generate_category_code,
	because failure handling is now complicated by having to save the
	input args for the fail event, and the setup for this naturally
	belongs in generate_category_code.

	Also move the responsibility for the call event to
	generate_category_code.

	Move Tyson's recent additions for tracing to trace.m in a generalized
	form, since they are now needed for all events, not just call and exit.

	Remove obsolete code for eager code generation.

compiler/code_info.m:
	Add a predicate to call the new predicate in code_exprn.

	Export a predicate for trace.m.

	Considerably simplify the treatment of continuation_infos,
	with code_info structures now storing only the stuff that can change
	during code generation (due to trace events).

compiler/code_util.m:
compiler/opt_util.m:
compiler/vn_filter.m:
	Move some code to code_util.m from opt_util.m and generalize it a bit,
	since the new predicate in code_exprn.m now needs the functionality.
	Make vn_filter.m refer to the moved predicates by their new name.

compiler/continuation_info.m:
	Major reorganization and simplification of the data structures.
	The data that changes during code generation is now stored in the
	code generator state; data that is only available after code generation
	is combined with the info from the code generator state and put into
	the HLDS; data that is available only after optimization is put
	directly into the HLDS.

	Do not add continuation_info records for labels that are not used
	either by tracing or by agc. For labels that are used by either,
	always include stack layout information if any variables are live.

compiler/continuation_info.m:
compiler/stack_layout.m:
	Do not associate the stack layout information at procedure entry and
	exit with the per-procedure data structure. Since we now associate this
	info with the labels of those events instead, they do not need special
	handling. However, do include a pointer to the call event's label's
	layout structure in the per-procedure data, so that we can later
	implement redo in the debugger.

compiler/stack_layout.m:
	Handle the possibility that the set of type variables that are needed
	at a point is not numbered 1-N without any missing type var numbers.

compiler/*_switch*.m:
compiler/ite_gen.m:
compiler/disj_gen.m:
compiler/pragma_c_gen.m:
	When creating trace events, associate not just a goal path but
	also a pre-death set with events that represent entry to a computation
	branch. Trace.m now needs the pre-death set so that it can avoid
	trying to flush variables that are not supposed to be live in the
	computation branch being traced.

compiler/handle_options.m:
	Handle some more implications of tracing, and document them better.

compiler/live_vars.m:
compiler/liveness.m:
compiler/store_alloc.m:
	If tracing is on, try to preserve the input arguments throughout
	the execution of the procedure. This is not possible if any part
	of an input argument is clobbered, but in the absence of a utility
	predicate that can test for this, we ignore the issue for now.

compiler/mercury_compile.m:
	Do not invoke continuation_info__process_instructions to add
	stack layout information about call return sites unless we are doing
	agc. (Tracing does not require this info, and it is big.)

compiler/{lambda,polymorphism,goal_util}.m:
	Enforce the invariant that if the signature of a procedure created
	for a lambda goal includes a type variable, it also includes the
	typeinfo for that type variable.

	(This change is from Simon.)

runtime/mercury_regorder.h:
	Add two new macros, MR_NUM_SPECIAL_REG and MR_MAX_SPECIAL_REG_MR
	that mercury_trace.c uses to decide how much fake_reg to save and
	restore.

runtime/mercury_stack_layout.h:
	Change the definition of MR_Var_Shape_Info to reflect the real type
	of one of its fields more closely.

	Make the type names conform to the Mercury style guide
	With_Studly_Cap_Names.

	Fix the definition of MR_DETISM_DET_CODE_MODEL.

runtime/mercury_stack_layout.c:
	Use the new forms of the type names.

runtime/mercury_trace.h:
	Modify the prototype of MR_trace() to reflect the new arg giving
	the number of the highest numbered rN register in use at the call.

runtime/mercury_trace.[ch]:
runtime/mercury_wrapper.c:
	Add support for turning tracing on and off and for choosing the
	external or internal debugger.

runtime/mercury_trace.c:
	Implement a new command set more in line with what we intend to
	grow towards in the future.

	Save/restore only the necessary registers, not all of them.

	Do not indent trace events by the depth, since the depth can get
	very large.

	There is a reference here back to the library, but this will
	go away when the tabling change is committed.

runtime/mercury_trace.[ch]:
	Add a new function, MR_trace_report. This function, which is for
	invocation in the event of a fatal error, reports what the number
	of the last event was (if tracing is enabled). This should allow
	the programmer to go more directly to the source of the problem.

runtime/mercury_wrapper.c:
	Remove the long obsolete code for initializing r[123] with integers.

library/require.m:
	

scripts/mmd:
	A new script for turning on the tracing code in an executable.

scripts/Mmakefile:
	Include mmd in the list of scripts to be installed.

tests/misc_tests/Mmakefile:
tests/misc_tests/debugger_regs.*:
tests/misc_tests/debugger_test.*:
	Move the tests of the debugger to the new tests/debugger directory.
	In the process, give debugger_test back its original name,
	"interpreter", and give it an input script that tests the new
	debugger commands while avoiding the printing of excessively large
	terms.

tests/debugger/Mmakefile:
tests/debugger/runtests:
tests/debugger/debugger_regs.*:
tests/debugger/interpreter.*:
	The moved test cases and copied Mmakefile/runtests.

tests/misc_tests/queens.*:
	A new test case to test the printing of variables in polymorphic
	procedures.

Zoltan.

Index: compiler/arg_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/arg_info.m,v
retrieving revision 1.27
diff -u -r1.27 arg_info.m
--- arg_info.m	1998/03/03 17:33:30	1.27
+++ arg_info.m	1998/03/11 04:56:38
@@ -23,7 +23,7 @@
 :- module arg_info.
 :- interface. 
 :- import_module hlds_module, hlds_pred, llds, globals, prog_data.
-:- import_module bool, list.
+:- import_module bool, list, assoc_list, term.
 
 :- pred generate_arg_info(module_info, module_info).
 :- mode generate_arg_info(in, out) is det.
@@ -45,12 +45,19 @@
 :- pred arg_info__ho_call_args_method(globals, args_method).
 :- mode arg_info__ho_call_args_method(in, out) is det.
 
+	% Given a list of the head variables and their argument information,
+	% return a list giving the input variables and their initial locations.
+:- pred arg_info__build_input_arg_list(assoc_list(var, arg_info),
+	assoc_list(var, rval)).
+:- mode arg_info__build_input_arg_list(in, out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module map, int, mode_util, require.
+:- import_module code_util, mode_util.
+:- import_module std_util, map, int, require.
 
 %-----------------------------------------------------------------------------%
 
@@ -224,6 +231,21 @@
 arg_info__args_method_is_ho_callable(_, simple, no).
 
 arg_info__ho_call_args_method(_, compact).
+
+%---------------------------------------------------------------------------%
+
+arg_info__build_input_arg_list([], []).
+arg_info__build_input_arg_list([V - Arg | Rest0], VarArgs) :-
+	Arg = arg_info(Loc, Mode),
+	(
+		Mode = top_in
+	->
+		code_util__arg_loc_to_register(Loc, Reg),
+		VarArgs = [V - lval(Reg) | VarArgs0]
+	;
+		VarArgs = VarArgs0
+	),
+	arg_info__build_input_arg_list(Rest0, VarArgs0).
 
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
Index: compiler/code_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_exprn.m,v
retrieving revision 1.57
diff -u -r1.57 code_exprn.m
--- code_exprn.m	1998/03/03 17:33:44	1.57
+++ code_exprn.m	1998/03/16 05:09:26
@@ -239,12 +239,18 @@
 :- pred code_exprn__set_follow_vars(follow_vars, exprn_info, exprn_info).
 :- mode code_exprn__set_follow_vars(in, in, out) is det.
 
+%	code_exprn__max_reg_in_use(MaxReg)
+%		Returns the number of the highest numbered rN register in use.
+
+:- pred code_exprn__max_reg_in_use(exprn_info, int).
+:- mode code_exprn__max_reg_in_use(in, out) is det.
+
 %------------------------------------------------------------------------------%
 %------------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module exprn_aux, tree.
+:- import_module code_util, exprn_aux, tree.
 :- import_module bool, bag, require, int, term, string, std_util.
 
 :- type var_stat	--->	evaled(set(rval))
@@ -1766,6 +1772,55 @@
 code_exprn__get_var_name(Var, Name) -->
 	code_exprn__get_varset(Varset),
 	{ varset__lookup_name(Varset, Var, Name) }.
+
+%------------------------------------------------------------------------------%
+
+code_exprn__max_reg_in_use(ExprnInfo, Max) :-
+	code_exprn__get_vars(Vars, ExprnInfo, _),
+	map__to_assoc_list(Vars, VarStats),
+	assoc_list__values(VarStats, Stats),
+	code_exprn__max_reg_in_use_vars(Stats, 0, Max1),
+	code_exprn__get_regs(InUseRegs, ExprnInfo, _),
+	bag__to_list_without_duplicates(InUseRegs, IRegs),
+	code_exprn__max_reg_in_use_lvals(IRegs, Max1, Max2),
+	code_exprn__get_acquired(Acquired, ExprnInfo, _),
+	set__to_sorted_list(Acquired, ARegs),
+	code_exprn__max_reg_in_use_lvals(ARegs, Max2, Max).
+
+:- pred code_exprn__max_reg_in_use_vars(list(var_stat), int, int).
+:- mode code_exprn__max_reg_in_use_vars(in, in, out) is det.
+
+code_exprn__max_reg_in_use_vars([], Max, Max).
+code_exprn__max_reg_in_use_vars([Stat | Stats], Max0, Max) :-
+	(
+		Stat = evaled(RvalSet),
+		set__to_sorted_list(RvalSet, Rvals),
+		code_exprn__max_reg_in_use_rvals(Rvals, Max0, Max1)
+	;
+		Stat = cached(Rval),
+		code_exprn__max_reg_in_use_rvals([Rval], Max0, Max1)
+	),
+	code_exprn__max_reg_in_use_vars(Stats, Max1, Max).
+
+:- pred code_exprn__max_reg_in_use_rvals(list(rval), int, int).
+:- mode code_exprn__max_reg_in_use_rvals(in, in, out) is det.
+
+code_exprn__max_reg_in_use_rvals(Rvals, Max0, Max) :-
+	list__map(code_util__lvals_in_rval, Rvals, LvalLists),
+	list__condense(LvalLists, Lvals),
+	code_exprn__max_reg_in_use_lvals(Lvals, Max0, Max).
+
+:- pred code_exprn__max_reg_in_use_lvals(list(lval), int, int).
+:- mode code_exprn__max_reg_in_use_lvals(in, in, out) is det.
+
+code_exprn__max_reg_in_use_lvals(Lvals, Max0, Max) :-
+	list__filter_map(code_exprn__lval_is_r_reg, Lvals, RegNumbers),
+	list__foldl(int__max, RegNumbers, Max0, Max).
+
+:- pred code_exprn__lval_is_r_reg(lval, int).
+:- mode code_exprn__lval_is_r_reg(in, out) is semidet.
+
+code_exprn__lval_is_r_reg(reg(r, N), N).
 
 %------------------------------------------------------------------------------%
 
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.48
diff -u -r1.48 code_gen.m
--- code_gen.m	1998/03/03 17:33:45	1.48
+++ code_gen.m	1998/03/16 09:25:33
@@ -152,7 +152,6 @@
 	pred_info_procedures(PredInfo, ProcInfos),
 		% locate the proc_info structure for this mode of the predicate
 	map__lookup(ProcInfos, ProcId, ProcInfo),
-		% find out if the proc is deterministic/etc
 	generate_proc_code(ProcInfo, ProcId, PredId, ModuleInfo0, Globals,
 		ContInfo0, CellCount0, ContInfo1, CellCount1, Proc),
 	generate_proc_list_code(ProcIds, PredId, PredInfo, ModuleInfo0,
@@ -187,7 +186,7 @@
 		% get the goal for this procedure
 	proc_info_goal(ProcInfo, Goal),
 		% get the information about this procedure that we need.
-	proc_info_varset(ProcInfo, VarInfo),
+	proc_info_varset(ProcInfo, VarSet),
 	proc_info_liveness_info(ProcInfo, Liveness),
 	proc_info_stack_slots(ProcInfo, StackSlots),
 	proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InitialInst),
@@ -207,21 +206,23 @@
 		SaveSuccip = no
 	),
 		% initialise the code_info structure 
-	code_info__init(VarInfo, Liveness, StackSlots, SaveSuccip, Globals,
+	code_info__init(VarSet, Liveness, StackSlots, SaveSuccip, Globals,
 		PredId, ProcId, ProcInfo, InitialInst, FollowVars,
-		ModuleInfo, CellCount0, ContInfo0, CodeInfo0),
+		ModuleInfo, CellCount0, CodeInfo0),
 		% generate code for the procedure
 	globals__lookup_bool_option(Globals, generate_trace, Trace),
-	( Trace = yes ->
+	code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel),
+	(
+		Trace = yes
+	->
 		trace__setup(CodeInfo0, CodeInfo1)
 	;
 		CodeInfo1 = CodeInfo0
 	),
-	generate_category_code(CodeModel, Goal, CodeTree, FrameInfo,
-		CodeInfo1, CodeInfo),
+	generate_category_code(CodeModel, Goal, ProcInfo, CodeTree,
+		MaybeTraceCallLabel, FrameInfo, CodeInfo1, CodeInfo),
 		% extract the new continuation_info and cell count
-	code_info__get_continuation_info(ContInfo1, CodeInfo, _CodeInfo1),
-	code_info__get_cell_count(CellCount, CodeInfo, _CodeInfo2),
+	code_info__get_cell_count(CellCount, CodeInfo, _CodeInfo1),
 
 		% turn the code tree into a list
 	tree__flatten(CodeTree, FragmentList),
@@ -238,13 +239,12 @@
 		Instructions = Instructions0
 	),
 	( BasicStackLayout = yes ->
-		code_util__make_proc_label(ModuleInfo, PredId, ProcId,
-			ProcLabel),
-		continuation_info__add_proc_layout_info(proc(PredId, ProcId),
+		code_info__get_layout_info(LayoutInfo, CodeInfo, _CodeInfo2),
+		continuation_info__add_proc_info(proc(PredId, ProcId),
 			ProcLabel, TotalSlots, Detism, MaybeSuccipSlot,
-			ContInfo1, ContInfo)
+			MaybeTraceCallLabel, LayoutInfo, ContInfo0, ContInfo)
 	;
-		ContInfo = ContInfo1
+		ContInfo = ContInfo0
 	),
 
 		% get the name and arity of this predicate
@@ -253,11 +253,58 @@
 		% construct a c_procedure structure with all the information
 	Proc = c_procedure(Name, Arity, proc(PredId, ProcId), Instructions).
 
-:- pred generate_category_code(code_model, hlds_goal, code_tree, frame_info,
-				code_info, code_info).
-:- mode generate_category_code(in, in, out, out, in, out) is det.
+%---------------------------------------------------------------------------%
+
+	% Generate_category_code generates code for an entire procedure.
+	% Its algorithm has three main stages:
+	%
+	%	- generate code for the body goal
+	%	- generate code for the prologue
+	%	- generate code for the epilogue
+	%
+	% The only caller of generate_category_code, generate_proc_code,
+	% has set up the code generator state to reflect what the machine
+	% state will be on entry to the procedure. Ensuring that the
+	% machine state at exit/fail will conform to the expectation
+	% of the caller is the job of the epilogue.
+	%
+	% The reason why we generate the prologue after the body is that
+	% information such as the total number of stack slots needed,
+	% which is needed when creating the prologue, cannot be conveniently
+	% obtained before generating the body, since the code generator
+	% may allocate temporary variables to hold values such as saved
+	% heap and trail pointers.
+	%
+	% Code_gen__generate_prologue cannot depend on the code generator
+	% state, since when it is invoked this state is not appropriate
+	% for the prologue. Nor can it change the code generator state,
+	% since that would confuse code_gen__generate_epilogue.
+	%
+	% Generating CALL trace events is done by generate_category_code,
+	% since only on entry to generate_category_code is the code generator
+	% state set up right. Generating EXIT trace events is done by
+	% code_gen__generate_exit, since the epilogue takes care of the
+	% successes of all procedures of all three code models.
+	% Generating FAIL trace events is done by generate_category_code,
+	% since this requires modifying how we generate code for the body
+	% of the procedure (failures must now branch to a different place).
+	% Since FAIL trace events are part of the failure continuation,
+	% generate_category_code takes care of the failure continuation
+	% as well. (Det procedures of course have no failure continuation.
+	% Nondet procedures have a failure continuation, but in the absence
+	% of tracing this continuation needs no code. Only semidet procedures
+	% need code for the failure continuation at all times.)
+	% code_gen__generate_epilogue.
+	%
+	% Procedures defined by nondet pragma C codes are a special case.
+	% Pragma_c_gen__generate_pragma_c_code handles XXX
+
+:- pred generate_category_code(code_model, hlds_goal, proc_info, code_tree,
+	maybe(label), frame_info, code_info, code_info).
+:- mode generate_category_code(in, in, in, out, out, out, in, out) is det.
 
-generate_category_code(model_det, Goal, Code, FrameInfo) -->
+generate_category_code(model_det, Goal, ProcInfo, Code,
+		MaybeTraceCallLabel, FrameInfo) -->
 		% generate the code for the body of the clause
 	(
 		code_info__get_globals(Globals),
@@ -265,6 +312,7 @@
 		middle_rec__match_and_generate(Goal, MiddleRecCode)
 	->
 		{ Code = MiddleRecCode },
+		{ MaybeTraceCallLabel = no },
 		{ FrameInfo = frame(0, no, no) }
 	;
 		% make a new failure cont (not model_non);
@@ -272,83 +320,147 @@
 		% but is a place holder
 		code_info__manufacture_failure_cont(no),
 
-		code_gen__generate_goal(model_det, Goal, BodyCode),
-		code_info__get_instmap(Instmap),
-
-		code_gen__generate_prolog(model_det, Goal, FrameInfo,
-			PrologCode),
-		(
-			{ instmap__is_reachable(Instmap) }
-		->
-			code_gen__generate_epilog(model_det,
-				FrameInfo, EpilogCode)
+		code_info__get_maybe_trace_info(MaybeTraceInfo),
+		( { MaybeTraceInfo = yes(TraceInfo) } ->
+			{ trace__fail_vars(ProcInfo, ResumeVars) },
+				% Protect these vars from being forgotten,
+				% so they will be around for the exit trace.
+			code_info__push_resume_point_vars(ResumeVars),
+			trace__generate_event_code(call, TraceInfo,
+				TraceCallLabel, _TypeInfos, TraceCallCode),
+			{ MaybeTraceCallLabel = yes(TraceCallLabel) }
 		;
-			{ EpilogCode = empty }
+			{ TraceCallCode = empty },
+			{ MaybeTraceCallLabel = no }
 		),
-
-		{ Code = tree(PrologCode, tree(BodyCode, EpilogCode)) }
+		code_gen__generate_goal(model_det, Goal, BodyCode),
+		code_gen__generate_entry(model_det, Goal, FrameInfo,
+			EntryCode),
+		code_gen__generate_exit(model_det, FrameInfo, _, ExitCode),
+		{ Code =
+			tree(EntryCode,
+			tree(TraceCallCode,
+			tree(BodyCode,
+			     ExitCode)))
+		}
 	).
 
-generate_category_code(model_semi, Goal, Code, FrameInfo) -->
+generate_category_code(model_semi, Goal, ProcInfo, Code,
+		MaybeTraceCallLabel, FrameInfo) -->
 		% make a new failure cont (not model_non)
 	code_info__manufacture_failure_cont(no),
+	code_info__get_maybe_trace_info(MaybeTraceInfo),
+	{ set__singleton_set(FailureLiveRegs, reg(r, 1)) },
+	{ FailCode = node([
+		assign(reg(r, 1), const(false)) - "Fail",
+		livevals(FailureLiveRegs) - "",
+		goto(succip) - "Return from procedure call"
+	]) },
+	( { MaybeTraceInfo = yes(TraceInfo) } ->
+		{ trace__fail_vars(ProcInfo, ResumeVars) },
+		code_info__make_known_failure_cont(ResumeVars, orig_and_stack,
+			no, SetupCode),
+		code_info__push_resume_point_vars(ResumeVars),
+		trace__generate_event_code(call, TraceInfo,
+			TraceCallLabel, _TypeInfos, TraceCallCode),
+		{ MaybeTraceCallLabel = yes(TraceCallLabel) },
+		code_gen__generate_goal(model_semi, Goal, BodyCode),
+		code_gen__generate_entry(model_semi, Goal, FrameInfo,
+			EntryCode),
+		code_gen__generate_exit(model_semi, FrameInfo,
+			RestoreDeallocCode, ExitCode),
+		code_info__pop_resume_point_vars,
+		code_info__restore_failure_cont(ResumeCode),
+		code_info__set_forward_live_vars(ResumeVars),
+		trace__generate_event_code(fail, TraceInfo, TraceFailCode),
+		{ Code =
+			tree(EntryCode,
+			tree(SetupCode,
+			tree(TraceCallCode,
+			tree(BodyCode,
+			tree(ExitCode,
+			tree(ResumeCode,
+			tree(TraceFailCode,
+			tree(RestoreDeallocCode,
+			     FailCode))))))))
+		}
+	;
+		{ MaybeTraceCallLabel = no },
+		code_gen__generate_goal(model_semi, Goal, BodyCode),
+		code_gen__generate_entry(model_semi, Goal, FrameInfo,
+			EntryCode),
+		code_gen__generate_exit(model_semi, FrameInfo,
+			RestoreDeallocCode, ExitCode),
+		code_info__restore_failure_cont(ResumeCode),
+		{ Code =
+			tree(EntryCode,
+			tree(BodyCode,
+			tree(ExitCode,
+			tree(ResumeCode,
+			tree(RestoreDeallocCode,
+			     FailCode)))))
+		}
+	).
 
-		% generate the code for the body of the clause
-	code_gen__generate_goal(model_semi, Goal, BodyCode),
-	code_gen__generate_prolog(model_semi, Goal, FrameInfo, PrologCode),
-	code_gen__generate_epilog(model_semi, FrameInfo, EpilogCode),
-	{ Code = tree(PrologCode, tree(BodyCode, EpilogCode)) }.
-
-generate_category_code(model_non, Goal, Code, FrameInfo) -->
+generate_category_code(model_non, Goal, ProcInfo, Code,
+		MaybeTraceCallLabel, FrameInfo) -->
 		% make a new failure cont (yes, it is model_non)
 	code_info__manufacture_failure_cont(yes),
 		% we must arrange the tracing of failure out of this proc
 	code_info__get_maybe_trace_info(MaybeTraceInfo),
 	( { MaybeTraceInfo = yes(TraceInfo) } ->
-		{ set__init(ResumeVars) },
-		code_info__make_known_failure_cont(ResumeVars, stack_only, yes,
-			SetupCode),
-
-			% generate the code for the body of the clause
+		{ trace__fail_vars(ProcInfo, ResumeVars) },
+		code_info__make_known_failure_cont(ResumeVars, orig_and_stack,
+			yes, SetupCode),
 		code_info__push_resume_point_vars(ResumeVars),
+		trace__generate_event_code(call, TraceInfo,
+			TraceCallLabel, _TypeInfos, TraceCallCode),
+		{ MaybeTraceCallLabel = yes(TraceCallLabel) },
 		code_gen__generate_goal(model_non, Goal, BodyCode),
-		code_gen__generate_prolog(model_non, Goal, FrameInfo,
+		code_gen__generate_entry(model_non, Goal, FrameInfo,
 			PrologCode),
-		code_gen__generate_epilog(model_non, FrameInfo, EpilogCode),
-		{ MainCode = tree(PrologCode, tree(BodyCode, EpilogCode)) },
+		code_gen__generate_exit(model_non, FrameInfo, _, EpilogCode),
 
 		code_info__pop_resume_point_vars,
 		code_info__restore_failure_cont(RestoreCode),
-		trace__generate_event_code(fail, TraceInfo, TraceEventCode),
+		code_info__set_forward_live_vars(ResumeVars),
+		trace__generate_event_code(fail, TraceInfo, TraceFailCode),
 		code_info__generate_failure(FailCode),
 		{ Code =
-			tree(MainCode,
+			tree(PrologCode,
 			tree(SetupCode,
+			tree(TraceCallCode,
+			tree(BodyCode,
+			tree(EpilogCode,
 			tree(RestoreCode,
-			tree(TraceEventCode,
-			     FailCode))))
+			tree(TraceFailCode,
+			     FailCode)))))))
 		}
 	;
-			% generate the code for the body of the clause
+		{ MaybeTraceCallLabel = no },
 		code_gen__generate_goal(model_non, Goal, BodyCode),
-		code_gen__generate_prolog(model_non, Goal, FrameInfo,
+		code_gen__generate_entry(model_non, Goal, FrameInfo,
 			PrologCode),
-		code_gen__generate_epilog(model_non, FrameInfo, EpilogCode),
-		{ Code = tree(PrologCode, tree(BodyCode, EpilogCode)) }
+		code_gen__generate_exit(model_non, FrameInfo, _, EpilogCode),
+		{ Code =
+			tree(PrologCode,
+			tree(BodyCode,
+			     EpilogCode))
+		}
 	).
 
 %---------------------------------------------------------------------------%
 
-	% Generate the prolog for a procedure.
+	% Generate the prologue for a procedure.
 	%
-	% The prolog will contain
+	% The prologue will contain
 	%
-	%	a comment to mark prolog start
+	%	a comment to mark prologue start
 	%	a comment explaining the stack layout
 	%	the procedure entry label
 	%	code to allocate a stack frame
 	%	code to fill in some special slots in the stack frame
-	%	a comment to mark prolog end
+	%	a comment to mark prologue end
 	%
 	% At the moment the only special slot is the succip slot.
 	%
@@ -357,11 +469,11 @@
 	% need a stack frame, and if the procedure is nondet, then the code
 	% to fill in the succip slot is subsumed by the mkframe.
 
-:- pred code_gen__generate_prolog(code_model, hlds_goal, frame_info, code_tree, 
-	code_info, code_info).
-:- mode code_gen__generate_prolog(in, in, out, out, in, out) is det.
+:- pred code_gen__generate_entry(code_model, hlds_goal, frame_info,
+	code_tree, code_info, code_info).
+:- mode code_gen__generate_entry(in, in, out, out, in, out) is det.
 
-code_gen__generate_prolog(CodeModel, Goal, FrameInfo, PrologCode) -->
+code_gen__generate_entry(CodeModel, Goal, FrameInfo, PrologCode) -->
 	code_info__get_stack_slots(StackSlots),
 	code_info__get_varset(VarSet),
 	{ code_aux__explain_stack_slots(StackSlots, VarSet, SlotsComment) },
@@ -399,38 +511,9 @@
 	),
 	code_info__get_maybe_trace_info(MaybeTraceInfo),
 	( { MaybeTraceInfo = yes(TraceInfo) } ->
-		{ trace__generate_slot_fill_code(TraceInfo, TraceFillCode) },
-		trace__generate_event_code(call, TraceInfo, TraceEventCode),
-		{ TraceCode = tree(TraceFillCode, TraceEventCode) }
-	;
-		{ TraceCode = empty }
-	),
-
-		% Generate live value information and put
-		% it into the continuation info if we are doing
-		% execution tracing.
-	code_info__get_globals(Globals),
-	(
-		{ globals__lookup_bool_option(Globals, trace_stack_layout,
-			yes) }
-	->
-		code_info__get_arginfo(ArgModes),
-		code_info__get_headvars(HeadVars),
-		{ assoc_list__from_corresponding_lists(HeadVars, ArgModes,
-			Args) },
-		{ code_gen__select_args_with_mode(Args, top_in, InVars,
-			InLvals) },
-
-		code_gen__generate_var_infos(InVars, InLvals, VarInfos),
-		code_gen__generate_typeinfos_on_entry(InVars, InLvals,
-			TypeInfos),
-		
-		code_info__get_continuation_info(ContInfo0),
-		{ continuation_info__add_proc_entry_info(proc(PredId, ProcId),
-			VarInfos, TypeInfos, ContInfo0, ContInfo) },
-		code_info__set_continuation_info(ContInfo)
+		{ trace__generate_slot_fill_code(TraceInfo, TraceFillCode) }
 	;
-		[]
+		{ TraceFillCode = empty }
 	),
 
 	{ predicate_module(ModuleInfo, PredId, ModuleName) },
@@ -492,28 +575,23 @@
 		tree(LabelCode,
 		tree(AllocCode,
 		tree(SaveSuccipCode,
-		tree(TraceCode,
+		tree(TraceFillCode,
 		     EndComment)))))
 	}.
 
 %---------------------------------------------------------------------------%
 
-	% Generate the epilog for a procedure.
+	% Generate the success epilogue for a procedure.
 	%
-	% The epilog will contain
+	% The epilogue will contain
 	%
-	%	a comment to mark epilog start
+	%	a comment to mark epilogue start
 	%	code to place the output arguments where their caller expects
-	%	the success continuation
-	%	the faulure continuation (for semidet procedures only)
-	%	a comment to mark epilog end.
-	%
-	% The success continuation will contain
-	%
 	%	code to restore registers from some special slots
 	%	code to deallocate the stack frame
 	%	code to set r1 to TRUE (for semidet procedures only)
 	%	a jump back to the caller, including livevals information
+	%	a comment to mark epilogue end
 	%
 	% The failure continuation will contain
 	%
@@ -523,7 +601,8 @@
 	%	code to set r1 to FALSE
 	%	a jump back to the caller, including livevals information
 	%
-	% At the moment the only special slot is the succip slot.
+	% At the moment the only special slots are the succip slot, and
+	% the slots holding the call number and call depth for tracing.
 	%
 	% Not all frames will have all these components. For example, for
 	% nondet procedures we don't deallocate the stack frame before
@@ -531,14 +610,15 @@
 	%
 	% Epilogs for procedures defined by nondet pragma C codes do not
 	% follow the rules above. For such procedures, the normal functions
-	% of the epilog are handled when traversing the pragma C code goal;
-	% we need only #undef a macro defined by the procedure prolog.
+	% of the epilogue are handled when traversing the pragma C code goal;
+	% we need only #undef a macro defined by the procedure prologue.
 
-:- pred code_gen__generate_epilog(code_model, frame_info, code_tree,
+:- pred code_gen__generate_exit(code_model, frame_info, code_tree, code_tree,
 	code_info, code_info).
-:- mode code_gen__generate_epilog(in, in, out, in, out) is det.
+:- mode code_gen__generate_exit(in, in, out, out, in, out) is det.
 
-code_gen__generate_epilog(CodeModel, FrameInfo, EpilogCode) -->
+code_gen__generate_exit(CodeModel, FrameInfo, RestoreDeallocCode, EpilogCode)
+		-->
 	{ StartComment = node([
 		comment("Start of procedure epilogue") - ""
 	]) },
@@ -554,6 +634,7 @@
 				will_not_call_mercury, no)
 				- ""
 		]) },
+		{ RestoreDeallocCode = empty }, % XXX
 		{ EpilogCode =
 			tree(StartComment,
 			tree(UndefCode,
@@ -592,51 +673,25 @@
 			]) }
 		),
 		{ RestoreDeallocCode = tree(RestoreSuccipCode, DeallocCode ) },
+
 		code_info__get_maybe_trace_info(MaybeTraceInfo),
 		( { MaybeTraceInfo = yes(TraceInfo) } ->
 			trace__generate_event_code(exit, TraceInfo,
-				SuccessTraceCode),
-			( { CodeModel = model_semi } ->
-				trace__generate_event_code(fail, TraceInfo,
-					FailureTraceCode)
-			;
-				{ FailureTraceCode = empty }
-			)
+				_, TypeInfoDatas, TraceExitCode),
+			{ assoc_list__values(TypeInfoDatas, TypeInfoLvals) }
 		;
-			{ SuccessTraceCode = empty },
-			{ FailureTraceCode = empty }
+			{ TraceExitCode = empty },
+			{ TypeInfoLvals = [] }
 		),
-			% Generate live value information and put
-			% it into the continuation info if we are doing
-			% execution tracing.
-		{ code_gen__select_args_with_mode(Args, top_out, OutVars,
+
+			% Find out which locations should be mentioned
+			% in the success path livevals(...) annotation,
+			% so that value numbering doesn't optimize them away.
+		{ code_gen__select_args_with_mode(Args, top_out, _OutVars,
 			OutLvals) },
-		code_info__get_globals(Globals),
-		(
-			{ globals__lookup_bool_option(Globals,
-				trace_stack_layout, yes) }
-		->
-			code_gen__generate_var_infos(OutVars, OutLvals,
-				VarInfos),
-			code_gen__generate_typeinfos_on_exit(OutVars,
-				TypeInfos),
-			code_info__get_continuation_info(ContInfo0),
-			code_info__get_pred_id(PredId),
-			code_info__get_proc_id(ProcId),
-			{ continuation_info__add_proc_exit_info(
-				proc(PredId, ProcId), VarInfos, TypeInfos,
-				ContInfo0, ContInfo) },
-			code_info__set_continuation_info(ContInfo),
-
-				% Make sure typeinfos are in livevals(...)
-				% so that value numbering doesn't mess
-				% with them.
-			{ assoc_list__values(TypeInfos, ExtraLvals) },
-			{ list__append(ExtraLvals, OutLvals, LiveArgLvals) }
-		;
-			{ LiveArgLvals = OutLvals }
-		),
+		{ list__append(TypeInfoLvals, OutLvals, LiveArgLvals) },
 		{ set__list_to_set(LiveArgLvals, LiveArgs) },
+
 		(
 			{ CodeModel = model_det },
 			{ SuccessCode = node([
@@ -644,14 +699,12 @@
 				goto(succip) - "Return from procedure call"
 			]) },
 			{ AllSuccessCode =
-				tree(SuccessTraceCode,
+				tree(TraceExitCode,
 				tree(RestoreDeallocCode,
 				     SuccessCode))
-			},
-			{ AllFailureCode = empty }
+			}
 		;
 			{ CodeModel = model_semi },
-			code_info__restore_failure_cont(ResumeCode),
 			{ set__insert(LiveArgs, reg(r, 1), SuccessLiveRegs) },
 			{ SuccessCode = node([
 				assign(reg(r, 1), const(true)) - "Succeed",
@@ -659,21 +712,9 @@
 				goto(succip) - "Return from procedure call"
 			]) },
 			{ AllSuccessCode =
-				tree(SuccessTraceCode,
+				tree(TraceExitCode,
 				tree(RestoreDeallocCode,
 				     SuccessCode))
-			},
-			{ set__singleton_set(FailureLiveRegs, reg(r, 1)) },
-			{ FailureCode = node([
-				assign(reg(r, 1), const(false)) - "Fail",
-				livevals(FailureLiveRegs) - "",
-				goto(succip) - "Return from procedure call"
-			]) },
-			{ AllFailureCode =
-				tree(ResumeCode,
-				tree(FailureTraceCode,
-				tree(RestoreDeallocCode,
-				     FailureCode)))
 			}
 		;
 			{ CodeModel = model_non },
@@ -683,105 +724,20 @@
 					- "Return from procedure call"
 			]) },
 			{ AllSuccessCode =
-				tree(SuccessTraceCode,
+				tree(TraceExitCode,
 				     SuccessCode)
-			},
-			{ AllFailureCode = empty }
+			}
 		),
 		{ EpilogCode =
 			tree(StartComment,
 			tree(FlushCode,
 			tree(AllSuccessCode,
-			tree(AllFailureCode,
-			     EndComment))))
+			     EndComment)))
 		}
 	).
 
 %---------------------------------------------------------------------------%
 
-	% Generate the list of lval - live_value_type pairs for the
-	% the given variables.
-
-:- pred code_gen__generate_var_infos(list(var), list(lval),
-		list(var_info), code_info, code_info).
-:- mode code_gen__generate_var_infos(in, in, out, in, out) is det.
-code_gen__generate_var_infos(Vars, Lvals, VarInfos) -->
-		% Add the variable names, insts, types and lvals.
-	code_info__get_varset(VarSet),
-	code_info__get_instmap(InstMap),
-	{ map__from_corresponding_lists(Vars, Lvals, VarLvalMap) },
-	=(CodeInfo),
-	{ MakeVarInfo = lambda([Var::in, VarInfo::out] is det, (
-		map__lookup(VarLvalMap, Var, Lval),
-		code_info__variable_type(Var, Type, CodeInfo, _),
-		instmap__lookup_var(InstMap, Var, Inst),
-		LiveType = var(Type, Inst),
-		varset__lookup_name(VarSet, Var, "V_", Name),
-		VarInfo = var_info(Lval, LiveType, Name)
-	)) }, 
-	{ list__map(MakeVarInfo, Vars, VarInfos) }.
-
-
-	% Generate the tvar - lval pairs for the typeinfos of the
-	% given variables on entry to the procedure (we find the
-	% lval location by looking in the input registers).
-	
-:- pred code_gen__generate_typeinfos_on_entry(list(var), list(lval),
-		assoc_list(tvar, lval), code_info, code_info).
-:- mode code_gen__generate_typeinfos_on_entry(in, in, out, in, out) is det.
-code_gen__generate_typeinfos_on_entry(Vars, Lvals, TypeInfos) -->
-
-	code_gen__find_typeinfos_for_vars(Vars, TVars, TypeInfoVars),
-
-		% Find the locations of the TypeInfoVars.
-	{ map__from_corresponding_lists(Vars, Lvals, VarLvalMap) },
-	{ map__apply_to_list(TypeInfoVars, VarLvalMap, TypeInfoLvals) },
-	{ assoc_list__from_corresponding_lists(TVars, TypeInfoLvals,
-		TypeInfos) }.
-
-	% Generate the tvar - lval pairs for the typeinfos of the
-	% given variables on exit from the procedure (we use code_exprn
-	% to find the lvals).
-
-:- pred code_gen__generate_typeinfos_on_exit(list(var), assoc_list(var, lval),
-		code_info, code_info).
-:- mode code_gen__generate_typeinfos_on_exit(in, out, in, out) is det.
-code_gen__generate_typeinfos_on_exit(Vars, TypeInfos) -->
-
-	code_gen__find_typeinfos_for_vars(Vars, TVars, TypeInfoVars),
-
-		% Find the locations of the TypeInfoVars.
-	code_info__variable_locations(VarLocs),
-	{ map__apply_to_list(TypeInfoVars, VarLocs, TypeInfoLvalSets) },
-	{ FindSingleLval = lambda([Set::in, Lval::out] is det, (
-		(
-			set__remove_least(Set, Value, _),
-			Value = lval(Lval0)
-		->
-			Lval = Lval0
-		;
-			error("code_gen__generate_typeinfos_on_exit: typeinfo var not available")
-		))) },
-	{ list__map(FindSingleLval, TypeInfoLvalSets, TypeInfoLvals) },
-	{ assoc_list__from_corresponding_lists(TVars, TypeInfoLvals,
-		TypeInfos) }.
-
-:- pred code_gen__find_typeinfos_for_vars(list(var), list(tvar), list(var),
-		code_info, code_info).
-:- mode code_gen__find_typeinfos_for_vars(in, out, out, in, out) is det.
-code_gen__find_typeinfos_for_vars(Vars, TypeVars, TypeInfoVars) -->
-		% Find the TypeInfo variables
-	list__map_foldl(code_info__variable_type, Vars, Types),
-	{ list__map(type_util__vars, Types, TypeVarsList) },
-	{ list__condense(TypeVarsList, TypeVars0) },
-	{ list__sort_and_remove_dups(TypeVars0, TypeVars) },
-        code_info__get_proc_info(ProcInfo),
-	{ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap) },
-	{ map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns) },
-	{ list__map(type_info_locn_var, TypeInfoLocns, TypeInfoVars) }.
-
-%---------------------------------------------------------------------------%
-
 % 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 context-specific predicates.
@@ -801,12 +757,12 @@
 		{ goal_info_get_code_model(GoalInfo, CodeModel) },
 		(
 			{ CodeModel = model_det },
-			code_gen__generate_det_goal_2(Goal, GoalInfo, Code0)
+			code_gen__generate_det_goal_2(Goal, GoalInfo, Code)
 		;
 			{ CodeModel = model_semi },
 			( { ContextModel \= model_det } ->
 				code_gen__generate_semi_goal_2(Goal, GoalInfo,
-					Code0)
+					Code)
 			;
 				{ error("semidet model in det context") }
 			)
@@ -814,7 +770,7 @@
 			{ CodeModel = model_non },
 			( { ContextModel = model_non } ->
 				code_gen__generate_non_goal_2(Goal, GoalInfo,
-					Code0)
+					Code)
 			;
 				{ error("nondet model in det/semidet context") }
 			)
@@ -822,17 +778,7 @@
 			% Make live any variables which subsequent goals
 			% will expect to be live, but were not generated
 		code_info__set_instmap(Instmap),
-		code_info__post_goal_update(GoalInfo),
-		code_info__get_globals(Options),
-		(
-			{ globals__lookup_bool_option(Options, lazy_code, yes) }
-		->
-			{ Code1 = empty }
-		;
-			{ error("Eager code unavailable") }
-%%%			code_info__generate_eager_flush(Code1)
-		),
-		{ Code = tree(Code0, Code1) }
+		code_info__post_goal_update(GoalInfo)
 	;
 		{ Code = empty }
 	),
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.218
diff -u -r1.218 code_info.m
--- code_info.m	1998/03/03 17:33:48	1.218
+++ code_info.m	1998/03/16 04:51:03
@@ -41,7 +41,7 @@
 :- implementation.
 
 :- import_module code_util, code_exprn, prog_out.
-:- import_module type_util, mode_util, options.
+:- import_module arg_info, type_util, mode_util, options.
 
 :- import_module set, varset, stack.
 :- import_module string, require, char, bimap, tree, int.
@@ -68,8 +68,8 @@
 		% Create a new code_info structure.
 :- pred code_info__init(varset, set(var), stack_slots, bool, globals,
 	pred_id, proc_id, proc_info, instmap, follow_vars, module_info,
-	int /* cell number */, continuation_info, code_info).
-:- mode code_info__init(in, in, in, in, in, in, in, in, in, in, in, in, in,
+	int /* cell number */, code_info).
+:- mode code_info__init(in, in, in, in, in, in, in, in, in, in, in, in,
 	out) is det.
 
 		% Get the variables for the current procedure.
@@ -118,13 +118,9 @@
 :- pred code_info__get_globals(globals, code_info, code_info).
 :- mode code_info__get_globals(out, in, out) is det.
 
-:- pred code_info__get_continuation_info(continuation_info, 
+:- pred code_info__get_layout_info(map(label, internal_layout_info), 
 		code_info, code_info).
-:- mode code_info__get_continuation_info(out, in, out) is det.
-
-:- pred code_info__set_continuation_info(continuation_info, 
-		code_info, code_info).
-:- mode code_info__set_continuation_info(in, in, out) is det.
+:- mode code_info__get_layout_info(out, in, out) is det.
 
 :- pred code_info__get_maybe_trace_info(maybe(trace_info),
 		code_info, code_info).
@@ -185,6 +181,10 @@
 	code_info, code_info).
 :- mode code_info__set_temps_in_use(in, in, out) is det.
 
+:- pred code_info__set_layout_info(map(label, internal_layout_info), 
+		code_info, code_info).
+:- mode code_info__set_layout_info(in, in, out) is det.
+
 :- pred code_info__get_zombies(set(var), code_info, code_info).
 :- mode code_info__get_zombies(out, in, out) is det.
 
@@ -240,10 +240,10 @@
 			map(lval, slot_contents),
 					% The temp locations in use on the stack
 					% and what they contain (for gc).
-			continuation_info,	
+			map(label, internal_layout_info),	
 					% Information on which values
-					% are live at continuation
-					% points, for accurate gc.
+					% are live and where at which labels,
+					% for tracing and/or accurate gc.
 			set(var),	% Zombie variables; variables that have
 					% been killed but are protected by a
 					% resume point.
@@ -287,11 +287,11 @@
 
 code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals,
 		PredId, ProcId, ProcInfo, Requests, FollowVars,
-		ModuleInfo, CellCount, Shapes, C) :-
+		ModuleInfo, CellCount, C) :-
 	proc_info_headvars(ProcInfo, HeadVars),
 	proc_info_arg_info(ProcInfo, ArgInfos),
 	assoc_list__from_corresponding_lists(HeadVars, ArgInfos, Args),
-	code_info__build_input_arg_list(Args, ArgList),
+	arg_info__build_input_arg_list(Args, ArgList),
 	globals__get_options(Globals, Options),
 	code_exprn__init_state(ArgList, Varset, StackSlots, FollowVars,
 		Options, ExprnInfo),
@@ -300,6 +300,7 @@
 	set__init(AvailSlots0),
 	map__init(TempsInUse0),
 	set__init(Zombies0),
+	map__init(Shapes),
 	code_info__max_var_slot(StackSlots, VarSlotCount0),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	(
@@ -334,24 +335,6 @@
 		no
 	).
 
-	% XXX This should be in arg_info.m.
-:- pred code_info__build_input_arg_list(assoc_list(var, arg_info),
-	assoc_list(var, rval)).
-:- mode code_info__build_input_arg_list(in, out) is det.
-
-code_info__build_input_arg_list([], []).
-code_info__build_input_arg_list([V - Arg | Rest0], VarArgs) :-
-	Arg = arg_info(Loc, Mode),
-	(
-		Mode = top_in
-	->
-		code_util__arg_loc_to_register(Loc, Reg),
-		VarArgs = [V - lval(Reg) | VarArgs0]
-	;
-		VarArgs = VarArgs0
-	),
-	code_info__build_input_arg_list(Rest0, VarArgs0).
-
 %---------------------------------------------------------------------------%
 
 code_info__get_var_slot_count(A, CI, CI) :-
@@ -422,7 +405,7 @@
 	CI = code_info(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, Q, _, _,
 		_, _, _).
 
-code_info__get_continuation_info(R, CI, CI) :-
+code_info__get_layout_info(R, CI, CI) :-
 	CI = code_info(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, R, _,
 		_, _, _).
 
@@ -475,10 +458,10 @@
 %	Q		map(lval, slot_contents),
 %					% The temp locations in use on the stack
 %					% and what they contain (for gc).
-%	R		continuation_info,	
+%	R		map(label, internal_layout_info),	
 %					% Information on which values
-%					% are live at continuation
-%					% points, for accurate gc.
+%					% are live and where at which labels,
+%					% for tracing and/or accurate gc.
 %	S		set(var),	% Zombie variables; variables that have
 %					% been killed but are protected by a
 %					% resume point.
@@ -581,7 +564,7 @@
 	CI = code_info(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q,
 		R, S, T, U, V).
 
-code_info__set_continuation_info(R, CI0, CI) :-
+code_info__set_layout_info(R, CI0, CI) :-
 	CI0 = code_info(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q,
 		_, S, T, U, V),
 	CI = code_info(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q,
@@ -731,6 +714,10 @@
 :- pred code_info__succip_is_used(code_info, code_info).
 :- mode code_info__succip_is_used(in, out) is det.
 
+:- pred code_info__add_layout_for_label(label, internal_layout_info,
+	code_info, code_info).
+:- mode code_info__add_layout_for_label(in, in, in, out) is det.
+
 %---------------------------------------------------------------------------%
 
 :- implementation.
@@ -967,12 +954,11 @@
 	code_info__set_fail_stack(J, C3, C4),
 	code_info__get_max_temp_slot_count(PC, C1, _),
 	code_info__set_max_temp_slot_count(PC, C4, C5),
-	code_info__get_continuation_info(ContInfo, C1, _),
-	code_info__set_continuation_info(ContInfo, C5, C6),
+	code_info__get_layout_info(LayoutInfo, C1, _),
+	code_info__set_layout_info(LayoutInfo, C5, C6),
 	code_info__get_cell_count(CellCount, C1, _),
 	code_info__set_cell_count(CellCount, C6, C).
 
-
 code_info__apply_instmap_delta(Delta) -->
 	code_info__get_instmap(InstMap0),
 	{ instmap__apply_instmap_delta(InstMap0, Delta, InstMap) },
@@ -1014,6 +1000,15 @@
 code_info__succip_is_used -->
 	code_info__set_succip_used(yes).
 
+code_info__add_layout_for_label(Label, LayoutInfo) -->
+	code_info__get_layout_info(Internals0),
+	( { map__contains(Internals0, Label) } ->
+		{ error("adding layout for already known label") }
+	;
+		{ map__det_insert(Internals0, Label, LayoutInfo, Internals) },
+		code_info__set_layout_info(Internals)
+	).
+
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
 
@@ -2504,6 +2499,11 @@
 	code_info, code_info).
 :- mode code_info__produce_variable_in_reg(in, out, out, in, out) is det.
 
+:- pred code_info__produce_variable_in_reg_or_stack(var, code_tree, rval,
+	code_info, code_info).
+:- mode code_info__produce_variable_in_reg_or_stack(in, out, out, in, out)
+	is det.
+
 :- pred code_info__materialize_vars_in_rval(rval, rval, code_tree, code_info,
 	code_info).
 :- mode code_info__materialize_vars_in_rval(in, out, out, in, out) is det.
@@ -2561,6 +2561,9 @@
 	code_info, code_info).
 :- mode code_info__save_variables_on_stack(in, out, in, out) is det.
 
+:- pred code_info__max_reg_in_use(int, code_info, code_info).
+:- mode code_info__max_reg_in_use(out, in, out) is det.
+
 %---------------------------------------------------------------------------%
 
 :- implementation.
@@ -2569,11 +2572,6 @@
 	code_info, code_info).
 :- mode code_info__place_vars(in, out, in, out) is det.
 
-:- pred code_info__produce_variable_in_reg_or_stack(var, code_tree, rval,
-	code_info, code_info).
-:- mode code_info__produce_variable_in_reg_or_stack(in, out, out, in, out)
-	is det.
-
 code_info__variable_locations(Locations) -->
 	code_info__get_exprn_info(Exprn),
 	{ code_exprn__get_varlocs(Exprn, Locations) }.
@@ -2785,6 +2783,10 @@
 	code_info__save_variable_on_stack(Var, FirstCode),
 	code_info__save_variables_on_stack(Vars, RestCode),
 	{ Code = tree(FirstCode, RestCode) }.
+
+code_info__max_reg_in_use(Max) -->
+	code_info__get_exprn_info(Exprn),
+	{ code_exprn__max_reg_in_use(Exprn, Max) }.
 
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.95
diff -u -r1.95 code_util.m
--- code_util.m	1998/03/03 17:33:50	1.95
+++ code_util.m	1998/03/16 04:33:34
@@ -147,6 +147,16 @@
 	int, int).
 :- mode code_util__count_recursive_calls(in, in, in, out, out) is det.
 
+	% These predicates return the set of lvals referenced in an rval
+	% and an lval respectively. Lvals referenced indirectly through
+	% lvals of the form var(_) are not counted.
+
+:- pred code_util__lvals_in_rval(rval, list(lval)).
+:- mode code_util__lvals_in_rval(in, out) is det.
+
+:- pred code_util__lvals_in_lval(lval, list(lval)).
+:- mode code_util__lvals_in_lval(in, out) is det.
+
 %---------------------------------------------------------------------------%
 
 :- implementation.
@@ -868,3 +878,56 @@
 		int__min(Min0, Min1, Min),
 		int__max(Max0, Max1, Max)
 	).
+
+%-----------------------------------------------------------------------------%
+
+code_util__lvals_in_rval(lval(Lval), [Lval | Lvals]) :-
+	code_util__lvals_in_lval(Lval, Lvals).
+code_util__lvals_in_rval(var(_), []).
+code_util__lvals_in_rval(create(_, _, _, _, _), []).
+code_util__lvals_in_rval(mkword(_, Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+code_util__lvals_in_rval(const(_), []).
+code_util__lvals_in_rval(unop(_, Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+code_util__lvals_in_rval(binop(_, Rval1, Rval2), Lvals) :-
+	code_util__lvals_in_rval(Rval1, Lvals1),
+	code_util__lvals_in_rval(Rval2, Lvals2),
+	list__append(Lvals1, Lvals2, Lvals).
+code_util__lvals_in_rval(mem_addr(MemRef), Lvals) :-
+	code_util__lvals_in_mem_ref(MemRef, Lvals).
+
+code_util__lvals_in_lval(reg(_, _), []).
+code_util__lvals_in_lval(stackvar(_), []).
+code_util__lvals_in_lval(framevar(_), []).
+code_util__lvals_in_lval(succip, []).
+code_util__lvals_in_lval(maxfr, []).
+code_util__lvals_in_lval(curfr, []).
+code_util__lvals_in_lval(succip(Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+code_util__lvals_in_lval(redoip(Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+code_util__lvals_in_lval(succfr(Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+code_util__lvals_in_lval(prevfr(Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+code_util__lvals_in_lval(hp, []).
+code_util__lvals_in_lval(sp, []).
+code_util__lvals_in_lval(field(_, Rval1, Rval2), Lvals) :-
+	code_util__lvals_in_rval(Rval1, Lvals1),
+	code_util__lvals_in_rval(Rval2, Lvals2),
+	list__append(Lvals1, Lvals2, Lvals).
+code_util__lvals_in_lval(lvar(_), []).
+code_util__lvals_in_lval(temp(_, _), []).
+code_util__lvals_in_lval(mem_ref(Rval), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+
+:- pred code_util__lvals_in_mem_ref(mem_ref, list(lval)).
+:- mode code_util__lvals_in_mem_ref(in, out) is det.
+
+code_util__lvals_in_mem_ref(stackvar_ref(_), []).
+code_util__lvals_in_mem_ref(framevar_ref(_), []).
+code_util__lvals_in_mem_ref(heap_ref(Rval, _, _), Lvals) :-
+	code_util__lvals_in_rval(Rval, Lvals).
+
+%-----------------------------------------------------------------------------%
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.10
diff -u -r1.10 continuation_info.m
--- continuation_info.m	1998/03/03 17:33:54	1.10
+++ continuation_info.m	1998/03/18 00:55:48
@@ -6,37 +6,38 @@
 %
 % File: continuation_info.m.
 % Main author: trd.
+% Extensive modifications by zs.
 %
-% This file defines the continuation_info data structure, which is used
-% to hold the information we need to output stack_layout tables, 
-% are for
-% accurate garbage collection.
+% This file defines the continuation_info data structure, which the code
+% generator uses to collect information that will later be converted into
+% stack_layout tables for accurate garbage collection, for stack tracing,
+% execution tracing and perhaps other purposes.
 %
 % Information is collected in several passes. 
-%	- If trace_stack_layouts are needed, 
-%		- during the generation of the procedure's prolog code 
-%		  (in code_gen.m) we add the information about live values
-%		  at entry.
-%		- during the generation of the procedure's epilog code 
-%		  (in code_gen.m) we add the information about live
-%		  values at exit.
 %
-% 	- If basic_stack_layouts are needed, after code for a procedure
-% 	  has been generated, the proc_layout_general_info is added to
-% 	  the continuation_info, and some internal label information
-% 	  is initialized (but not filled in with live values).
+% 	- Before we start generating code for a procedure,
+%	  we initialize the set of internal labels for which we have
+%	  layout information to the empty set. This set is stored in
+%	  the code generator state.
 %
-% 	- If agc_stack_layouts are needed, after the code has been
-% 	  optimized a pass is made over the final LLDS instructions.
-% 	  Information about internal labels, is collected.  The liveness
-% 	  information in call instructions is stored with the
-% 	  corresponding continuation label.
+%	- During code generation for the procedure, provided the option
+%	  trace_stack_layouts is set, we add layout information for labels
+%	  that represent trace ports to the code generator state.
+%
+% 	- After we finish generating code for a procedure, we record
+%	  all the static information about the procedure (some of which
+%	  is available only after code generation), and the info about
+%	  internal labels accumulated in the code generator state,
+%	  in the continuation_info structure (which is part of HLDS).
+%
+% 	- If agc_stack_layouts is set, we make a pass over the
+% 	  optimized code recorded in the final LLDS instructions.
+%	  In this pass, we collect information from call instructions
+%	  about the internal labels to which calls can return.
+%	  This info will also go straight into the HLDS.
 %
 % stack_layout.m converts the information collected in this module into
 % stack_layout tables.
-%		
-% The data structures in this module could do with a re-design when it
-% becomes more stable.
 
 %-----------------------------------------------------------------------------%
 
@@ -45,7 +46,7 @@
 :- interface.
 
 :- import_module llds, hlds_pred, prog_data, hlds_data.
-:- import_module set, map, list, assoc_list, term, std_util.
+:- import_module set, map, list, std_util.
 
 	%
 	% Information used by the continuation_info module.
@@ -59,60 +60,43 @@
 	% Information for any procedure, includes information about the
 	% procedure itself, and any internal labels within it.
 	%
-	% The maybe(data) are needed because the data is collected
-	% in a roundabout fashion from various phases of compilation.
-	% In some compilation grades, they are not even needed.
-	% Before data is collected, the field is set to `no'. If
-	% the data is needed (according to various stack_layout
-	% options) it will later be set to a `yes(....)'.
-	% The map is initialized to an empty map, and is later filled
-	% with entries (if required).
-	%
 :- type proc_layout_info
 	--->	proc_layout_info(
-			maybe(proc_layout_general_info),
-					% information on the procedure,
-					% needed for basic_stack_layouts
-			map(label, internal_layout_info),
-					% info for each internal label,
-					% needed for basic_stack_layouts
-			maybe(continuation_label_info),  % entry
-			maybe(continuation_label_info)	 % exit
-					% live data information about
-					% entry and exit points,
-					% needed for trace_stack_layouts
-		).
-
-:- type proc_layout_general_info
-	--->	proc_layout_general_info(
 			proc_label,	% the proc label
 			determinism,	% which stack is used
 			int,		% number of stack slots
-			maybe(int)	% location of succip on stack
+			maybe(int),	% location of succip on stack
+			maybe(label),	% name of the label of the call event
+			proc_label_layout_info
+					% info for each internal label,
+					% needed for basic_stack_layouts
 		).
 
 	%
+	% Information about the labels internal to a procedure.
+	%
+:- type proc_label_layout_info	==	map(label, internal_layout_info).
+
+	%
 	% Information for any internal label.
-	% (Continuation labels are a special case of internal labels).
+	% At some labels, we are interested in the layout of live data;
+	% at others, we are not. The layout_label_info will be present
+	% only for labels of the first kind.
 	%
-:- type internal_layout_info
-	--->	internal_layout_info(
-			maybe(continuation_label_info)
-				% needed for agc_stack_layouts
-		).
+:- type internal_layout_info	==	maybe(layout_label_info).
 
 	%
-	% Information for a label that is a continuation.
+	% Information about the layout of live data for a label.
 	%
 	% Different calls can assign slightly
 	% different liveness annotations to the labels after the call.
 	% (Two different paths of computation can leave different
 	% information live).
 	% We take the intersection of these annotations.  Intersecting
-	% is easy if we represent the live values and type infos as
-	% sets.
-:- type continuation_label_info
-	--->	continuation_label_info(
+	% is easy if we represent the live values and type infos as sets.
+	%
+:- type layout_label_info
+	--->	layout_label_info(
 			set(var_info),
 				% live vars and their locations/names
 			set(pair(tvar, lval))
@@ -128,8 +112,7 @@
 
 	% Return an initialized continuation info structure.
 
-:- pred continuation_info__init(continuation_info).
-:- mode continuation_info__init(out) is det.
+:- pred continuation_info__init(continuation_info::out) is det.
 
 	%
 	% Add the information for a single proc.
@@ -138,44 +121,30 @@
 	% the code model for this proc, and the stack slot of the succip
 	% in this proc (if there is one).
 	%
-:- pred continuation_info__add_proc_layout_info(pred_proc_id, proc_label,
-		int, determinism, maybe(int), continuation_info,
-		continuation_info).
-:- mode continuation_info__add_proc_layout_info(in, in, in, in, in, in,
-		out) is det.
-
-:- pred continuation_info__add_proc_entry_info(pred_proc_id, 
-		list(var_info), assoc_list(var, lval),
-		continuation_info, continuation_info).
-:- mode continuation_info__add_proc_entry_info(in, in, in, in, out) is det.
-
-:- pred continuation_info__add_proc_exit_info(pred_proc_id, 
-		list(var_info), assoc_list(var, lval),
-		continuation_info, continuation_info).
-:- mode continuation_info__add_proc_exit_info(in, in, in, in, out) is det.
-
-:- pred continuation_info__process_llds(list(c_procedure),
-		continuation_info, continuation_info) is det.
-:- mode continuation_info__process_llds(in, in, out) is det.
-
-	%
-	% Add the information for all the labels within a
-	% proc.
-	%
-	% Takes the list of instructions for this proc, the
-	% proc_label, the number of stack slots, the code model for this
-	% proc, and the stack slot of the succip in this proc.
-	%
-:- pred continuation_info__process_instructions(pred_proc_id,
-	list(instruction), continuation_info, continuation_info).
-:- mode continuation_info__process_instructions(in, in, in, out) is det.
+:- pred continuation_info__add_proc_info(pred_proc_id::in, proc_label::in,
+	int::in, determinism::in, maybe(int)::in, maybe(label)::in,
+	proc_label_layout_info::in, continuation_info::in,
+	continuation_info::out) is det.
+
+	%
+	% Call continuation_info__process_instructions on the code
+	% of every procedure in the list.
+	%
+:- pred continuation_info__process_llds(list(c_procedure)::in,
+	continuation_info::in, continuation_info::out) is det.
+
+	%
+	% Add the information for all the continuation labels within a proc.
+	%
+:- pred continuation_info__process_instructions(pred_proc_id::in,
+	list(instruction)::in, continuation_info::in, continuation_info::out)
+	is det.
 
 	%
 	% Get the finished list of proc_layout_infos.
 	%
-:- pred continuation_info__get_all_proc_layouts(list(proc_layout_info),
-		continuation_info, continuation_info).
-:- mode continuation_info__get_all_proc_layouts(out, in, out) is det.
+:- pred continuation_info__get_all_proc_layouts(continuation_info::in,
+	list(proc_layout_info)::out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -185,16 +154,7 @@
 :- import_module require.
 
 	% The continuation_info data structure
-
-:- type continuation_info
-	--->	continuation_info(
-			map(pred_proc_id, proc_layout_info),
-				% A proc_layout_info for every procedure
-				% processed
-			map(label, internal_layout_info)
-				% internal labels processed so far
-				% in the current procedure
-			).
+:- type continuation_info	==	map(pred_proc_id, proc_layout_info).
 
 %-----------------------------------------------------------------------------%
 
@@ -205,34 +165,31 @@
 	%
 
 continuation_info__init(ContInfo) :-
-	map__init(LabelMap),
-	map__init(Internals),
-	ContInfo = continuation_info(LabelMap, Internals).
-
-continuation_info__add_proc_entry_info(PredProcId, TypeLvals, TypeInfos) -->
-	continuation_info__get_proc_layout(PredProcId, ProcLayout0),
-	{ ProcLayout0 = proc_layout_info(MaybeProcGeneral, InternalMap, _,
-		ExitInfo) },
-	{ set__list_to_set(TypeLvals, TypeLvalSet) },
-	{ set__list_to_set(TypeInfos, TypeInfoSet) },
-	{ EntryInfo = yes(continuation_label_info(TypeLvalSet, TypeInfoSet)) },
-	{ ProcLayout = proc_layout_info(MaybeProcGeneral, InternalMap, 
-		EntryInfo, ExitInfo) },
-	continuation_info__update_proc_layout(PredProcId, ProcLayout).
-
-continuation_info__add_proc_exit_info(PredProcId, TypeLvals, TypeInfos) -->
-	continuation_info__get_proc_layout(PredProcId, ProcLayout0),
-	{ ProcLayout0 = proc_layout_info(MaybeProcGeneral, InternalMap, 
-		EntryInfo, _) },
-	{ set__list_to_set(TypeLvals, TypeLvalSet) },
-	{ set__list_to_set(TypeInfos, TypeInfoSet) },
-	{ ExitInfo = yes(continuation_label_info(TypeLvalSet, TypeInfoSet)) },
-	{ ProcLayout = proc_layout_info(MaybeProcGeneral, InternalMap, 
-		EntryInfo, ExitInfo) },
-	continuation_info__update_proc_layout(PredProcId, ProcLayout).
-	
+	map__init(ContInfo).
+
+	%
+	% Add the info for this proc (a proc_layout_info) to the
+	% continuation_info. 
+	%
+continuation_info__add_proc_info(PredProcId, ProcLabel, StackSize,
+		Detism, SuccipLocation, MaybeTraceCallLabel, InternalMap,
+		ContInfo0, ContInfo) :-
+	( map__contains(ContInfo0, PredProcId) ->
+		error("duplicate continuation_info for proc.")
+	;
+		LayoutInfo = proc_layout_info(ProcLabel, Detism, StackSize,
+			SuccipLocation, MaybeTraceCallLabel, InternalMap),
+		map__det_insert(ContInfo0, PredProcId, LayoutInfo, ContInfo)
+	).
+
+	%
+	% Get all the proc_layout_infos.
+	%
+continuation_info__get_all_proc_layouts(ContInfo, Entries) :-
+	map__values(ContInfo, Entries).
+
 continuation_info__process_llds([]) --> [].
-continuation_info__process_llds([Proc|Procs]) -->
+continuation_info__process_llds([Proc | Procs]) -->
 	{ Proc = c_procedure(_, _, PredProcId, Instrs) },
 	continuation_info__process_instructions(PredProcId, Instrs),
 	continuation_info__process_llds(Procs).
@@ -241,103 +198,51 @@
 	% Process the list of instructions for this proc, adding
 	% all internal label information to the continuation_info.
 	%
-continuation_info__process_instructions(PredProcId, Instructions) -->
+continuation_info__process_instructions(PredProcId, Instructions,
+		ContInfo0, ContInfo) :-
 
-		% Get all the continuation info from the call instructions
-	continuation_info__initialize_internal_info,
-	{ GetCallLivevals = lambda([Instr::in, Pair::out] is semidet, (
+		% Get all the continuation info from the call instructions.
+	map__lookup(ContInfo0, PredProcId, ProcLayoutInfo0),
+	ProcLayoutInfo0 = proc_layout_info(A, B, C, D, E, Internals0),
+	GetCallLivevals = lambda([Instr::in, Pair::out] is semidet, (
 		Instr = call(_, label(Label), LiveInfo, _) - _Comment,
 		Pair = Label - LiveInfo
-		)) },
-	{ list__filter_map(GetCallLivevals, Instructions, Calls) },
+	)),
+	list__filter_map(GetCallLivevals, Instructions, Calls),
 
-		% Process the continuation label info
-	list__foldl(continuation_info__process_internal_info,
-		Calls),
-
-		% Get all internal labels.
-		% (Some labels are not used as continuations).
-	{ GetAllInternalLabels = lambda([Instr::in, Label::out] is semidet, (
+		% Process the continuation label info.
+	list__foldl(continuation_info__process_continuation, Calls,
+		Internals0, Internals1),
+
+		% Add empty entries for the labels that do not have real info,
+		% since if continuation_info__process_instructions is invoked
+		% then MR_USE_STACK_LAYOUTS will be defined, and this demands
+		% a stack layout data structure for every label, even if it
+		% is not used. When this aspect of the runtime is fixed,
+		% we will be able to remove this step.
+	GetAllInternalLabels = lambda([Instr::in, Label::out] is semidet, (
 		Instr = label(Label) - _Comment,
 		Label = local(_, _)
-		)) },
-	{ list__filter_map(GetAllInternalLabels, Instructions, Labels) },
-
-		% Insert all non-continuation internal labels into the
-		% internals, then add the internals to the information
-		% for this proc.
-	continuation_info__add_non_continuation_labels(Labels),
-	continuation_info__get_internal_info(InternalInfo),
-	continuation_info__add_internal_info_to_proc(PredProcId, InternalInfo).
-
-	%
-	% Add the info for this proc (a proc_layout_info) to the
-	% continuation_info. 
-	%
-continuation_info__add_proc_layout_info(PredProcId, ProcLabel, StackSize,
-		Detism, SuccipLocation) -->
-	continuation_info__get_proc_layout(PredProcId, ProcLayoutInfo0),
-	{ 
-		ProcLayoutInfo0 = proc_layout_info(no, InternalMap, 
-			EntryInfo, ExitInfo) 
-	->
-		ProcLayoutInfo = proc_layout_info(yes(proc_layout_general_info(
-			ProcLabel, Detism, StackSize, SuccipLocation)), 
-			InternalMap, EntryInfo, ExitInfo)
-	;
-		error("continuation_info__add_proc_layout_info: general information already done.")
-	},
-	continuation_info__update_proc_layout(PredProcId, ProcLayoutInfo).
+	)),
+	list__filter_map(GetAllInternalLabels, Instructions, Labels),
+	list__foldl(continuation_info__ensure_label_is_present, Labels,
+		Internals1, Internals),
 
-	%
-	% Get all the proc_layout_infos.
-	%
-continuation_info__get_all_proc_layouts(Entries, ContInfo, ContInfo) :-
-	ContInfo = continuation_info(Map, _),
-	map__values(Map, Entries).
+	ProcLayoutInfo = proc_layout_info(A, B, C, D, E, Internals),
+	map__det_update(ContInfo0, PredProcId, ProcLayoutInfo, ContInfo).
 
 %-----------------------------------------------------------------------------%
 
 	%
-	% Add the list of internal labels to the internal_info
-	% in the continuation_info.
-	%
-:- pred continuation_info__add_non_continuation_labels(list(label),
-		continuation_info, continuation_info).
-:- mode continuation_info__add_non_continuation_labels(in, in, out) is det.
-
-continuation_info__add_non_continuation_labels(Labels) -->
-	continuation_info__get_internal_info(InternalInfo0),
-	{ list__foldl(continuation_info__ensure_label_is_present, Labels,
-		InternalInfo0, InternalInfo) },
-	continuation_info__set_internal_info(InternalInfo).
-
-	%
-	% Add a label to the internals, if it isn't already there.
-	%
-:- pred continuation_info__ensure_label_is_present(label,
-		map(label, internal_layout_info),
-		map(label, internal_layout_info)).
-:- mode continuation_info__ensure_label_is_present(in, in, out) is det.
-continuation_info__ensure_label_is_present(Label, InternalMap0, InternalMap) :-
-	( map__contains(InternalMap0, Label) ->
-		InternalMap = InternalMap0
-	;
-		Internal = internal_layout_info(no),
-		map__det_insert(InternalMap0, Label,
-			Internal, InternalMap)
-	).
-
-	%
 	% Collect the liveness information from a single label and add
 	% it to the internals.
 	%
-:- pred continuation_info__process_internal_info(pair(label,
-		list(liveinfo)), continuation_info, continuation_info).
-:- mode continuation_info__process_internal_info(in, in, out) is det.
+:- pred continuation_info__process_continuation(
+	pair(label, list(liveinfo))::in,
+	proc_label_layout_info::in, proc_label_layout_info::out) is det.
 
-continuation_info__process_internal_info(Label - LiveInfoList, ContInfo0,
-		ContInfo) :-
+continuation_info__process_continuation(Label - LiveInfoList,
+		Internals0, Internals) :-
 	GetVarInfo = lambda([LiveLval::in, VarInfo::out] is det, (
 		LiveLval = live_lvalue(Lval, LiveValueType, Name, _),
 		VarInfo = var_info(Lval, LiveValueType, Name)
@@ -351,10 +256,40 @@
 	list__sort_and_remove_dups(TypeInfoList, SortedTypeInfoList),
 	set__sorted_list_to_set(SortedTypeInfoList, TypeInfoSet),
 	set__list_to_set(VarInfoList, VarInfoSet),
-	NewInternal = internal_layout_info(
-		yes(continuation_label_info(VarInfoSet, TypeInfoSet))),
+	NewInternal = yes(layout_label_info(VarInfoSet, TypeInfoSet)),
 	continuation_info__add_internal_info(Label, NewInternal,
-		ContInfo0, ContInfo).
+		Internals0, Internals).
+
+:- pred continuation_info__ensure_label_is_present(label::in,
+	proc_label_layout_info::in, proc_label_layout_info::out) is det.
+
+continuation_info__ensure_label_is_present(Label, InternalMap0, InternalMap) :-
+	( map__contains(InternalMap0, Label) ->
+		InternalMap = InternalMap0
+	;
+		map__det_insert(InternalMap0, Label, no, InternalMap)
+	).
+
+%-----------------------------------------------------------------------------%
+
+	%
+	% Add an internal info to the list of internal infos.
+	%
+:- pred continuation_info__add_internal_info(label::in,
+	internal_layout_info::in,
+	proc_label_layout_info::in, proc_label_layout_info::out) is det.
+
+continuation_info__add_internal_info(Label, Internal1,
+		Internals0, Internals) :-
+	(
+		map__search(Internals0, Label, Internal0)
+	->
+		continuation_info__merge_internal_labels(Internal0, Internal1,
+			Internal),
+		map__set(Internals0, Label, Internal, Internals)
+	;
+		map__det_insert(Internals0, Label, Internal1, Internals)
+	).
 
 	%
 	% Merge the continuation label information of two labels.
@@ -367,157 +302,24 @@
 	% label is guaranteed not to depend on it.
 	% XXX Is this true for non-det code?
 
-:- pred continuation_info__merge_internal_labels(maybe(continuation_label_info),
-	maybe(continuation_label_info), maybe(continuation_label_info)).
-:- mode continuation_info__merge_internal_labels(in, in, out) is det.
+:- pred continuation_info__merge_internal_labels(
+	maybe(layout_label_info)::in, maybe(layout_label_info)::in,
+	maybe(layout_label_info)::out) is det.
 
 continuation_info__merge_internal_labels(no, no, no).
 continuation_info__merge_internal_labels(no,
-		yes(continuation_label_info(LV0, TV0)),
-		yes(continuation_label_info(LV0, TV0))).
+		yes(layout_label_info(LV0, TV0)),
+		yes(layout_label_info(LV0, TV0))).
 continuation_info__merge_internal_labels(
-		yes(continuation_label_info(LV0, TV0)),
+		yes(layout_label_info(LV0, TV0)),
 		no,
-		yes(continuation_label_info(LV0, TV0))).
+		yes(layout_label_info(LV0, TV0))).
 continuation_info__merge_internal_labels(
-		yes(continuation_label_info(LV0, TV0)),
-		yes(continuation_label_info(LV1, TV1)),
-		yes(continuation_label_info(LV, TV))) :-
+		yes(layout_label_info(LV0, TV0)),
+		yes(layout_label_info(LV1, TV1)),
+		yes(layout_label_info(LV, TV))) :-
 	set__intersect(LV0, LV1, LV),
 	set__intersect(TV0, TV1, TV).
-
-%-----------------------------------------------------------------------------%
-
-	% Procedures to manipulate continuation_info
-
-	%
-	% Add the given proc_layout_info to the continuation_info.
-	%
-:- pred continuation_info__insert_proc_layout(pred_proc_id, proc_layout_info,
-		continuation_info, continuation_info).
-:- mode continuation_info__insert_proc_layout(in, in, in, out) is det.
-
-continuation_info__insert_proc_layout(PredProcId, ProcLayoutInfo,
-		ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap0, Internals),
-	map__det_insert(ProcLayoutMap0, PredProcId, ProcLayoutInfo,
-		ProcLayoutMap),
-	ContInfo = continuation_info(ProcLayoutMap, Internals).
-
-	%
-	% Get the proc layout if it exists, otherwise return an 
-	% empty one.
-	%
-:- pred continuation_info__get_proc_layout(pred_proc_id, proc_layout_info,
-		continuation_info, continuation_info).
-:- mode continuation_info__get_proc_layout(in, out, in, out) is det.
-
-continuation_info__get_proc_layout(PredProcId, ProcLayoutInfo,
-		ContInfo, ContInfo) :-
-	ContInfo = continuation_info(ProcLayoutMap, _Internals),
-	( 
-		map__search(ProcLayoutMap, PredProcId, ProcLayoutInfo0)
-	->
-		ProcLayoutInfo = ProcLayoutInfo0
-	;
-		map__init(InternalMap),
-		ProcLayoutInfo = proc_layout_info(no, InternalMap, no, no)
-	).
-
-	%
-	% Update a proc layout.
-	%
-:- pred continuation_info__update_proc_layout(pred_proc_id, proc_layout_info,
-		continuation_info, continuation_info).
-:- mode continuation_info__update_proc_layout(in, in, in, out) is det.
-
-continuation_info__update_proc_layout(PredProcId, ProcLayoutInfo,
-		ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap0, Internals),
-	map__set(ProcLayoutMap0, PredProcId, ProcLayoutInfo, ProcLayoutMap),
-	ContInfo = continuation_info(ProcLayoutMap, Internals).
-
-	%
-	% Add the given internal_info to the given procedure in
-	% the continuation_info.
-	%
-	% (The procedure proc_layout_info has already been processed and
-	% added, but at that time the internal_info wasn't available).
-	%
-:- pred continuation_info__add_internal_info_to_proc(pred_proc_id,
-		map(label, internal_layout_info), continuation_info,
-		continuation_info).
-:- mode continuation_info__add_internal_info_to_proc(in, in, in, out) is det.
-
-continuation_info__add_internal_info_to_proc(PredProcId, InternalLayout,
-		ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap0, Internals),
-	map__lookup(ProcLayoutMap0, PredProcId, ProcLayoutInfo0),
-	ProcLayoutInfo0 = proc_layout_info(MaybeProcGeneral, _, EntryInfo,
-		ExitInfo),
-	ProcLayoutInfo = proc_layout_info(MaybeProcGeneral, InternalLayout,
-		EntryInfo, ExitInfo),
-	map__set(ProcLayoutMap0, PredProcId, ProcLayoutInfo, ProcLayoutMap),
-	ContInfo = continuation_info(ProcLayoutMap, Internals).
-
-	%
-	% Add an internal info to the list of internal infos.
-	%
-:- pred continuation_info__add_internal_info(label,
-		internal_layout_info, continuation_info, continuation_info).
-:- mode continuation_info__add_internal_info(in, in, in, out) is det.
-
-continuation_info__add_internal_info(Label, Internal, ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap, Internals0),
-	Internal = internal_layout_info(ContLabelInfo0),
-	(
-		map__search(Internals0, Label, Existing)
-	->
-		Existing = internal_layout_info(ContLabelInfo1),
-		continuation_info__merge_internal_labels(ContLabelInfo0,
-			ContLabelInfo1, ContLabelInfo),
-		New = internal_layout_info(ContLabelInfo),
-		map__set(Internals0, Label, New, Internals)
-		
-	;
-		map__det_insert(Internals0, Label, Internal, Internals)
-	),
-	ContInfo = continuation_info(ProcLayoutMap, Internals).
-
-	%
-	% Initialize the internal info.
-	%
-:- pred continuation_info__initialize_internal_info(
-	continuation_info, continuation_info).
-:- mode continuation_info__initialize_internal_info(in, out) is det.
-
-continuation_info__initialize_internal_info(ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap, _),
-	map__init(Internals),
-	ContInfo = continuation_info(ProcLayoutMap, Internals).
-
-	%
-	% Set the internal info.
-	%
-:- pred continuation_info__set_internal_info(
-	map(label, internal_layout_info), continuation_info,
-	continuation_info).
-:- mode continuation_info__set_internal_info(in, in, out) is det.
-
-continuation_info__set_internal_info(Internals, ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap, _),
-	ContInfo = continuation_info(ProcLayoutMap, Internals).
-
-	%
-	% Get the internal_info.
-	%
-:- pred continuation_info__get_internal_info(
-		map(label, internal_layout_info),
-		continuation_info, continuation_info).
-:- mode continuation_info__get_internal_info(out, in, out) is det.
-
-continuation_info__get_internal_info(InternalMap, ContInfo, ContInfo) :-
-	ContInfo = continuation_info(_, InternalMap).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%



More information about the developers mailing list