diff: Compiler changes for stack layouts (round 2)

[Tyson Richard DOWD]

Most problems from the last incarnation of this diff have now
been fixed, except for those which have been designated as future
work.

One outstanding problem is that of different paths to the same
label can have different liveness - this diff doesn't fix that, I
need to spend more time looking at why the problem occurs.

This diff should fix the problems with the cell numbers not being
correctly calculated, but I'm unable to check this -- 
I can't reproduce the bug in Zoltan's test case.

===================================================================

Estimated hours taken: 50

Generate stack layouts for accurate garbage collection.

compiler/base_type_layout.m:
	Change the order of some arguments so that threaded data
	structures are more often in the final two arguments (allows
	easy use of higher order predicates).
	Simplify some code using higher order preds.
	Export base_type_layout__construct_pseudo_type_info, as
	stack_layout.m needs to be able to generate pseudo_type_infos
	too.
	Fix problems with cell numbers being re-used -- get the next
	cell number from module_info, and update module_info
	after processing base_type_layouts.

compiler/code_gen.m:
	Add information about each procedure to the continuation info.
	Handle new field in c_procedure.

compiler/continuation_info.m:
	Redesign most of this module to deal with labels
	that are continuation points for multiple calls.
	Change the order of some arguments so that threaded data
	structures are in the final two arguments.
	Cleaned up and documented code.

compiler/dupelim.m:
compiler/exprn_aux.m:
	Handle new label_entry data type.

compiler/export.m:
compiler/opt_debug.m:
	Handle new label_entry and general data types.

compiler/llds_out.m:
	Add an argument to get_proc_label to control whether a
	"mercury_" prefix is wanted.
	Handle new label_entry and general data types.

compiler/llds.m:
	Add a new alternative for data_const - a label_entry.
	Add a new alternative for data_name - general, which
	allows any sort of data, with names generated elsewhere.
	Add the pred_proc_id as a field of c_procedure.

compiler/optimize.m:
compiler/llds_common.m:
compiler/optimize.m:
	Handle new field in c_procedure.

compiler/mercury_compile.m:
	Generate layout information after code has been generated,
	and output stack layouts.

compiler/notes/compiler_design.html:
	Document new stack_layout module.

compiler/stack_layout.m:
	New file - generates the LLDS code that defines
	global constants to hold the stack_layout structures.

compiler/options.m:
compiler/handle_options.m:
	Add --stack-layout option which outputs stack layouts.
	Make accurate gc imply stack_layout.



Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.22
diff -u -r1.22 base_type_layout.m
--- base_type_layout.m	1997/08/22 13:54:37	1.22
+++ base_type_layout.m	1997/11/02 14:18:03
@@ -222,8 +222,15 @@
 :- pred base_type_layout__generate_hlds(module_info, module_info).
 :- mode base_type_layout__generate_hlds(in, out) is det.
 
-:- pred base_type_layout__generate_llds(module_info, list(c_module)).
-:- mode base_type_layout__generate_llds(in, out) is det.
+:- pred base_type_layout__generate_llds(module_info, module_info,
+		list(c_module)).
+:- mode base_type_layout__generate_llds(in, out, out) is det.
+
+	% stack_layout.m uses this.
+	% The int arguments are label numbers for generating `create' rvals
+	% with.
+:- pred base_type_layout__construct_pseudo_type_info(type, rval, int, int).
+:- mode base_type_layout__construct_pseudo_type_info(in, out, in, out) is det.
 
 :- implementation.
 
@@ -303,18 +310,20 @@
 %---------------------------------------------------------------------------%
 
 	% Initialize the LayoutInfo, and begin processing BaseGenInfos.
-base_type_layout__generate_llds(ModuleInfo, CModules) :-
-	module_info_base_gen_layouts(ModuleInfo, BaseGenInfos),
-	module_info_globals(ModuleInfo, Globals),
+base_type_layout__generate_llds(ModuleInfo0, ModuleInfo, CModules) :-
+	module_info_base_gen_layouts(ModuleInfo0, BaseGenInfos),
+	module_info_globals(ModuleInfo0, Globals),
 	globals__lookup_int_option(Globals, num_tag_bits, NumTagBits),
 	int__pow(2, NumTagBits, MaxTags),
-	module_info_name(ModuleInfo, ModuleName),
-	module_info_ctors(ModuleInfo, ConsTable),
-	LayoutInfo0 = layout_info(ModuleName, ConsTable, MaxTags, 0, 
+	module_info_name(ModuleInfo0, ModuleName),
+	module_info_ctors(ModuleInfo0, ConsTable),
+	module_info_get_cell_count(ModuleInfo0, CellCount),
+	LayoutInfo0 = layout_info(ModuleName, ConsTable, MaxTags, CellCount, 
 		unqualified("") - 0, []),
 	base_type_layout__construct_base_type_data(BaseGenInfos, 
 		LayoutInfo0, LayoutInfo),
-	LayoutInfo = layout_info(_, _, _, _, _, CModules).
+	LayoutInfo = layout_info(_, _, _, FinalCellCount, _, CModules),
+	module_info_set_cell_count(ModuleInfo0, FinalCellCount, ModuleInfo).
 
 %---------------------------------------------------------------------------%
 
@@ -512,16 +521,16 @@
 :- pred base_type_layout__encode_create(layout_info, int, list(maybe(rval)),
 		bool, int, list(maybe(rval))).
 :- mode base_type_layout__encode_create(in, in, in, in, in, out) is det.
-base_type_layout__encode_create(LayoutInfo, Tag, Rvals0, Unique, Label, 
+base_type_layout__encode_create(LayoutInfo, Tag, Rvals0, Unique, CellNumber, 
 		Rvals) :-
 	base_type_layout__get_max_tags(LayoutInfo, MaxTags),
 	(
 		MaxTags < 4
 	->
 		Rvals = [yes(const(int_const(Tag))), 
-			yes(create(0, Rvals0, Unique, Label))]
+			yes(create(0, Rvals0, Unique, CellNumber))]
 	;
-		Rvals = [yes(create(Tag, Rvals0, Unique, Label))]
+		Rvals = [yes(create(Tag, Rvals0, Unique, CellNumber))]
 	).
 
 	% Encode a cons tag (simple or complicated) in rvals.
@@ -603,11 +612,11 @@
 	base_type_layout__layout_enum_vector(ConsList, VectorRvals),
 
 		% Create a tagged pointer to it
-	base_type_layout__get_next_label(LayoutInfo0, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo0,
+		LayoutInfo),
 	base_type_layout__tag_value_const(Tag),
 	base_type_layout__encode_create(LayoutInfo, Tag, 
-		VectorRvals, no, NextLabel, Rval),
+		VectorRvals, no, NextCellNumber, Rval),
 
 		% Duplicate it MaxTags times.
 	base_type_layout__get_max_tags(LayoutInfo, MaxTags),
@@ -653,12 +662,12 @@
 	base_type_layout__layout_no_tag_vector(SymName, Type,
 		LayoutInfo0, LayoutInfo1, VectorRvals),
 
-	base_type_layout__get_next_label(LayoutInfo1, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo1,
+		LayoutInfo),
 	base_type_layout__tag_value_equiv(Tag),
 
 	base_type_layout__encode_create(LayoutInfo, Tag, 
-			VectorRvals, no, NextLabel, Rval),
+			VectorRvals, no, NextCellNumber, Rval),
 
 	base_type_layout__get_max_tags(LayoutInfo, MaxTags),
 	list__duplicate(MaxTags, Rval, RvalsList),
@@ -682,8 +691,8 @@
 	Rval0 = yes(const(int_const(NoTagIndicator))),
 
 		% generate pseudo_type_info
-	base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0, 
-		LayoutInfo1, Rval1),
+	base_type_layout__generate_pseudo_type_info(Type, Rval1, LayoutInfo0, 
+		LayoutInfo1),
 
 		% functor name
 	unqualify_name(SymName, Name),
@@ -709,8 +718,8 @@
 base_type_layout__layout_eqv(Type, LayoutInfo0, LayoutInfo, Rvals) :-
 
 		% generate rest of word, remove a level of creates
-	base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0, 
-		LayoutInfo1, Rval0),
+	base_type_layout__generate_pseudo_type_info(Type, Rval0, LayoutInfo0, 
+		LayoutInfo1),
 	base_type_layout__tag_value_equiv(Tag),
 	( 
 		% If it was a constant (a type variable), then tag it
@@ -726,10 +735,10 @@
 		base_type_layout__no_tag_indicator(no, NoTagIndicator),
 		IndicatorRval = yes(const(int_const(NoTagIndicator))),
 		
-		base_type_layout__get_next_label(LayoutInfo1, NextLabel),
-		base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
+		base_type_layout__get_next_cell_number(NextCellNumber, 
+			LayoutInfo1, LayoutInfo),
 		base_type_layout__encode_create(LayoutInfo, Tag, 
-			[IndicatorRval, Rval0], no, NextLabel, Rval)
+			[IndicatorRval, Rval0], no, NextCellNumber, Rval)
 	),
 	base_type_layout__get_max_tags(LayoutInfo, MaxTags),
 	list__duplicate(MaxTags, Rval, RvalsList),
@@ -837,11 +846,11 @@
 		))),
 	    [C | Cs], CtorNameRvals),
 
-	base_type_layout__get_next_label(LayoutInfo0, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo0,
+		LayoutInfo),
 	base_type_layout__tag_value(comp_const, Tag),
 	base_type_layout__encode_create(LayoutInfo, Tag, 
-		[Rval0, Rval1 | CtorNameRvals], no, NextLabel, Rval).
+		[Rval0, Rval1 | CtorNameRvals], no, NextCellNumber, Rval).
 
 
 	% For simple tags:
@@ -855,11 +864,11 @@
 base_type_layout__handle_simple(ConsList, LayoutInfo0, LayoutInfo, Rval) :-
 	base_type_layout__simple_vector(ConsList, LayoutInfo0, LayoutInfo1,
 		EndRvals),
-	base_type_layout__get_next_label(LayoutInfo1, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo1,
+		LayoutInfo),
 	base_type_layout__tag_value(simple, Tag),
 	base_type_layout__encode_create(LayoutInfo, Tag, EndRvals, no, 
-		NextLabel, Rval).
+		NextCellNumber, Rval).
 
 	% Create a simple vector.
 	%
@@ -885,8 +894,8 @@
 	),
 	base_type_layout__get_cons_args(LayoutInfo0, ConsId, ConsArgs),
 	list__length(ConsArgs, NumArgs),
-	base_type_layout__generate_pseudo_type_infos(ConsArgs, 
-		LayoutInfo0, LayoutInfo1, PseudoTypeInfos),
+	list__map_foldl(base_type_layout__generate_pseudo_type_info,
+		ConsArgs, PseudoTypeInfos, LayoutInfo0, LayoutInfo1),
 	base_type_layout__encode_cons_tag(ConsTag, ConsTagRvals, LayoutInfo1,
 		LayoutInfo),
 	list__append([yes(const(int_const(NumArgs))) | PseudoTypeInfos], 
@@ -908,8 +917,8 @@
 base_type_layout__handle_complicated([], _, _, _) :-
 	error("base_type_layout: no constructors for complicated tag").
 base_type_layout__handle_complicated([C | Cs], LayoutInfo0, LayoutInfo, Rval) :-
-	base_type_layout__get_next_label(LayoutInfo0, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo1),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo0,
+		LayoutInfo1),
 
 		% Number of sharers
 	list__length([C | Cs], NumCtors),
@@ -930,7 +939,7 @@
 
 	base_type_layout__tag_value(complicated, Tag),
 	base_type_layout__encode_create(LayoutInfo, Tag, 
-		[NumSharersRval | SharedRvals], no, NextLabel, Rval).
+		[NumSharersRval | SharedRvals], no, NextCellNumber, Rval).
 
 %---------------------------------------------------------------------------%
 
@@ -949,8 +958,8 @@
 base_type_layout__functors_eqv(Type, LayoutInfo0, LayoutInfo, Rvals) :-
 
 		% Construct pseudo
-	base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0, 
-		LayoutInfo, Rvals0),
+	base_type_layout__generate_pseudo_type_info(Type, Rvals0, LayoutInfo0, 
+		LayoutInfo),
 	base_type_layout__functors_value(equiv, EqvIndicator),
 	EqvRval = yes(const(int_const(EqvIndicator))),
 	Rvals = [EqvRval, Rvals0].
@@ -970,11 +979,11 @@
 	base_type_layout__layout_enum_vector(ConsList, VectorRvals),
 
 		% Create a pointer to it
-	base_type_layout__get_next_label(LayoutInfo0, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo0,
+		LayoutInfo),
 	base_type_layout__functors_value(enum, EnumIndicator),
 	EnumRval = yes(const(int_const(EnumIndicator))),
-	CreateRval = yes(create(0, VectorRvals, no, NextLabel)),
+	CreateRval = yes(create(0, VectorRvals, no, NextCellNumber)),
 	Rvals = [EnumRval, CreateRval].
 
 	% base_type_functors of a no_tag:
@@ -993,9 +1002,9 @@
 	base_type_layout__layout_no_tag_vector(SymName, Type,
 		LayoutInfo0, LayoutInfo1, VectorRvals),
 
-	base_type_layout__get_next_label(LayoutInfo1, NextLabel),
-	base_type_layout__incr_next_label(LayoutInfo1, LayoutInfo),
-	CreateRval = yes(create(0, VectorRvals, no, NextLabel)),
+	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo1,
+		LayoutInfo),
+	CreateRval = yes(create(0, VectorRvals, no, NextCellNumber)),
 
 	base_type_layout__functors_value(no_tag, NoTagIndicator),
 	NoTagRval = yes(const(int_const(NoTagIndicator))),
@@ -1023,12 +1032,10 @@
 			Acc = Rvals0 - LayoutInfoA,
 			base_type_layout__simple_vector([ConsPair], LayoutInfoA,
 				LayoutInfoB, VectorRvalList),
-			base_type_layout__get_next_label(LayoutInfoB,
-				NextLabel),
-			base_type_layout__incr_next_label(LayoutInfoB,
-				LayoutInfoC),
+			base_type_layout__get_next_cell_number(NextCellNumber,
+				LayoutInfoB, LayoutInfoC),
 			VectorRval = yes(create(0, VectorRvalList, no, 
-				NextLabel)),
+				NextCellNumber)),
 			Rvals1 = [VectorRval | Rvals0],
 			NewAcc = Rvals1 - LayoutInfoC)),
 		ConsList, [] - LayoutInfo0, VectorRvals - LayoutInfo),
@@ -1053,44 +1060,28 @@
 
 %---------------------------------------------------------------------------%
 
-	% Generate some pseudo-typeinfos as create() rvals.
-	%
-	% Pseudo-typeinfos are just like typeinfos, but can also
-	% store type variables. We store type variables as integers,
-	% which will always have low values.
-	
-:- pred base_type_layout__generate_pseudo_type_infos(list(type), layout_info,
-	layout_info, list(maybe(rval))).
-:- mode base_type_layout__generate_pseudo_type_infos(in, in, out, out) is det.
-
-base_type_layout__generate_pseudo_type_infos([], LayoutInfo, LayoutInfo, []).
-base_type_layout__generate_pseudo_type_infos([Type | Types], LayoutInfo0, 
-		LayoutInfo, [PseudoTypeInfo | PseudoTypeInfos]) :-
-	base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0, 
-		LayoutInfo1, PseudoTypeInfo),
-	base_type_layout__generate_pseudo_type_infos(Types, LayoutInfo1, 
-		LayoutInfo, PseudoTypeInfos).
+:- pred base_type_layout__generate_pseudo_type_info(type, maybe(rval), 
+	layout_info, layout_info).
+:- mode base_type_layout__generate_pseudo_type_info(in, out, in, out) is det.
+
+base_type_layout__generate_pseudo_type_info(Type, yes(Rval), LayoutInfo0, 
+		LayoutInfo) :-
+	base_type_layout__get_cell_number(LayoutInfo0, CellNumber0),
+	base_type_layout__construct_pseudo_type_info(Type, Rval, 
+		CellNumber0, CellNumber),
+	base_type_layout__set_cell_number(CellNumber, LayoutInfo0, LayoutInfo).
 
-	% generate a single pseudo-typeinfo as a create() rval.
-	
-:- pred base_type_layout__generate_pseudo_type_info(type, layout_info,
-	layout_info, maybe(rval)).
-:- mode base_type_layout__generate_pseudo_type_info(in, in, out, out) is det.
 
-base_type_layout__generate_pseudo_type_info(Type, LayoutInfo0, LayoutInfo,
-		Pseudo) :-
+base_type_layout__construct_pseudo_type_info(Type, Pseudo, CNum0, CNum) :-
 	(
 		type_to_type_id(Type, TypeId, TypeArgs)
 	->
 		( 
-			% XXX higher order types are tricky. For the moment,
-			% we'll just make them refer to the defined pred_0
-			% base_type_info, with argument according to
-			% their types. The arity will need to be
-			% obtained from elsewhere - for most
-			% applications the closure contains the number
-			% of arguments present in the closure, which
-			% is enough to copy them.
+			% For higher order types: they all refer to the
+			% defined pred_0 base_type_info, have an extra
+			% argument for their real arity, and then type
+			% arguments according to their types. 
+			% polymorphism.m has a detailed explanation.
 
 			type_is_higher_order(Type, _PredFunc, _TypeArgs)
 		->
@@ -1105,20 +1096,20 @@
 			sym_name_get_module_name(QualTypeName, "", TypeModule),
 			RealArityArg = []
 		),
-		base_type_layout__get_next_label(LayoutInfo0, NextLabel),
-		base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo1),
 		Pseudo0 = yes(const(data_addr_const(data_addr(TypeModule,
 			base_type(info, TypeName, Arity))))),
+		CNum1 = CNum0 + 1,
 
 			% generate args, but remove one level of create()s.
-		base_type_layout__generate_pseudo_type_infos(TypeArgs,
-			LayoutInfo1, LayoutInfo, PseudoArgs0),
-		base_type_layout__remove_creates(PseudoArgs0, PseudoArgs1),
+		list__map_foldl(base_type_layout__construct_pseudo_type_info,
+			TypeArgs, PseudoArgs0, CNum1, CNum),
+		list__map(base_type_layout__remove_create, PseudoArgs0,
+			PseudoArgs1),
 
 		list__append(RealArityArg, PseudoArgs1, PseudoArgs),
 
-		Pseudo = yes(create(0, [Pseudo0 | PseudoArgs], no, 
-			NextLabel))
+		Pseudo = create(0, [Pseudo0 | PseudoArgs], no, 
+			CNum0)
 	;
 		type_util__var(Type, Var)
 	->
@@ -1126,34 +1117,25 @@
 		base_type_layout__max_varint(MaxVarInt),
 		require(VarInt < MaxVarInt, 
 			"base_type_layout: type variable representation exceeds limit"),
-		Pseudo = yes(const(int_const(VarInt))),
-		LayoutInfo = LayoutInfo0
+		Pseudo = const(int_const(VarInt)),
+		CNum = CNum0
 	;
 		error("base_type_layout: type neither var nor non-var")
 	).
 
-	% Remove a level of create() from a list of rvals.
-	
-:- pred base_type_layout__remove_creates(list(maybe(rval)), list(maybe(rval))).
-:- mode base_type_layout__remove_creates(in, out) is det.
-
-base_type_layout__remove_creates([], []).
-base_type_layout__remove_creates([MaybeRval0 | Rest0], [MaybeRval | Rest]) :-
-	base_type_layout__remove_create(MaybeRval0, MaybeRval),
-	base_type_layout__remove_creates(Rest0, Rest).
 
 	% Remove a create() from an rval, if present.
 	
-:- pred base_type_layout__remove_create(maybe(rval), maybe(rval)).
+:- pred base_type_layout__remove_create(rval, maybe(rval)).
 :- mode base_type_layout__remove_create(in, out) is det.
 
-base_type_layout__remove_create(MaybeRval0, MaybeRval) :-
+base_type_layout__remove_create(Rval0, Rval) :-
 	(
-		MaybeRval0 = yes(create(_, [PTI], _, _))
+		Rval0 = create(_, [PTI], _, _)
 	->
-		MaybeRval = PTI
+		Rval = PTI
 	;
-		MaybeRval = MaybeRval0
+		Rval = yes(Rval0)
 	).
 
 	% Gather the constructors for each tag into a list, and
@@ -1255,10 +1237,10 @@
 base_type_layout__get_max_tags(LayoutInfo, MaxTags) :-
 	LayoutInfo = layout_info(_, _, MaxTags, _, _, _).
 
-:- pred base_type_layout__get_next_label(layout_info, int).
-:- mode base_type_layout__get_next_label(in, out) is det.
-base_type_layout__get_next_label(LayoutInfo, NextLabel) :-
-	LayoutInfo = layout_info(_, _, _, NextLabel, _, _).
+:- pred base_type_layout__get_cell_number(layout_info, int).
+:- mode base_type_layout__get_cell_number(in, out) is det.
+base_type_layout__get_cell_number(LayoutInfo, NextCNum) :-
+	LayoutInfo = layout_info(_, _, _, NextCNum, _, _).
 
 :- pred base_type_layout__get_type_id(layout_info, type_id).
 :- mode base_type_layout__get_type_id(in, out) is det.
@@ -1277,11 +1259,17 @@
 	CModules = [CModule | CModules0],
 	LayoutInfo = layout_info(A, B, C, D, E, CModules).
 
-:- pred base_type_layout__incr_next_label(layout_info, layout_info).
-:- mode base_type_layout__incr_next_label(in, out) is det.
-base_type_layout__incr_next_label(LayoutInfo0, LayoutInfo) :-
-	LayoutInfo0 = layout_info(A, B, C, NextLabel0, E, F),
-	NextLabel = NextLabel0 + 1,
+:- pred base_type_layout__get_next_cell_number(int, layout_info, layout_info).
+:- mode base_type_layout__get_next_cell_number(out, in, out) is det.
+base_type_layout__get_next_cell_number(CNum0, LayoutInfo0, LayoutInfo) :-
+	LayoutInfo0 = layout_info(A, B, C, CNum0, E, F),
+	CNum = CNum0 + 1,
+	LayoutInfo = layout_info(A, B, C, CNum, E, F).
+
+:- pred base_type_layout__set_cell_number(int, layout_info, layout_info).
+:- mode base_type_layout__set_cell_number(in, in, out) is det.
+base_type_layout__set_cell_number(NextLabel, LayoutInfo0, LayoutInfo) :-
+	LayoutInfo0 = layout_info(A, B, C, _, E, F),
 	LayoutInfo = layout_info(A, B, C, NextLabel, E, F).
 
 :- pred base_type_layout__set_type_id(layout_info, type_id, layout_info).
Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.38
diff -u -r1.38 code_gen.m
--- code_gen.m	1997/10/11 15:42:40	1.38
+++ code_gen.m	1997/10/31 03:06:18
@@ -220,35 +220,32 @@
 		% now the code is a list of code fragments (== list(instr)),
 		% so we need to do a level of unwinding to get a flat list.
 	list__condense(FragmentList, Instructions0),
+	FrameInfo = frame(TotalSlots, MaybeSuccipSlot),
 	(
-		FrameInfo = frame(_TotalSlots, MaybeSuccipSlot),
 		MaybeSuccipSlot = yes(SuccipSlot)
 	->
 		code_gen__add_saved_succip(Instructions0,
-			SuccipSlot, Instructions),
-
-		( GC_Method = accurate ->
-			code_info__get_total_stackslot_count(StackSize,
-				CodeInfo, _),
-			code_util__make_proc_label(ModuleInfo, 
-				PredId, ProcId, ProcLabel),
-			continuation_info__add_proc_info(Instructions, 
-				ProcLabel, StackSize, CodeModel,
-				SuccipSlot, ContInfo1, ContInfo)
-		;
-			ContInfo = ContInfo1
-		)
+			SuccipSlot, Instructions)
 	;
-		ContInfo = ContInfo1,
 		Instructions = Instructions0
 	),
+	( GC_Method = accurate ->
+		code_util__make_proc_label(ModuleInfo, PredId, ProcId,
+			ProcLabel),
+		continuation_info__add_proc_layout_info(proc(PredId, ProcId),
+			ProcLabel, TotalSlots, CodeModel, MaybeSuccipSlot,
+			ContInfo1, ContInfo)
+	;
+		ContInfo = ContInfo1
+	),
 
 		% get the name and arity of this predicate
 	predicate_name(ModuleInfo, PredId, Name),
 	predicate_arity(ModuleInfo, PredId, Arity),
 		% construct a c_procedure structure with all the information
 	proc_id_to_int(ProcId, LldsProcId),
-	Proc = c_procedure(Name, Arity, LldsProcId, Instructions).
+	Proc = c_procedure(Name, Arity, LldsProcId, proc(PredId, ProcId),
+		Instructions).
 
 :- pred generate_category_code(code_model, hlds_goal, code_tree, frame_info,
 				code_info, code_info).
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/continuation_info.m,v
retrieving revision 1.3
diff -u -r1.3 continuation_info.m
--- continuation_info.m	1997/07/27 15:00:03	1.3
+++ continuation_info.m	1997/10/31 04:03:44
@@ -10,17 +10,19 @@
 % This file defines the continuation_info data structure, which is used
 % to hold the information we need to output stack_layout tables for
 % accurate garbage collection.
-
-% XXX What about redirected labels? Since we just traverse the call
-% instructions looking for return addresses, it's possible that we will 
-% store the information about a code address that actually occurs
-% outside the procedure.
-% We might want to check that code addresses are inside the procedure,
-% and keep seperate any that aren't until we can find out where they
-% really belong. Then again, maybe they aren't needed at all, since this
-% information is likely to be the same elsewhere.
-% Check this out - it's likely that tredirections aren't introduced
-% until optimization.
+%
+% Information is collected in two passes. 
+% 	1. After the code for a procedure has been generated, a
+% 	   proc_layout_info is added to the continuation info (using
+% 	   continuation_info__add_proc_layout_info). 
+% 	2. After 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.
+%
+% stack_layout.m converts the information collected in this module into
+% stack_layout tables.
+%		
 
 %-----------------------------------------------------------------------------%
 
@@ -28,23 +30,105 @@
 
 :- interface.
 
-:- import_module list, llds.
+:- import_module list, llds, hlds_pred.
 
+	%
+	% Information used by the continuation_info module.
+	% This is an abstract data type - when processing is finished
+	% use continuation_info__get_all_entries to retrieve the
+	% completed proc_layout_infos.
+	%
 :- type continuation_info.
 
+	%
+	% Information for any procedure, includes information about the
+	% procedure itself, and any internal labels within it.
+	%
+:- type proc_layout_info
+	--->
+		proc_layout_info(
+			proc_label,	% the proc label
+			int,		% number of stack slots
+			code_model,	% which stack is used
+			maybe(int),	% location of succip on stack
+			map(label, internal_layout_info)
+					% info for each internal label
+		).
+
+	%
+	% Information for any internal label.
+	% (Continuation labels are a special case of internal labels).
+	%
+:- type internal_layout_info
+	--->
+		internal_layout_info(
+			maybe(continuation_label_info)
+		).
+
+	%
+	% Information for a label that is a continuation.
+	%
+	% 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(
+			set(pair(lval, live_value_type)),
+					% live values and their
+					% locations
+			set(pair(tvar, lval))
+				% locations of polymorphic type vars
+		).
+
+
 	% Return an initialized continuation info structure.
 
 :- pred continuation_info__init(continuation_info).
 :- mode continuation_info__init(out) is det.
 
-	% Add the information for all the continuations within a 
-	% proc. Takes the list of instructions for this proc, the
+	%
+	% Add the information for a single proc.
+	%
+	% Takes the pred_proc_id, proc_label, the number of stack slots,
+	% 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, code_model, 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__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(list(instruction), proc_label,
-		int, code_model, int, continuation_info, continuation_info).
-:- mode continuation_info__add_proc_info(in, in, in, in, in, in, 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.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -52,71 +136,137 @@
 :- implementation.
 
 :- import_module llds, prog_data.
-:- import_module map, list, assoc_list, std_util, term.
+:- import_module map, list, assoc_list, std_util, term, set, require.
 
-	% The continuation_info data structure 
+	% The continuation_info data structure
 
 :- type continuation_info
 	--->	continuation_info(
-			map(proc_label, entry_layout_info),
-				% final data table 
-			list(internal_layout_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 entry_layout_info
-	--->
-		entry_layout_info(
-			int,		% number of stack slots
-			code_model,	% which stack is used
-			int,		% location of succip on stack
-			list(internal_layout_info) 
-					% info for each internal label
-		).
-
-:- type internal_layout_info
-	--->
-		internal_layout_info(
-			code_addr,	% what label is this associated with
-			assoc_list(lval, live_value_type),
-			assoc_list(tvar, lval)
-				% locations of polymorphic type vars
-		).
-					
-
-:- type type_param_locs == assoc_list(var, lval).
 
 %-----------------------------------------------------------------------------%
 
-continuation_info__add_proc_info(Instructions, ProcLabel, StackSize, CodeModel,
-	SuccipLocation, ContInfo0, ContInfo) :-
-		
-	continuation_info__set_internal_info([], ContInfo0, ContInfo1),
+	% Exported predicates.
 
-		% Get all the info for the internal labels.
-	GetCallLivevals = lambda([Instr::in, Pair::out] is semidet, (
-		Instr = call(_, Continuation, LiveInfo, _) - _Comment,
-		Pair = Continuation - LiveInfo
-		)),
-	list__filter_map(GetCallLivevals, Instructions, Calls),
-	list__foldl(continuation_info__process_internal_info, 
-		Calls, ContInfo1, ContInfo2),
+	%
+	% Initialize the continuation_info
+	%
 
-	continuation_info__get_internal_info(ContInfo2, InternalInfo),
+continuation_info__init(ContInfo) :-
+	map__init(LabelMap),
+	map__init(Internals),
+	ContInfo = continuation_info(LabelMap, Internals).
 
-	EntryLayout = entry_layout_info(StackSize, CodeModel,
-		SuccipLocation, InternalInfo),
+continuation_info__process_llds([]) --> [].
+continuation_info__process_llds([Proc|Procs]) -->
+	{ Proc = c_procedure(_, _, _, PredProcId, Instrs) },
+	continuation_info__process_instructions(PredProcId, Instrs),
+	continuation_info__process_llds(Procs).
+
+	%
+	% Process the list of instructions for this proc, adding
+	% all internal label information to the continuation_info.
+	%
+continuation_info__process_instructions(PredProcId, Instructions) -->
+
+		% Get all the continuation info from the call instructions
+	continuation_info__initialize_internal_info,
+	{ GetCallLivevals = lambda([Instr::in, Pair::out] is semidet, (
+		Instr = call(_, label(Label), LiveInfo, _) - _Comment,
+		Pair = Label - LiveInfo
+		)) },
+	{ 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, (
+		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,
+		CodeModel, SuccipLocation, ContInfo0, ContInfo) :-
+
+		% We don't know anything about the internals yet.
+	map__init(InternalMap),
+	ProcLayoutInfo = proc_layout_info(ProcLabel, StackSize, CodeModel,
+		SuccipLocation, InternalMap),
+	continuation_info__insert_proc_layout(PredProcId, ProcLayoutInfo,
+		ContInfo0, ContInfo).
+
+	%
+	% Get all the proc_layout_infos.
+	%
+continuation_info__get_all_proc_layouts(Entries, ContInfo, ContInfo) :-
+	ContInfo = continuation_info(Map, _),
+	map__values(Map, Entries).
 
-	continuation_info__add_proc_layout(ProcLabel, EntryLayout,
-		ContInfo2, ContInfo).
+%-----------------------------------------------------------------------------%
 
-	% Process a single continuation label.
+	%
+	% 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.
 
-:- pred continuation_info__process_internal_info(pair(code_addr,
+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.
 
-continuation_info__process_internal_info(CodeAddr - LiveInfoList, ContInfo0, 
+continuation_info__process_internal_info(Label - LiveInfoList, ContInfo0,
 		ContInfo) :-
 	GetTypeInfo = lambda([LiveLval::in, TypeInfos::out] is det, (
 		LiveLval = live_lvalue(_, _, TypeInfos)
@@ -129,51 +279,143 @@
 	list__map(GetTypeInfo, LiveInfoList, TypeInfoListList),
 	list__condense(TypeInfoListList, TypeInfoList),
 	list__sort_and_remove_dups(TypeInfoList, SortedTypeInfoList),
-	NewInternal = internal_layout_info(CodeAddr, LvalPairList, 
-		SortedTypeInfoList), 
-	continuation_info__add_internal_info(NewInternal, ContInfo0, 
+	set__sorted_list_to_set(SortedTypeInfoList, TypeInfoSet),
+	set__list_to_set(LvalPairList, LvalPairSet),
+	NewInternal = internal_layout_info(
+		yes(continuation_label_info(LvalPairSet, TypeInfoSet))),
+	continuation_info__add_internal_info(Label, NewInternal, ContInfo0,
 		ContInfo).
 
+	%
+	% Merge the continuation label information of two labels.
+	%
+	% If there are two continuation infos to be merged, we take
+	% the intersection.
+	%
+	% The reason why taking the intersection is correct is that if
+	% something is not live on one path, the code following the
+	% 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.
+
+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))).
+continuation_info__merge_internal_labels(
+		yes(continuation_label_info(LV0, TV0)),
+		no,
+		yes(continuation_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))) :-
+	set__intersect(LV0, LV1, LV),
+	set__intersect(TV0, TV1, TV).
+
 %-----------------------------------------------------------------------------%
 
-	% Initialize the continuation_info
+	% Procedures to manipulate continuation_info
 
-continuation_info__init(ContInfo) :-
-	map__init(LabelMap),
-	ContInfo = continuation_info(LabelMap, []).
 
-:- pred continuation_info__add_proc_layout(proc_label, entry_layout_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__add_proc_layout(in, in, in, out) is det.
+:- mode continuation_info__insert_proc_layout(in, in, in, out) is det.
 
-continuation_info__add_proc_layout(ProcLabel, EntryLayout, 
+continuation_info__insert_proc_layout(PredProcId, ProcLayoutInfo,
 		ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(ProcLayoutMap0, B),
-	map__det_insert(ProcLayoutMap0, ProcLabel, EntryLayout, ProcLayoutMap),
-	ContInfo = continuation_info(ProcLayoutMap, B).
-
-:- pred continuation_info__add_internal_info(internal_layout_info,
-		continuation_info, continuation_info).
-:- mode continuation_info__add_internal_info(in, in, out) is det.
-
-continuation_info__add_internal_info(Internal, ContInfo0, ContInfo) :-
-	ContInfo0 = continuation_info(A, Internals),
-	ContInfo = continuation_info(A, [ Internal | Internals ]).
+	ContInfo0 = continuation_info(ProcLayoutMap0, Internals),
+	map__det_insert(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.
 
-:- pred continuation_info__set_internal_info(list(internal_layout_info),
-		continuation_info, continuation_info).
+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(ProcLabel, StackSize, CodeModel,
+		SuccipLocation, _),
+	ProcLayoutInfo = proc_layout_info(ProcLabel, StackSize, CodeModel,
+		SuccipLocation, InternalLayout),
+	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(A, _),
-	ContInfo = continuation_info(A, Internals).
+	ContInfo0 = continuation_info(ProcLayoutMap, _),
+	ContInfo = continuation_info(ProcLayoutMap, Internals).
 
-:- pred continuation_info__get_internal_info(continuation_info, 
-		list(internal_layout_info)).
-:- mode continuation_info__get_internal_info(in, out) is det.
+	%
+	% 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(ContInfo, Internals) :-
-	ContInfo = continuation_info(_, Internals).
+continuation_info__get_internal_info(InternalMap, ContInfo, ContInfo) :-
+	ContInfo = continuation_info(_, InternalMap).
 
 
 %-----------------------------------------------------------------------------%
Index: compiler/dupelim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dupelim.m,v
retrieving revision 1.23
diff -u -r1.23 dupelim.m
--- dupelim.m	1997/10/31 00:41:24	1.23
+++ dupelim.m	1997/11/05 01:16:18
@@ -268,6 +268,7 @@
 	dupelim__replace_labels_code_addr(Addr0, Replmap, Addr).
 dupelim__replace_labels_rval_const(data_addr_const(DataAddr), _,
 		data_addr_const(DataAddr)).
+dupelim__replace_labels_rval_const(label_entry(Label), _, label_entry(Label)).
 
 :- pred dupelim__replace_labels_code_addr(code_addr, map(label, label),
 	code_addr).
Index: compiler/export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.14
diff -u -r1.14 export.m
--- export.m	1997/09/27 19:53:32	1.14
+++ export.m	1997/09/29 04:18:19
@@ -131,7 +131,7 @@
 	copy_output_args(ArgInfoTypes, 0, OutputArgs),
 	
 	code_util__make_proc_label(Module, PredId, ProcId, ProcLabel),
-	get_proc_label(ProcLabel, ProcLabelString),
+	get_proc_label(ProcLabel, yes, ProcLabelString),
 
 	string__append_list([	"\n",
 				C_RetType, "\n", 
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/exprn_aux.m,v
retrieving revision 1.22
diff -u -r1.22 exprn_aux.m
--- exprn_aux.m	1997/07/27 15:00:17	1.22
+++ exprn_aux.m	1997/08/15 05:30:07
@@ -131,6 +131,8 @@
 exprn_aux__const_is_constant(code_addr_const(CodeAddr), ExprnOpts, IsConst) :-
 	exprn_aux__addr_is_constant(CodeAddr, ExprnOpts, IsConst).
 exprn_aux__const_is_constant(data_addr_const(_), _, yes).
+exprn_aux__const_is_constant(label_entry(Label), ExprnOpts, IsConst) :-
+	exprn_aux__addr_is_constant(label(Label), ExprnOpts, IsConst).
 
 :- pred exprn_aux__addr_is_constant(code_addr, exprn_opts, bool).
 :- mode exprn_aux__addr_is_constant(in, in, out) is det.
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.34
diff -u -r1.34 handle_options.m
--- handle_options.m	1997/10/16 04:59:09	1.34
+++ handle_options.m	1997/10/23 00:15:32
@@ -525,7 +525,8 @@
 	% 'accurate' is now set in the grade, so we can override it here.
 	( 
 		{ GC = accurate }, 
-		set_string_opt(gc, "accurate") 
+		set_string_opt(gc, "accurate"), 
+		set_bool_opt(stack_layout, yes) 
 	; 
 		{ GC = conservative },
 		set_string_opt(gc, "conservative")
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.211
diff -u -r1.211 llds.m
--- llds.m	1997/10/12 13:32:31	1.211
+++ llds.m	1997/10/31 03:48:42
@@ -75,6 +75,7 @@
 			string,			% predicate name
 			int,			% arity
 			llds_proc_id,		% mode number
+			pred_proc_id,		% the pred_proc_id this code
 			list(instruction)	% the code for this procedure
 		).
 
@@ -425,7 +426,9 @@
 	;	float_const(float)
 	;	string_const(string)
 	;	code_addr_const(code_addr)
-	;	data_addr_const(data_addr).
+	;	data_addr_const(data_addr)
+	;	label_entry(label).
+			% the address of the label (uses ENTRY macro).
 
 :- type data_addr
 	--->	data_addr(string, data_name).
@@ -433,8 +436,10 @@
 
 :- type data_name
 	--->	common(int)
-	;	base_type(base_data, string, arity).
+	;	base_type(base_data, string, arity)
 			% base_data, type name, type arity
+	;	stack_layout(label).	
+			% stack_layout for a given label
 
 :- type base_data
 	--->	info
@@ -641,6 +646,7 @@
 llds__const_type(string_const(_), data_ptr).
 llds__const_type(code_addr_const(_), code_ptr).
 llds__const_type(data_addr_const(_), data_ptr).
+llds__const_type(label_entry(_), code_ptr).
 
 llds__unop_return_type(mktag, word).
 llds__unop_return_type(tag, word).
Index: compiler/llds_common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_common.m,v
retrieving revision 1.10
diff -u -r1.10 llds_common.m
--- llds_common.m	1997/08/25 17:48:23	1.10
+++ llds_common.m	1997/10/22 02:40:26
@@ -138,9 +138,9 @@
 :- mode llds_common__process_proc(in, in, out, out) is det.
 
 llds_common__process_proc(Proc0, Info0, Info, Proc) :-
-	Proc0 = c_procedure(Name, Arity, Mode, Instrs0),
+	Proc0 = c_procedure(Name, Arity, Mode, PredProcId, Instrs0),
 	llds_common__process_instrs(Instrs0, Info0, Info, Instrs),
-	Proc = c_procedure(Name, Arity, Mode, Instrs).
+	Proc = c_procedure(Name, Arity, Mode, PredProcId, Instrs).
 
 :- pred llds_common__process_instrs(list(instruction),
 	common_info, common_info, list(instruction)).
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.60
diff -u -r1.60 llds_out.m
--- llds_out.m	1997/10/31 00:41:29	1.60
+++ llds_out.m	1997/11/05 01:16:24
@@ -61,9 +61,18 @@
 :- mode output_proc_label(in, di, uo) is det.
 
 	% Get a proc label string (used by procs which are exported to C).
+	% The boolean controls whether a prefix ("mercury__") is added to the
+	% proc label.
 
-:- pred get_proc_label(proc_label, string).
-:- mode get_proc_label(in, out) is det.
+:- pred llds_out__get_proc_label(proc_label, bool, string).
+:- mode llds_out__get_proc_label(in, in, out) is det.
+
+	% Get a label string.
+	% The boolean controls whether a prefix ("mercury__") is added to the
+	% label.
+
+:- pred llds_out__get_label(label, bool, string).
+:- mode llds_out__get_label(in, in, out) is det.
 
 	% Mangle an arbitrary name into a C identifier
 
@@ -601,7 +610,7 @@
 :- mode output_c_procedure_decls(in, in, out, di, uo) is det.
 
 output_c_procedure_decls(Proc, DeclSet0, DeclSet) -->
-	{ Proc = c_procedure(_Name, _Arity, _ModeNum0, Instrs) },
+	{ Proc = c_procedure(_Name, _Arity, _ModeNum0, _PredProcId, Instrs) },
 	output_instruction_list_decls(Instrs, DeclSet0, DeclSet).
 
 :- pred output_c_procedure(c_procedure, bool, bool,
@@ -609,7 +618,7 @@
 :- mode output_c_procedure(in, in, in, di, uo) is det.
 
 output_c_procedure(Proc, PrintComments, EmitCLoops) -->
-	{ Proc = c_procedure(Name, Arity, ModeNum0, Instrs) },
+	{ Proc = c_procedure(Name, Arity, ModeNum0, _PredProcId, Instrs) },
 	( { PrintComments = yes } ->
 		io__write_string("\n/*-------------------------------------"),
 		io__write_string("------------------------------------*/\n")
@@ -2087,24 +2096,32 @@
 output_code_addr(do_not_reached) -->
 	io__write_string("ENTRY(do_not_reached)").
 
+
+	% Output a data address. 
+
 :- pred output_data_addr(string, data_name, io__state, io__state).
 :- mode output_data_addr(in, in, di, uo) is det.
 
 output_data_addr(BaseName0, VarName) -->
 	{ llds_out__name_mangle(BaseName0, BaseName) },
 	io__write_string("mercury_data_"),
-	io__write_string(BaseName),
 	(
 		{ VarName = common(N) },
+		io__write_string(BaseName),
 		io__write_string("__common_"),
 		{ string__int_to_string(N, NStr) },
 		io__write_string(NStr)
 	;
 		{ VarName = base_type(BaseData, TypeName0, TypeArity) },
+		io__write_string(BaseName),
 		{ llds_out__make_base_type_name(BaseData, TypeName0, TypeArity,
 			Str) },
 		io__write_string("__"),
 		io__write_string(Str)
+	;
+		{ VarName = stack_layout(Label) },
+		io__write_string("_stack_layout__"),
+		output_label(Label)
 	).
 
 :- pred output_label_as_code_addr(label, io__state, io__state).
@@ -2195,25 +2212,28 @@
 % is referred to as local(_) in type_info structures and as c_local(_)
 % in the recursive call.
 
-output_label(exported(ProcLabel)) -->
-	output_proc_label(ProcLabel).
-output_label(local(ProcLabel)) -->
-	output_proc_label(ProcLabel).
-output_label(c_local(ProcLabel)) -->
-	output_proc_label(ProcLabel).
-output_label(local(ProcLabel, Num)) -->
-	output_proc_label(ProcLabel),
-	io__write_string("_i"),		% i for "internal" (not Intel ;-)
-	io__write_int(Num).
+output_label(Label) -->
+	{ llds_out__get_label(Label, yes, LabelStr) },
+	io__write_string(LabelStr).
 
 output_proc_label(ProcLabel) -->
-	{ get_proc_label(ProcLabel, ProcLabelString) },
+	{ llds_out__get_proc_label(ProcLabel, yes, ProcLabelString) },
 	io__write_string(ProcLabelString).
 
-get_proc_label(proc(DefiningModule, PredOrFunc, PredModule,
-		PredName, Arity, ModeNum0), ProcLabelString) :-
+llds_out__get_label(exported(ProcLabel), AddPrefix, ProcLabelStr) :-
+	llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr).
+llds_out__get_label(local(ProcLabel), AddPrefix, ProcLabelStr) :-
+	llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr).
+llds_out__get_label(c_local(ProcLabel), AddPrefix, ProcLabelStr) :-
+	llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr).
+llds_out__get_label(local(ProcLabel, Num), AddPrefix, LabelStr) :-
+	llds_out__get_proc_label(ProcLabel, AddPrefix, ProcLabelStr),
+	string__format("%s_i%i", [s(ProcLabelStr), i(Num)], LabelStr).
+
+llds_out__get_proc_label(proc(DefiningModule, PredOrFunc, PredModule,
+		PredName, Arity, ModeNum0), AddPrefix, ProcLabelString) :-
 	get_label_name(DefiningModule, PredOrFunc, PredModule,
-		PredName, Arity, LabelName),
+		PredName, Arity, AddPrefix, LabelName),
 	( PredOrFunc = function ->
 		OrigArity is Arity - 1
 	;
@@ -2228,11 +2248,12 @@
 
 	% For a special proc, output a label of the form:
 	% mercury____<PredName>___<TypeModule>__<TypeName>_<TypeArity>_<Mode>
-get_proc_label(special_proc(Module, PredName, TypeModule, TypeName, TypeArity,
-				ModeNum0), ProcLabelString) :-
+llds_out__get_proc_label(special_proc(Module, PredName, TypeModule, 
+		TypeName, TypeArity, ModeNum0), AddPrefix, ProcLabelString) :-
 	% figure out the LabelName
 	DummyArity = -1,	% not used by get_label_name.
-	get_label_name("", predicate, "", PredName, DummyArity, LabelName),
+	get_label_name("", predicate, "", PredName, DummyArity, AddPrefix,
+		LabelName),
 
 	% figure out the ModeNumString
 	string__int_to_string(TypeArity, TypeArityString),
@@ -2260,11 +2281,15 @@
 		"_", TypeArityString, "_", ModeNumString], 
 		ProcLabelString).
 
-:- pred get_label_name(string, pred_or_func, string, string, int, string).
-:- mode get_label_name(in, in, in, in, in, out) is det.
+	%  get a label name, given the defining module, predicate or
+	%  function indicator, declaring module, predicate name, arity,
+	%  and whether or not to add a prefix.
+
+:- pred get_label_name(string, pred_or_func, string, string, int, bool, string).
+:- mode get_label_name(in, in, in, in, in, in, out) is det.
 
 get_label_name(DefiningModule, PredOrFunc, DeclaringModule,
-		Name0, Arity, LabelName) :-
+		Name0, Arity, AddPrefix, LabelName) :-
 	(
 		( 
 			DeclaringModule = "mercury_builtin"
@@ -2303,8 +2328,14 @@
 		PredOrFunc = predicate,
 		LabelName3 = LabelName2
 	),
-	get_label_prefix(Prefix),
-	string__append(Prefix, LabelName3, LabelName).
+	( 
+		AddPrefix = yes
+	->
+		get_label_prefix(Prefix),
+		string__append(Prefix, LabelName3, LabelName)
+	;
+		LabelName = LabelName3
+	).
 
 	% To ensure that Mercury labels don't clash with C symbols, we
 	% prefix them with `mercury__'.
@@ -2683,6 +2714,10 @@
 	% we need to cast them here to avoid type errors
 	io__write_string("(const Word *) &"),
 	output_data_addr(BaseName, VarName).
+output_rval_const(label_entry(Label)) -->
+	io__write_string("ENTRY("),
+	output_label(Label),
+	io__write_string(")").
 
 :- pred output_lval_as_word(lval, io__state, io__state).
 :- mode output_lval_as_word(in, di, uo) is det.
@@ -3035,7 +3070,7 @@
 :- mode gather_labels_from_c_procs(in, in, out) is det.
 
 gather_labels_from_c_procs([], Labels, Labels).
-gather_labels_from_c_procs([c_procedure(_, _, _, Instrs) | Procs],
+gather_labels_from_c_procs([c_procedure(_, _, _, _, Instrs) | Procs],
 		Labels0, Labels) :-
 	gather_labels_from_instrs(Instrs, Labels0, Labels1),
 	gather_labels_from_c_procs(Procs, Labels1, Labels).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.59
diff -u -r1.59 mercury_compile.m
--- mercury_compile.m	1997/10/16 15:09:42	1.59
+++ mercury_compile.m	1997/11/02 14:19:32
@@ -38,7 +38,7 @@
 :- import_module lco, liveness, stratify.
 :- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
 :- import_module code_gen, optimize, export, base_type_info, base_type_layout.
-:- import_module llds_common, llds_out.
+:- import_module llds_common, llds_out, continuation_info, stack_layout.
 
 	% miscellaneous compiler modules
 :- import_module prog_data, hlds_module, hlds_pred, hlds_out, llds.
@@ -754,7 +754,11 @@
 	!,
 	mercury_compile__maybe_dump_hlds(HLDS95, "95", "codegen"), !,
 
-	{ HLDS99 = HLDS95 },
+	mercury_compile__maybe_generate_stack_layouts(HLDS95, LLDS1, Verbose, 
+		Stats, HLDS97), !,
+	mercury_compile__maybe_dump_hlds(HLDS97, "97", "stack_layout"), !,
+
+	{ HLDS99 = HLDS97 },
 	mercury_compile__maybe_dump_hlds(HLDS99, "99", "final"), !,
 
 	mercury_compile__maybe_do_optimize(LLDS1, Verbose, Stats, LLDS).
@@ -882,16 +886,31 @@
 	{ module_info_get_continuation_info(ModuleInfo3, ContInfo0) },
 	{ module_info_get_cell_count(ModuleInfo3, CellCount0) },
 	{ generate_proc_code(ProcInfo7, ProcId, PredId, ModuleInfo3, Globals,
-		ContInfo0, CellCount0, ContInfo, CellCount, Proc0) },
-	{ module_info_set_continuation_info(ModuleInfo3, ContInfo, 
+		ContInfo0, CellCount0, ContInfo1, CellCount, Proc0) },
+	{ module_info_set_continuation_info(ModuleInfo3, ContInfo1, 
 		ModuleInfo4) },
-	{ module_info_set_cell_count(ModuleInfo4, CellCount, ModuleInfo) },
+	{ module_info_set_cell_count(ModuleInfo4, CellCount, ModuleInfo5) },
 	{ globals__lookup_bool_option(Globals, optimize, Optimize) },
 	( { Optimize = yes } ->
 		optimize__proc(Proc0, Proc)
 	;
 		{ Proc = Proc0 }
+	),
+	{ globals__lookup_bool_option(Globals, stack_layout, StackLayout) },
+	( { StackLayout = yes } ->
+		{ Proc = c_procedure(_, _, _, PredProcId, Instructions) },
+		{ module_info_get_continuation_info(ModuleInfo5, ContInfo2) },
+		write_proc_progress_message(
+			"% Generating stack layout information for ",
+					PredId, ProcId, ModuleInfo5),
+		{ continuation_info__process_instructions(PredProcId,
+			Instructions, ContInfo2, ContInfo3) },
+		{ module_info_set_continuation_info(ModuleInfo5, ContInfo3, 
+			ModuleInfo) }
+	;
+		{ ModuleInfo = ModuleInfo5 }
 	).
+	
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -1488,6 +1507,29 @@
 		{ LLDS = LLDS0 }
 	).
 
+:- pred mercury_compile__maybe_generate_stack_layouts(module_info, 
+	list(c_procedure), bool, bool, module_info, io__state, io__state).
+:- mode mercury_compile__maybe_generate_stack_layouts(in, in, in, in, out, 
+	di, uo) is det.
+
+mercury_compile__maybe_generate_stack_layouts(ModuleInfo0, LLDS0, Verbose, 
+		Stats, ModuleInfo) -->
+	globals__io_lookup_bool_option(stack_layout, StackLayout),
+	( { StackLayout = yes } ->
+		maybe_write_string(Verbose,
+			"% Generating stack layout information..."),
+		maybe_flush_output(Verbose),
+		{ module_info_get_continuation_info(ModuleInfo0, ContInfo0) },
+		{ continuation_info__process_llds(LLDS0, ContInfo0,
+			ContInfo) },
+		{ module_info_set_continuation_info(ModuleInfo0, ContInfo,
+			ModuleInfo) },
+		maybe_write_string(Verbose, " done.\n"),
+		maybe_report_stats(Stats)
+	;
+		{ ModuleInfo = ModuleInfo0 }
+	).
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -1497,14 +1539,17 @@
 	bool, io__state, io__state).
 :- mode mercury_compile__output_pass(in, in, in, out, di, uo) is det.
 
-mercury_compile__output_pass(HLDS, LLDS0, ModuleName, CompileErrors) -->
+mercury_compile__output_pass(HLDS0, LLDS0, ModuleName, CompileErrors) -->
 	globals__io_lookup_bool_option(verbose, Verbose),
 	globals__io_lookup_bool_option(statistics, Stats),
 
-	{ base_type_info__generate_llds(HLDS, BaseTypeInfos) },
-	{ base_type_layout__generate_llds(HLDS, BaseTypeLayouts) },
+	{ base_type_info__generate_llds(HLDS0, BaseTypeInfos) },
+	{ base_type_layout__generate_llds(HLDS0, HLDS1, BaseTypeLayouts) },
+	{ stack_layout__generate_llds(HLDS1, HLDS, StackLayouts) },
+
+	{ list__append(StackLayouts, BaseTypeLayouts, StaticData0) },
 
-	{ llds_common(LLDS0, BaseTypeLayouts, ModuleName, LLDS1, 
+	{ llds_common(LLDS0, StaticData0, ModuleName, LLDS1, 
 		StaticData, CommonData) },
 
 	{ list__append(BaseTypeInfos, StaticData, AllData) },
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_debug.m,v
retrieving revision 1.73
diff -u -r1.73 opt_debug.m
--- opt_debug.m	1997/10/31 00:41:26	1.73
+++ opt_debug.m	1997/11/05 01:16:28
@@ -679,12 +679,17 @@
 	opt_debug__dump_data_name(VarName, N_str),
 	string__append_list(["data_addr_const(", BaseName, ", ", N_str, ")"],
 		Str).
-
+opt_debug__dump_const(label_entry(Label), Str) :-
+	opt_debug__dump_label(Label, LabelStr),
+	string__append_list(["label_entry(", LabelStr, ")"], Str).
 opt_debug__dump_data_name(common(N), Str) :-
 	string__int_to_string(N, N_str),
 	string__append("common", N_str, Str).
 opt_debug__dump_data_name(base_type(BaseData, TypeName, TypeArity), Str) :-
 	llds_out__make_base_type_name(BaseData, TypeName, TypeArity, Str).
+opt_debug__dump_data_name(stack_layout(Label), Str) :-
+	opt_debug__dump_label(Label, LabelStr),
+	string__append_list(["stack_layout(", LabelStr, ")"], Str).
 
 opt_debug__dump_unop(mktag, "mktag").
 opt_debug__dump_unop(tag, "tag").
Index: compiler/optimize.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/optimize.m,v
retrieving revision 1.8
diff -u -r1.8 optimize.m
--- optimize.m	1997/07/27 15:01:17	1.8
+++ optimize.m	1997/10/22 02:41:06
@@ -38,8 +38,8 @@
 	optimize__proc(Proc0, Proc), !,
 	optimize__main(Procs0, Procs).
 
-optimize__proc(c_procedure(Name, Arity, Mode, Instrs0),
-		   c_procedure(Name, Arity, Mode, Instrs)) -->
+optimize__proc(c_procedure(Name, Arity, Mode, PredProcId, Instrs0),
+		   c_procedure(Name, Arity, Mode, PredProcId, Instrs)) -->
 	globals__io_lookup_bool_option(debug_opt, DebugOpt),
 	opt_debug__msg(DebugOpt, "before optimization"),
 	opt_debug__dump_instrs(DebugOpt, Instrs0),
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.209
diff -u -r1.209 options.m
--- options.m	1997/10/16 04:59:13	1.209
+++ options.m	1997/10/23 00:09:17
@@ -132,6 +132,7 @@
 		;	args
 		;	type_info
 		;	type_layout
+		;	stack_layout
 		;	highlevel_c
 		;	unboxed_float
 	% Code generation options
@@ -372,6 +373,7 @@
 	args			-	string("compact"),
 	type_info		-	string("default"),
 	type_layout		-	bool(yes),
+	stack_layout		-	bool(no),
 	highlevel_c		-	bool(no),
 	unboxed_float		-	bool(no)
 ]).
@@ -653,6 +655,7 @@
 long_option("type-info",		type_info).
 long_option("type-info-convention",	type_info).
 long_option("type-layout",		type_layout).
+long_option("stack-layout",		type_layout).
 long_option("highlevel-C",		highlevel_c).
 long_option("highlevel-c",		highlevel_c).
 long_option("high-level-C",		highlevel_c).
@@ -1384,11 +1387,17 @@
 %	io__write_string("\t\ttype_info structures. Only one option, shared-one-or-two-cell,\n"),
 %	io__write_string("\t\tis presently available.\n"),
 
+
 	io__write_string("\t--no-type-layout\n"),
 	io__write_string("\t(This option is not for general use.)\n"),
 	io__write_string("\t\tDon't output base_type_layout structures or references\n"),
 	io__write_string("\t\tto them. (The C code also needs to be compiled with\n"),
 	io__write_string("\t\t`-DNO_TYPE_LAYOUT').\n"),
+
+	io__write_string("\t--stack-layout\n"),
+	io__write_string("\t(This option is not for general use.)\n"),
+	io__write_string("\t\tGenerate stack_layout structures.\n"),
+
 	io__write_string("\t--unboxed-float\n"),
 	io__write_string("\t(This option is not for general use.)\n"),
 	io__write_string("\t\tDon't box floating point numbers.\n"),
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.7
diff -u -r1.7 compiler_design.html
--- compiler_design.html	1997/09/23 16:48:43	1.7
+++ compiler_design.html	1997/11/02 13:32:12
@@ -618,6 +618,10 @@
   the functors of a given type. The base_type_layout and base_type_functors
   structures of each declared type constructor are added to the LLDS.
 
+<li> stack_layout.m generates the stack_layout structures for
+  accurate garbage collection. Tables are created from the data
+  collected in continuation_info.m.
+
 <li> llds_common.m extracts static terms from the main body of the LLDS, and
   puts them at the front. If a static term originally appeared several times,
   it will now appear as a single static term with multiple references to it.

New File: compiler/stack_layout.m
===================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1997 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% This module generates the LLDS code that defines global constants to
% hold the `stack_layout' structures of the stack frames defined by the
% current module.
%
% The tables generated have a number of `create' rvals within them,
% these are removed by llds_common.m to create static structures.
%
% Author: trd
%
%---------------------------------------------------------------------------%
%
% Data Stucture: stack_layouts
%
% For each procedure,
% 	mercury_data__stack_layout__mercury__<proc_label>
% containing:
%	code address		(Code *) - address of entry
% 	number of stack slots	(Integer) 
% 	code_model		(Integer) actually, type MR_Code_Model 
% 					0 = DET, 1 = NONDET
% 	succip stack location	(Integer) actually, type MR_LIVE_LVAL
% 					(the location will be set to -1
% 					if there is no succip available).
%
% For each continuation label in a procedure
% 	mercury_data__stack_layout__mercury__<proc_label>_i<label number>
% containing:
%	code address		(Code *) - address of label
%	procedure info		(Word *) - pointer to procedure stack layout
%	number of live vars	(Integer)
%	live data locations and (Word *) - pointer to vector of 
%		types			MR_LIVE_LVAL and MR_LIVE_TYPE pairs
%	type parameters		(Word *) - pointer to vector of 
%					MR_LIVE_LVAL
%
% If the number of live vars is 0, there could be two explanations. The
% continuation label might actually have no live data, or (more likely)
% it isn't a continuation label at all.
%
% If you need to know the live variables at non-continuation labels,
% this code will not be sufficient. In particular, it is expected that
% information about live variables at entry and exit points will be
% added.
%
% Note: That number of type parameters is stored as it is not needed --
% the type parameter vector will simply be indexed by the type parameter
% number stored within pseudo-typeinfos. 
%
% XXX: Presently, type parameter vectors are not created, and
% inst information is ignored.
%
%---------------------------------------------------------------------------%

:- module stack_layout.

:- interface.

:- import_module hlds_module.

:- pred stack_layout__generate_llds(module_info, module_info, list(c_module)).
:- mode stack_layout__generate_llds(in, out, out) is det.

:- implementation.

:- import_module llds, globals, options, continuation_info, llds_out.
:- import_module base_type_layout.
:- import_module assoc_list, bool, string, int, list, map, std_util, require.
:- import_module set.

:- type stack_layout_info 	--->	
	stack_layout_info(
		string,		% module name
		int,		% next available cell number 
		list(c_module)	% generated data
	).

%---------------------------------------------------------------------------%

	% Initialize the StackLayoutInfo, and begin processing.
stack_layout__generate_llds(ModuleInfo0, ModuleInfo, CModules) :-
	module_info_get_continuation_info(ModuleInfo0, ContinuationInfo),
	continuation_info__get_all_proc_layouts(ProcLayoutList, 
		ContinuationInfo, _),

	module_info_name(ModuleInfo0, ModuleName),
	module_info_get_cell_count(ModuleInfo0, CellCount),

	LayoutInfo0 = stack_layout_info(ModuleName, CellCount, []),
	list__foldl(stack_layout__construct_layouts, ProcLayoutList,
		LayoutInfo0, LayoutInfo),

	stack_layout__get_cmodules(CModules, LayoutInfo, _),
	stack_layout__get_cell_number(FinalCellCount, LayoutInfo, _),
	module_info_set_cell_count(ModuleInfo0, FinalCellCount, ModuleInfo).

%---------------------------------------------------------------------------%

	% Construct the layouts for a single procedure.
	
:- pred stack_layout__construct_layouts(proc_layout_info, 
		stack_layout_info, stack_layout_info).
:- mode stack_layout__construct_layouts(in, in, out) is det.

stack_layout__construct_layouts(ProcLayoutInfo) -->

	{ ProcLayoutInfo = proc_layout_info(ProcLabel, StackSlots, CodeModel, 
		SuccipLoc, InternalMap) },

	{ map__to_assoc_list(InternalMap, Internals) },

	stack_layout__construct_proc_layout(ProcLabel, StackSlots, 
		CodeModel, SuccipLoc),
	list__foldl(stack_layout__construct_internal_layout(ProcLabel),
		Internals).

%---------------------------------------------------------------------------%

	% Construct the layout describing a single procedure.

:- pred stack_layout__construct_proc_layout(proc_label, int, code_model, 
		maybe(int), stack_layout_info, stack_layout_info).
:- mode stack_layout__construct_proc_layout(in, in, in, in, in, out) is det.
stack_layout__construct_proc_layout(ProcLabel, StackSlots, CodeModel, 
		SuccipLoc) -->
	{
		SuccipLoc = yes(Location0)
	->
		Location = Location0
	;
			% Use a dummy location of -1 if there is
			% no succip on the stack. The runtime system
			% might be able to work around this, depending
			% upon what it is using the stack layouts for.
		Location = -1
	},
	{
		CodeModel = model_det,
		SuccipLval = stackvar(Location)
	;
		CodeModel = model_semi,
		SuccipLval = stackvar(Location)
	;
		CodeModel = model_non,
		SuccipLval = framevar(Location)
	},
	{ Label = local(ProcLabel) },
	{ stack_layout__represent_lval(SuccipLval, SuccipRval) },
	{ StackSlotsRval = const(int_const(StackSlots)) },
	{ CodeAddrRval = const(code_addr_const(label(Label))) },
	stack_layout__represent_code_model(CodeModel, CodeModelRval),
	{ MaybeRvals = [yes(CodeAddrRval), yes(StackSlotsRval), 
		yes(CodeModelRval), yes(SuccipRval)] },
	stack_layout__get_module_name(ModuleName),

	{ CModule = c_data(ModuleName, stack_layout(Label), yes, 
		MaybeRvals, []) },
	stack_layout__add_cmodule(CModule).

%---------------------------------------------------------------------------%

	% Construct the layout describing a single continuation label.

:- pred stack_layout__construct_internal_layout(proc_label,
		pair(label, internal_layout_info), 
		stack_layout_info, stack_layout_info).
:- mode stack_layout__construct_internal_layout(in, in, in, out) is det.
stack_layout__construct_internal_layout(ProcLabel, Label - Internal) -->
	{ Internal = internal_layout_info(ContinuationLabelInfo) },
	{
		ContinuationLabelInfo = yes(continuation_label_info(
			LiveLvalSet0, _TVars))
	->
		LiveLvalSet = LiveLvalSet0
	;
		% We record no live values here. This might not be
		% true, however this label is not being used as a
		% continuation, so it shouldn't be relied upon.
		
		set__init(LiveLvalSet)
	},
		
		% XXX Should also output TVars.

	{ set__to_sorted_list(LiveLvalSet, LiveLvals) },
	
		% generate the required rvals
	{ CodeAddrRval = const(label_entry(Label)) },

	stack_layout__get_module_name(ModuleName),
	{ EntryAddrRval = const(data_addr_const(data_addr(ModuleName,
		stack_layout(local(ProcLabel))))) },
	{ list__length(LiveLvals, Length) },
	{ LengthRval = const(int_const(Length)) },
	stack_layout__construct_liveval_pairs(LiveLvals, LiveValRval),

	{ MaybeRvals = [yes(CodeAddrRval), yes(EntryAddrRval), 
		yes(LengthRval), yes(LiveValRval)]  },

	{ CModule = c_data(ModuleName, stack_layout(Label), yes, 
		MaybeRvals, []) },
	stack_layout__add_cmodule(CModule).

%---------------------------------------------------------------------------%

	% Construct a vector of (lval, live_value_type) pairs.

:- pred stack_layout__construct_liveval_pairs(assoc_list(lval, live_value_type),
		rval, stack_layout_info, stack_layout_info).
:- mode stack_layout__construct_liveval_pairs(in, out, in, out) is det.

stack_layout__construct_liveval_pairs(LiveLvals, Rval) -->
	list__map_foldl(stack_layout__construct_liveval_pair, LiveLvals, 
		RvalsList),
	{ list__condense(RvalsList, Rvals) },
	stack_layout__get_next_cell_number(CNum),
	{ Rval = create(0, Rvals, no, CNum) }.

	% Construct a pair of (lval, live_value_type) representations.

:- pred stack_layout__construct_liveval_pair(pair(lval, live_value_type),
		list(maybe(rval)), stack_layout_info, stack_layout_info).
:- mode stack_layout__construct_liveval_pair(in, out, in, out) is det.

stack_layout__construct_liveval_pair(Lval - LiveValueType, Rvals) -->
	{ stack_layout__represent_lval(Lval, Rval0) },
	stack_layout__represent_live_value_type(LiveValueType, Rval1),
	{ Rvals = [yes(Rval0), yes(Rval1)] }.
	

%---------------------------------------------------------------------------%


	% The constants here should be kept in sync with constants in
	% the runtime system:
	% 	mercury_accurate_gc.h - contains macros to access these
	%			 	constants.



	% Construct a representation of a live_value_type.
	%
	% Low integers for special values, a pointer for other values.
	% (Remember to keep the low integers below the max varint value in
	% runtime/type_info.h).

:- pred stack_layout__represent_live_value_type(live_value_type, rval,
	stack_layout_info, stack_layout_info).
:- mode stack_layout__represent_live_value_type(in, out, in, out) is det. 

stack_layout__represent_live_value_type(succip, Rval) -->
	{ Rval = const(int_const(0)) }.
stack_layout__represent_live_value_type(hp, Rval) -->
	{ Rval = const(int_const(1)) }.
stack_layout__represent_live_value_type(curfr, Rval) -->
	{ Rval = const(int_const(2)) }.
stack_layout__represent_live_value_type(maxfr, Rval) -->
	{ Rval = const(int_const(3)) }.
stack_layout__represent_live_value_type(redoip, Rval) -->
	{ Rval = const(int_const(4)) }.
stack_layout__represent_live_value_type(unwanted, Rval) -->
	{ Rval = const(int_const(5)) }.
stack_layout__represent_live_value_type(var(Type, _Inst), Rval) -->
	stack_layout__get_cell_number(CNum0),
	{ base_type_layout__construct_pseudo_type_info(Type, Rval0, CNum0,
		CNum) },
	stack_layout__set_cell_number(CNum),
		% XXX hack - don't yet write out insts
	{ Rval1 = const(int_const(-1)) },
	stack_layout__get_next_cell_number(CNum2),
	{ Rval = create(0, [yes(Rval0), yes(Rval1)], no, CNum2) }.

	% Construct a representation of an lval.

:- pred stack_layout__represent_lval(lval, rval).
:- mode stack_layout__represent_lval(in, out) is det.

stack_layout__represent_lval(reg(r, Num), Rval) :-
	stack_layout__make_tagged_rval(0, Num, Rval).
stack_layout__represent_lval(reg(f, Num), Rval) :-
	stack_layout__make_tagged_rval(1, Num, Rval).

stack_layout__represent_lval(stackvar(Num), Rval) :-
	stack_layout__make_tagged_rval(2, Num, Rval).
stack_layout__represent_lval(framevar(Num), Rval) :-
	stack_layout__make_tagged_rval(3, Num, Rval).

stack_layout__represent_lval(succip, Rval) :-
	stack_layout__make_tagged_rval(4, 0, Rval).
stack_layout__represent_lval(maxfr, Rval) :-
	stack_layout__make_tagged_rval(5, 0, Rval).
stack_layout__represent_lval(curfr, Rval) :-
	stack_layout__make_tagged_rval(6, 0, Rval).
stack_layout__represent_lval(hp, Rval) :-
	stack_layout__make_tagged_rval(7, 0, Rval).
stack_layout__represent_lval(sp, Rval) :-
	stack_layout__make_tagged_rval(8, 0, Rval).


stack_layout__represent_lval(temp(_, _), _) :-
	error("stack_layout: continuation live value stored in temp register").

stack_layout__represent_lval(succip(_), _) :-
	error("stack_layout: continuation live value stored in code address").
stack_layout__represent_lval(redoip(_), _) :-
	error("stack_layout: continuation live value stored in code address").
stack_layout__represent_lval(succfr(_), _) :-
	error("stack_layout: continuation live value stored in code address").
stack_layout__represent_lval(prevfr(_), _) :-
	error("stack_layout: continuation live value stored in code address").

stack_layout__represent_lval(field(_, _, _), _) :-
	error("stack_layout: continuation live value stored in field").
stack_layout__represent_lval(mem_ref(_), _) :-
	error("stack_layout: continuation live value stored in mem_ref").
stack_layout__represent_lval(lvar(_), _) :-
	error("stack_layout: continuation live value stored in lvar").


	% Some things in this module are encoded using a low tag.
	% This is not done using the normal compiler mkword, but by
	% doing the bit shifting here.
	%
	% This allows us to use more than the usual 2 or 3 bits, but
	% we have to use low tags and cannot tag pointers this way.

:- pred stack_layout__make_tagged_rval(int::in, int::in, rval::out) is det.

stack_layout__make_tagged_rval(Tag, Value, Rval) :-
	stack_layout__make_tagged_word(Tag, Value, TaggedValue),
	Rval = const(int_const(TaggedValue)).

:- pred stack_layout__make_tagged_word(int::in, int::in, int::out) is det.

stack_layout__make_tagged_word(Tag, Value, TaggedValue) :-
	stack_layout__tag_bits(Bits),
	TaggedValue = (Value << Bits) + Tag.


	% Construct a represntation of  the code model.

:- pred stack_layout__represent_code_model(code_model, rval, stack_layout_info, 
		stack_layout_info).
:- mode stack_layout__represent_code_model(in, out, in, out) is det.
stack_layout__represent_code_model(CodeModel, Rval) -->
	(
		{ CodeModel = model_det },
		{ Rval = const(int_const(0)) }
	;
		{ CodeModel = model_semi },
		{ Rval = const(int_const(0)) }
	;
		{ CodeModel = model_non },
		{ Rval = const(int_const(1)) }
	).

:- pred stack_layout__code_model(code_model::in, int::out) is det.
stack_layout__code_model(model_det, 0).
stack_layout__code_model(model_semi, 0).
stack_layout__code_model(model_non, 1).


:- pred stack_layout__tag_bits(int::out) is det.
stack_layout__tag_bits(8).

%---------------------------------------------------------------------------%

	% Access to the stack_layout data structure.

:- pred stack_layout__get_module_name(string, stack_layout_info, 
		stack_layout_info).
:- mode stack_layout__get_module_name(out, in, out) is det.
stack_layout__get_module_name(ModuleName, LayoutInfo, LayoutInfo) :-
	LayoutInfo = stack_layout_info(ModuleName, _, _).

:- pred stack_layout__get_next_cell_number(int, stack_layout_info,
	stack_layout_info).
:- mode stack_layout__get_next_cell_number(out, in, out) is det.
stack_layout__get_next_cell_number(CNum0, LayoutInfo0, LayoutInfo) :-
	LayoutInfo0 = stack_layout_info(A, CNum0, C),
	CNum is CNum0 + 1,
	LayoutInfo = stack_layout_info(A, CNum, C).

:- pred stack_layout__get_cell_number(int, stack_layout_info,
		stack_layout_info).
:- mode stack_layout__get_cell_number(out, in, out) is det.
stack_layout__get_cell_number(CNum, LayoutInfo, LayoutInfo) :-
	LayoutInfo = stack_layout_info(_, CNum, _).

:- pred stack_layout__get_cmodules(list(c_module), stack_layout_info, 
		stack_layout_info).
:- mode stack_layout__get_cmodules(out, in, out) is det.
stack_layout__get_cmodules(CModules, LayoutInfo, LayoutInfo) :-
	LayoutInfo = stack_layout_info(_, _, CModules).

:- pred stack_layout__add_cmodule(c_module, stack_layout_info,
		stack_layout_info).
:- mode stack_layout__add_cmodule(in, in, out) is det.
stack_layout__add_cmodule(CModule, LayoutInfo0, LayoutInfo) :-
	LayoutInfo0 = stack_layout_info(A, B, CModules0),
	CModules = [CModule | CModules0],
	LayoutInfo = stack_layout_info(A, B, CModules).

:- pred stack_layout__set_cell_number(int, stack_layout_info,
		stack_layout_info).
:- mode stack_layout__set_cell_number(in, in, out) is det.
stack_layout__set_cell_number(CNum, LayoutInfo0, LayoutInfo) :-
	LayoutInfo0 = stack_layout_info(A, _, C),
	LayoutInfo = stack_layout_info(A, CNum, C).


-- 
       Tyson Dowd           # To fix this, edit BLAH\BlahKey\Blah\Whatever 
                            # in the registry.
     trd at cs.mu.oz.au        # *WARNING* Editing the registry can DESTROY
http://www.cs.mu.oz.au/~trd # your machine forever. Do not do it.