[m-dev.] diff: start of new stack layouts.

Tyson Richard DOWD trd at cs.mu.oz.au
Mon May 26 14:26:35 AEST 1997


> Tyson Richard DOWD, you wrote:
> > 
> > Changes to clean up the collection of live value information. Instead of
> > requesting shape numbers and outputting .garb files, we store the needed
> > information for later processing, so we can generate typeinfos for such
> > types later, when we create stack_layout tables.
> 
> General comment: I'm still not happy with the handling of partially
> instantiated data structures.  I know you said that this is incomplete,
> but I'm not convinced that the code in your diff can be easily extended
> to handle them.  The design doesn't seem to support them.
>
> > compiler/call_gen.m:
> > 	- Don't request shape numbers for live data, store their types
> > 	  instead.
> 
> That's not going to work for partially instantiated data structures.
> How are you going to deal with them?
> I think you need to store the insts too.

Yes. It was my intention to add this later. I've added it now.
The code to generate something analogous to the type_infos for insts
hasn't yet been written.

Here's a new diff - with these changes and with --stack-layout removed.

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

Estimated hours taken: 30

Changes to clean up the collection of live value information. Instead of
requesting shape numbers and outputting .garb files, we store the needed
information for later processing, so we can generate typeinfos for such
types later, when we create stack_layout tables.

The compiler actually _shrinks_ as a result of this change.

compiler/call_gen.m:
	- Don't request shape numbers for live data, store their types
	  and insts instead.

compiler/code_gen.m:
	- Call continuation_info__add_proc_info for each procedure
	  generated.
	- Pass around continuation_infos rather than shape_tables.

compiler/code_info.m:
	- Don't request shape numbers for live data, store their types
	  and insts instead.
	- Provide predicate for converting lvals into live_value_types.
	- Replace shape_table with continuation_info

compiler/continuation_info.m:
	- New module for storing information about continuations needed
	  for accurate garbage collection. This will later be used to
	  output stack_layout structures.

compile/hlds_module.m:
	- Remove shape_table from module_info, put continuation_info in
	  its place.

compiler/llds.m:
	- Add new live_value_type, which describes a live value (succip,
	  curfr, maxfr, redoip, hp, var(type, inst), unwanted).
	  This will replace the shape_num type.

compiler/llds_out.m:
	- Output live_value_types instead of shape_nums.

compiler/make_hlds.m:
	- Don't add abstract_exports to the shape table - we don't
	  use them anymore.

compiler/mercury_compile.m:
	- Document `join_string_list' and `join_module_list' as their names
	  are a bit cryptic.
	- Don't output .garb files, don't do abstract exports pass.
	- Replace handling of shape_table with continuation_info.

compiler/garbage_out.m:
compiler/shapes.m:
	- Remove these files, as they are no longer used.

runtime/mercury_accurate_gc.h:
	- Add new file with defintions for accurate gc.


Index: compiler/call_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/call_gen.m,v
retrieving revision 1.109
diff -u -r1.109 call_gen.m
--- call_gen.m	1997/05/21 02:13:10	1.109
+++ call_gen.m	1997/05/26 02:52:35
@@ -79,7 +79,7 @@
 :- implementation.
 
 :- import_module hlds_module, hlds_data, prog_data, code_util, globals.
-:- import_module arg_info, type_util, mode_util, shapes, unify_proc.
+:- import_module arg_info, type_util, mode_util, unify_proc, instmap.
 :- import_module bool, int, list, assoc_list, tree, set, map.
 :- import_module std_util, require.
 
@@ -545,33 +545,16 @@
 	(
 		{ GC_Method = accurate }
 	->
-		code_info__get_shapes(S_Tab0),
 		code_info__variable_type(Var, Type),
-		code_info__get_module_info(Module_Info),
-		{ module_info_types(Module_Info, Type_Table) },
-
-		% XXX we really should check that the inst of Var is
-		% XXX ground - but that would probably break things when
-		% XXX partial insts get implemented.
-		{ shapes__request_shape_number(Type - ground(shared, no), 
-			Type_Table, S_Tab0, S_Tab1, S_Number) },
+		code_info__get_instmap(InstMap),
+		{ instmap__lookup_var(InstMap, Var, Inst) },
 		{ type_util__vars(Type, TypeVars) },
-		(
-			% if not polymorphic
-			{ TypeVars = [] }
-		->
-			{ TypeParams = no }
-		;
-			code_info__find_type_infos(TypeVars, Lvals),
-			{ TypeParams = yes(Lvals) }
-		),
-		code_info__set_shapes(S_Tab1)
+		code_info__find_type_infos(TypeVars, TypeParams),
+		{ LiveVal = live_lvalue(R, var(Type, Inst), TypeParams) }
 	;
-		{ TypeParams = no },
-		{ S_Number = 0 }
+		{ LiveVal = live_lvalue(R, unwanted, []) }
 	),
 	{ code_util__arg_loc_to_register(L, R) },
-	{ LiveVal = live_lvalue(R, num(S_Number), TypeParams) },
 	call_gen__insert_arg_livelvals(As, GC_Method, [LiveVal | LiveVals0], 
 		LiveVals).
 
Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.26
diff -u -r1.26 code_gen.m
--- code_gen.m	1997/05/21 02:13:14	1.26
+++ code_gen.m	1997/05/23 05:01:01
@@ -30,6 +30,7 @@
 :- interface.
 
 :- import_module hlds_module, hlds_pred, hlds_goal, llds, code_info.
+:- import_module continuation_info.
 :- import_module list, assoc_list, io.
 
 		% Translate a HLDS structure into an LLDS
@@ -39,10 +40,10 @@
 :- mode generate_code(in, out, out, di, uo) is det.
 
 :- pred generate_proc_code(proc_info, proc_id, pred_id, module_info, 
-	shape_table, int, shape_table, int, c_procedure, io__state, io__state).
+	continuation_info, int, continuation_info, int, c_procedure, 
+	io__state, io__state).
 :- mode generate_proc_code(in, in, in, in, in, in, out, out, out,
 	di, uo) is det.
-		% N.B. could use unique mode for `shape_table'
 
 		% This predicate generates code for a goal.
 
@@ -62,7 +63,7 @@
 :- import_module disj_gen, pragma_c_gen, globals, options, hlds_out.
 :- import_module code_aux, middle_rec, passes_aux.
 :- import_module code_util, type_util, mode_util.
-:- import_module prog_data, instmap, shapes.
+:- import_module prog_data, instmap.
 :- import_module bool, char, int, string, list, term.
 :- import_module map, tree, std_util, require, set, varset.
 
@@ -124,18 +125,19 @@
 		[]
 	),
 		% generate all the procedures for this predicate
-	{ module_info_get_shapes(ModuleInfo0, Shapes0) },
+	{ module_info_get_continuation_info(ModuleInfo0, ContInfo0) },
 	{ module_info_get_cell_count(ModuleInfo0, CellCount0) },
 	generate_proc_list_code(ProcIds, PredId, PredInfo, ModuleInfo0,
-		Shapes0, Shapes, CellCount0, CellCount, [], Code),
+		ContInfo0, ContInfo, CellCount0, CellCount, [], Code),
 	{ module_info_set_cell_count(ModuleInfo0, CellCount, ModuleInfo1) },
-	{ module_info_set_shapes(ModuleInfo1, Shapes, ModuleInfo) }.
+	{ module_info_set_continuation_info(ModuleInfo1, ContInfo, 
+		ModuleInfo) }.
 
 % For all the modes of predicate PredId, generate the appropriate
 % code (deterministic, semideterministic, or nondeterministic).
 
 :- pred generate_proc_list_code(list(proc_id), pred_id, pred_info, module_info,
-	shape_table, shape_table, int, int,
+	continuation_info, continuation_info, int, int,
 	list(c_procedure), list(c_procedure), io__state, io__state).
 % :- mode generate_proc_list_code(in, in, in, in, di, uo, di, uo, di, uo)
 %	is det.
@@ -143,21 +145,21 @@
 	di, uo) is det.
 
 generate_proc_list_code([], _PredId, _PredInfo, _ModuleInfo,
-		Shapes, Shapes, CellCount, CellCount, Procs, Procs) --> [].
+		ContInfo, ContInfo, CellCount, CellCount, Procs, Procs) --> [].
 generate_proc_list_code([ProcId | ProcIds], PredId, PredInfo, ModuleInfo0,
-		Shapes0, Shapes, CellCount0, CellCount, Procs0, Procs) -->
+		ContInfo0, ContInfo, CellCount0, CellCount, Procs0, Procs) -->
 	{ 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,
-		Shapes0, CellCount0, Shapes1, CellCount1, Proc),
+		ContInfo0, CellCount0, ContInfo1, CellCount1, Proc),
 	{ Procs1 = [Proc | Procs0] },
 	generate_proc_list_code(ProcIds, PredId, PredInfo, ModuleInfo0,
-		Shapes1, Shapes, CellCount1, CellCount, Procs1, Procs).
+		ContInfo1, ContInfo, CellCount1, CellCount, Procs1, Procs).
 
 generate_proc_code(ProcInfo, ProcId, PredId, ModuleInfo,
-		Shapes0, CellCount0, Shapes, CellCount, Proc) -->
+		ContInfo0, CellCount0, ContInfo, CellCount, Proc) -->
 		% find out if the proc is deterministic/etc
 	{ proc_info_interface_code_model(ProcInfo, CodeModel) },
 		% get the goal for this procedure
@@ -185,27 +187,43 @@
 		% initialise the code_info structure 
 	{ code_info__init(VarInfo, Liveness, StackSlots, SaveSuccip, Globals,
 		PredId, ProcId, ProcInfo, InitialInst, FollowVars,
-		ModuleInfo, CellCount0, Shapes0, CodeInfo0) },
+		ModuleInfo, CellCount0, ContInfo0, CodeInfo0) },
 		% generate code for the procedure
 	{ generate_category_code(CodeModel, Goal, CodeTree, SUsed, CodeInfo0,
 		CodeInfo) },
-		% extract the new shape table and cell count
-	{ code_info__get_shapes(Shapes, CodeInfo, _CodeInfo1) },
+		% extract the new continuation_info and cell count
+	{ code_info__get_continuation_info(ContInfo1, CodeInfo, _CodeInfo1) },
 	{ code_info__get_cell_count(CellCount, CodeInfo, _CodeInfo2) },
 
+
 		% turn the code tree into a list
 	{ tree__flatten(CodeTree, FragmentList) },
 		% 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) },
-	(
-		{ SUsed = yes(SlotNum) }
+	{
+		SUsed = yes(SlotNum)
 	->
-		{ code_gen__add_saved_succip(Instructions0,
-			SlotNum, Instructions) }
+		% XXX Do we need to still do this?
+		code_gen__add_saved_succip(Instructions0,
+			SlotNum, 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,
+				SlotNum, ContInfo1, ContInfo)
+		;
+			ContInfo = ContInfo1
+		)
 	;
-		{ Instructions = Instructions0 }
-	),
+		ContInfo = ContInfo1,
+		Instructions = Instructions0
+	},
+
 		% get the name and arity of this predicate
 	{ predicate_name(ModuleInfo, PredId, Name) },
 	{ predicate_arity(ModuleInfo, PredId, Arity) },
@@ -1059,7 +1077,7 @@
 		Instrn0 = call(Target, ReturnLabel, LiveVals0, CM)
 	->
 		Instrn  = call(Target, ReturnLabel, 
-			[live_lvalue(stackvar(StackLoc), succip, no) |
+			[live_lvalue(stackvar(StackLoc), succip, []) |
 			LiveVals0], CM)
 	;
 		Instrn = Instrn0
Index: compiler/code_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_info.m,v
retrieving revision 1.202
diff -u -r1.202 code_info.m
--- code_info.m	1997/05/21 02:13:16	1.202
+++ code_info.m	1997/05/26 02:57:18
@@ -11,7 +11,7 @@
 % This file defines the code_info type and various operations on it.
 % The code_info structure is the 'state' of the code generator.
 %
-% This file is organized indo eight submodules:
+% This file is organized into eight submodules:
 %
 %	- the code_info structure and its access predicates
 %	- simple wrappers around access predicates
@@ -41,7 +41,7 @@
 
 :- import_module hlds_module, hlds_data, code_util.
 :- import_module code_exprn, set, varset, term, stack, prog_data.
-:- import_module type_util, mode_util, options, shapes.
+:- import_module type_util, mode_util, options.
 :- import_module string, require, char, list, map, bimap, tree, int.
 
 %---------------------------------------------------------------------------%
@@ -66,7 +66,7 @@
 		% 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 */, shape_table, code_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, out)
 	is det.
 
@@ -116,11 +116,13 @@
 :- pred code_info__get_globals(globals, code_info, code_info).
 :- mode code_info__get_globals(out, in, out) is det.
 
-:- pred code_info__get_shapes(shape_table, code_info, code_info).
-:- mode code_info__get_shapes(out, in, out) is det.
-
-:- pred code_info__set_shapes(shape_table, code_info, code_info).
-:- mode code_info__set_shapes(in, in, out) is det.
+:- pred code_info__get_continuation_info(continuation_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.
 
 %---------------------------------------------------------------------------%
 
@@ -228,7 +230,10 @@
 			map(lval, lval_or_ticket),
 					% The temp locations in use on the stack
 					% and what they contain (for gc).
-			shape_table,	% Table of shapes.
+			continuation_info,	
+					% Information on which values
+					% are live at continuation
+					% points, for accurate gc.
 			set(var),	% Zombie variables; variables that have
 					% been killed but are protected by a
 					% resume point.
@@ -396,7 +401,7 @@
 	CI = code_info(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, Q, _, _,
 		_, _).
 
-code_info__get_shapes(R, CI, CI) :-
+code_info__get_continuation_info(R, CI, CI) :-
 	CI = code_info(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, R, _,
 		_, _).
 
@@ -445,7 +450,10 @@
 %	Q		map(lval, lval_or_ticket),
 %					% The temp locations in use on the stack
 %					% and what they contain (for gc).
-%	R		shape_table,	% Table of shapes.
+%	R		continuation_info,	
+%					% Information on which values
+%					% are live at continuation
+%					% points, for accurate gc.
 %	S		set(var),	% Zombie variables; variables that have
 %					% been killed but are protected by a
 %					% resume point.
@@ -541,7 +549,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).
 
-code_info__set_shapes(R, CI0, CI) :-
+code_info__set_continuation_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),
 	CI = code_info(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q,
@@ -608,7 +616,8 @@
 
 	% Given a list of type variables, find the lvals where the
 	% corresponding type_infos are being stored.
-:- pred code_info__find_type_infos(list(var), list(lval), code_info, code_info).
+:- pred code_info__find_type_infos(list(var), assoc_list(var, lval), 
+	code_info, code_info).
 :- mode code_info__find_type_infos(in, out, in, out) is det.
 
 	% Given a constructor id, and a variable (so that we can work out the
@@ -785,7 +794,7 @@
 	{ map__lookup(TypeTable, TypeId, TypeDefn) }.
 
 code_info__find_type_infos([], []) --> [].
-code_info__find_type_infos([TVar | TVars], [Lval | Lvals]) -->
+code_info__find_type_infos([TVar | TVars], [TVar - Lval | Lvals]) -->
 	code_info__get_proc_info(ProcInfo),
 	{ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap) },
 	(
@@ -917,8 +926,8 @@
 	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_shapes(Shapes, C1, _),
-	code_info__set_shapes(Shapes, C5, C6),
+	code_info__get_continuation_info(ContInfo, C1, _),
+	code_info__set_continuation_info(ContInfo, C5, C6),
 	code_info__get_cell_count(CellCount, C1, _),
 	code_info__set_cell_count(CellCount, C6, C).
 
@@ -2685,9 +2694,9 @@
 :- mode code_info__generate_temp_livelvals(in, in, out) is det.
 
 code_info__generate_temp_livelvals([], LiveInfo, LiveInfo).
-code_info__generate_temp_livelvals([Slot - StoredLval | Slots],
-		LiveInfo0, [live_lvalue(Slot, S_Num, no) | LiveInfo1]) :-
-	code_info__get_shape_num(StoredLval, S_Num),
+code_info__generate_temp_livelvals([Slot - StoredLval | Slots], LiveInfo0, 
+		[live_lvalue(Slot, LiveValueType, []) | LiveInfo1]) :-
+	code_info__get_live_value_type(StoredLval, LiveValueType),
 	code_info__generate_temp_livelvals(Slots, LiveInfo0, LiveInfo1).
 
 :- pred code_info__generate_commit_livelvals(int,
@@ -2707,12 +2716,16 @@
 		CurfrVar = stackvar(CurfrSlot),
 		MaxfrVar = stackvar(MaxfrSlot),
 		RedoipVar = stackvar(RedoipSlot),
-		code_info__get_shape_num(lval(curfr), CurfrSnum),
-		code_info__get_shape_num(lval(maxfr), MaxfrSnum),
-		code_info__get_shape_num(lval(redoip(lval(maxfr))), RedoipSnum),
-		LiveInfo2 = [live_lvalue(CurfrVar, CurfrSnum, no) | LiveInfo1],
-		LiveInfo3 = [live_lvalue(MaxfrVar, MaxfrSnum, no) | LiveInfo2],
-		LiveInfo  = [live_lvalue(RedoipVar, RedoipSnum, no) | LiveInfo3]
+		code_info__get_live_value_type(lval(curfr), CurfrValueType),
+		code_info__get_live_value_type(lval(maxfr), MaxfrValueType),
+		code_info__get_live_value_type(lval(redoip(lval(maxfr))),
+			RedoipValueType),
+		LiveInfo2 = [live_lvalue(CurfrVar, CurfrValueType, []) | 
+				LiveInfo1],
+		LiveInfo3 = [live_lvalue(MaxfrVar, MaxfrValueType, []) |
+				LiveInfo2],
+		LiveInfo  = [live_lvalue(RedoipVar, RedoipValueType, []) |
+				LiveInfo3]
 	).
 
 :- pred code_info__livevals_to_livelvals(assoc_list(lval, var), gc_method,
@@ -2720,58 +2733,42 @@
 :- mode code_info__livevals_to_livelvals(in, in, out, in, out) is det.
 
 code_info__livevals_to_livelvals([], _GC_Method, []) --> [].
-code_info__livevals_to_livelvals([L - V | Ls], GC_Method,
-		[live_lvalue(L, num(S_Num), TypeParams) | Lives]) -->
+code_info__livevals_to_livelvals([Lval - Var | Ls], GC_Method,
+		[LiveLval | Lives]) -->
 	(
 		{ GC_Method = accurate }
 	->
-		code_info__get_module_info(ModuleInfo),
-		code_info__get_shapes(S_Tab0),
-		{ module_info_types(ModuleInfo, Type_Table) },
-		code_info__variable_type(V, Type),
-
-		% XXX We don't yet support partial insts when allocating
-		% XXX shapes, so pass ground(shared, no) as a placeholder.
-		{ shapes__request_shape_number(Type - ground(shared, no),
-			Type_Table, S_Tab0, S_Tab1, S_Num) },
+		code_info__variable_type(Var, Type),
+		code_info__get_instmap(InstMap),
+		{ instmap__lookup_var(InstMap, Var, Inst) },
 		{ type_util__vars(Type, TypeVars) },
-		(
-			% if not polymorphic
-			{ TypeVars = [] }
-		->
-			{ TypeParams = no }
-		;
-			code_info__find_type_infos(TypeVars, Lvals),
-			{ TypeParams = yes(Lvals) }
-		),
-		code_info__set_shapes(S_Tab1)
+		code_info__find_type_infos(TypeVars, TypeParams),
+		{ LiveLval = live_lvalue(Lval, var(Type, Inst), TypeParams) }
 	;
-		% Dummy values
-		{ TypeParams = no },
-		{ S_Num = 0 }
+		{ LiveLval = live_lvalue(Lval, unwanted, []) }
 	),
 	code_info__livevals_to_livelvals(Ls, GC_Method, Lives).
 
-:- pred code_info__get_shape_num(lval_or_ticket, shape_num).
-:- mode code_info__get_shape_num(in, out) is det.
+:- pred code_info__get_live_value_type(lval_or_ticket, live_value_type).
+:- mode code_info__get_live_value_type(in, out) is det.
 
-code_info__get_shape_num(lval(succip), succip).
-code_info__get_shape_num(lval(hp), hp).
-code_info__get_shape_num(lval(maxfr), maxfr).
-code_info__get_shape_num(lval(curfr), curfr).
-code_info__get_shape_num(lval(succfr(_)), succfr).
-code_info__get_shape_num(lval(prevfr(_)), prevfr).
-code_info__get_shape_num(lval(redoip(_)), redoip).
-code_info__get_shape_num(lval(succip(_)), succip).
-code_info__get_shape_num(lval(sp), sp).
-code_info__get_shape_num(lval(lvar(_)), unwanted).
-code_info__get_shape_num(lval(field(_, _, _)), unwanted).
-code_info__get_shape_num(lval(temp(_, _)), unwanted).
-code_info__get_shape_num(lval(reg(_, _)), unwanted).
-code_info__get_shape_num(lval(stackvar(_)), unwanted).
-code_info__get_shape_num(lval(framevar(_)), unwanted).
-code_info__get_shape_num(lval(mem_ref(_)), unwanted).		% XXX
-code_info__get_shape_num(ticket, ticket).
+code_info__get_live_value_type(lval(succip), succip).
+code_info__get_live_value_type(lval(hp), hp).
+code_info__get_live_value_type(lval(maxfr), maxfr).
+code_info__get_live_value_type(lval(curfr), curfr).
+code_info__get_live_value_type(lval(succfr(_)), unwanted).
+code_info__get_live_value_type(lval(prevfr(_)), unwanted).
+code_info__get_live_value_type(lval(redoip(_)), unwanted).
+code_info__get_live_value_type(lval(succip(_)), unwanted).
+code_info__get_live_value_type(lval(sp), unwanted).
+code_info__get_live_value_type(lval(lvar(_)), unwanted).
+code_info__get_live_value_type(lval(field(_, _, _)), unwanted).
+code_info__get_live_value_type(lval(temp(_, _)), unwanted).
+code_info__get_live_value_type(lval(reg(_, _)), unwanted).
+code_info__get_live_value_type(lval(stackvar(_)), unwanted).
+code_info__get_live_value_type(lval(framevar(_)), unwanted).
+code_info__get_live_value_type(lval(mem_ref(_)), unwanted).		% XXX
+code_info__get_live_value_type(ticket, unwanted).
 
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.20
diff -u -r1.20 hlds_module.m
--- hlds_module.m	1997/04/07 05:39:25	1.20
+++ hlds_module.m	1997/05/21 03:20:13
@@ -12,7 +12,6 @@
 %	module_info
 %	dependency_info
 %	predicate_table
-%	shape_table
 %
 % There is a separate interface section for each of these.
 
@@ -23,11 +22,11 @@
 :- interface.
 
 :- import_module hlds_pred, unify_proc, special_pred.
-:- import_module relation, globals.
+:- import_module relation, globals, continuation_info.
 
 :- implementation.
 
-:- import_module hlds_data, hlds_out, prog_data, prog_util, shapes.
+:- import_module hlds_data, hlds_out, prog_data, prog_util.
 :- import_module require, int, string, list, map, set, std_util.
 :- import_module typecheck.
 
@@ -151,17 +150,14 @@
 :- pred module_info_get_special_pred_map(module_info, special_pred_map).
 :- mode module_info_get_special_pred_map(in, out) is det.
 
-:- pred module_info_get_shapes(module_info, shape_table).
-:- mode module_info_get_shapes(in, out) is det.
+:- pred module_info_get_continuation_info(module_info, continuation_info).
+:- mode module_info_get_continuation_info(in, out) is det.
 
 	% the cell count is used as a unique label number for
 	% constants in the generated C code
 :- pred module_info_get_cell_count(module_info, int).
 :- mode module_info_get_cell_count(in, out) is det.
 
-:- pred module_info_shape_info(module_info, shape_info).
-:- mode module_info_shape_info(in, out) is det.
-
 :- pred module_info_types(module_info, type_table).
 :- mode module_info_types(in, out) is det.
 
@@ -228,15 +224,13 @@
 					module_info).
 :- mode module_info_set_special_pred_map(in, in, out) is det.
 
-:- pred module_info_set_shapes(module_info, shape_table, module_info).
-:- mode module_info_set_shapes(in, in, out) is det.
+:- pred module_info_set_continuation_info(module_info, continuation_info, 
+		module_info).
+:- mode module_info_set_continuation_info(in, in, out) is det.
 
 :- pred module_info_set_cell_count(module_info, int, module_info).
 :- mode module_info_set_cell_count(in, in, out) is det.
 
-:- pred module_info_set_shape_info(module_info, shape_info, module_info).
-:- mode module_info_set_shape_info(in, in, out) is det.
-
 :- pred module_info_set_types(module_info, type_table, module_info).
 :- mode module_info_set_types(in, in, out) is det.
 
@@ -340,7 +334,7 @@
 			predicate_table,
 			unify_requests,
 			special_pred_map,
-			shape_info,
+			continuation_info,
 			type_table,
 			inst_table,
 			mode_table,
@@ -382,10 +376,7 @@
 	map__init(Types),
 	inst_table_init(Insts),
 	mode_table_init(Modes),
-	shapes__init_shape_table(ShapeTable),
-	map__init(AbsExports),
-	map__init(SpecialPredShapes),
-	Shapes = shape_info(ShapeTable, AbsExports, SpecialPredShapes),
+	continuation_info__init(ContinuationInfo),
 	map__init(Ctors),
 	DepInfo = no,
 	PragmaExports = [],
@@ -393,8 +384,8 @@
 	set__init(StratPreds),
 	map__init(UnusedArgInfo),
 	Module_Info = module(Name, C_Code_Info, PredicateTable, Requests, 
-		UnifyPredMap, Shapes, Types, Insts, Modes, Ctors, DepInfo, 
-		0, 0, PragmaExports, BaseTypeData, Globals,
+		UnifyPredMap, ContinuationInfo, Types, Insts, Modes, 
+		Ctors, DepInfo, 0, 0, PragmaExports, BaseTypeData, Globals,
 		StratPreds, UnusedArgInfo, 0).
 
 	% Various access predicates which extract different pieces
@@ -468,18 +459,10 @@
 	ModuleInfo = module(_, _, _, Requests, _, _, _, _, _, _, _, _,
 		_, _, _, _, _, _, _).
 
-module_info_get_shapes(ModuleInfo, Shapes) :-
-	module_info_shape_info(ModuleInfo, Shape_Info),
-	Shape_Info = shape_info(Shapes, _AbsExports, _SpecialPredShapes).
-
 module_info_get_special_pred_map(ModuleInfo, SpecialPredMap) :-
 	ModuleInfo = module(_, _, _, _, SpecialPredMap, 
 		_, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
-module_info_shape_info(ModuleInfo, ShapeInfo) :-
-	ModuleInfo = module(_, _, _, _, _, ShapeInfo, _, _, _, _, _, _,
-		_, _, _, _, _, _, _).
-
 module_info_types(ModuleInfo, Types) :-
 	ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, 
 		_, _, _, _, _, _).
@@ -598,18 +581,10 @@
 	ModuleInfo = module(A, B, C, D, SpecialPredMap, 
 		F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
 
-module_info_set_shapes(ModuleInfo0, Shapes, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, 
-		N, O, P, Q, R, S),
-	F = shape_info(_, AbsExports, SpecialPredShapes),
-	ModuleInfo = module(A, B, C, D, E, shape_info(Shapes, AbsExports, 
-		SpecialPredShapes), G, H, I, J,
-		K, L, M, N, O, P, Q, R, S).
-
-module_info_set_shape_info(ModuleInfo0, Shape_Info, ModuleInfo) :-
+module_info_set_continuation_info(ModuleInfo0, ContinuationInfo, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, _, G, H, I, J, K, L, M, N, 
 		O, P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, Shape_Info, G, H, I, J, K, L, 
+	ModuleInfo = module(A, B, C, D, E, ContinuationInfo, G, H, I, J, K, L, 
 		M, N, O, P, Q, R, S).
 
 module_info_set_types(ModuleInfo0, Types, ModuleInfo) :-
@@ -674,6 +649,10 @@
 	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, Count, 
 		N, O, P, Q, R, S).
 
+module_info_get_continuation_info(ModuleInfo, ContinuationInfo) :-
+	ModuleInfo = module(_, _, _, _, _, ContinuationInfo, _, _, _, _, _, _, 
+		_, _, _, _, _, _, _).
+
 module_info_get_pragma_exported_procs(ModuleInfo, Procs) :-
 	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, 
 		Procs, _, _, _, _, _).
@@ -729,11 +708,9 @@
 
 	module_info_get_predicate_table(ModuleInfo0, Preds0),
 	predicate_table_optimize(Preds0, Preds),
-	module_info_set_predicate_table(ModuleInfo0, Preds, ModuleInfo2),
+	module_info_set_predicate_table(ModuleInfo0, Preds, ModuleInfo3),
 
-	module_info_get_shapes(ModuleInfo2, (Shapes0 - N)),
-	map__optimize(Shapes0, Shapes),
-	module_info_set_shapes(ModuleInfo2, (Shapes - N), ModuleInfo3),
+	% XXX Might want to optimize continuation_info here.
 
 	module_info_types(ModuleInfo3, Types0),
 	map__optimize(Types0, Types),
@@ -1535,37 +1512,5 @@
 	module_info_preds(ModuleInfo, Preds),
 	map__lookup(Preds, PredId, PredInfo),
 	pred_info_arity(PredInfo, Arity).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- interface.
-
-:- type shape_id	==	pair(type, inst).
-
-:- type shape_info	--->	shape_info(shape_table, 
-					   abs_exports,
-					   special_pred_shapes).
-
-	% A map from label of unify pred, eg '__Unify__list_1_1' to shape num.
-:- type special_pred_shapes ==  map(label, shape_num).
-
-:- type abs_exports	==	map(type_id, maybe_shape_num).
-
-:- type maybe_shape_num --->	yes(shape_num)
-			;	no(type).
-
-:- type shape		--->	quad(shape_tag, shape_tag, shape_tag,
-					 shape_tag)
-			;	abstract(type, list(shape_num))
-			;	equivalent(shape_num)
-			;	polymorphic(type, int)
-			;	closure(type).
-
-:- type shape_tag	--->	constant
-			;	simple(list(pair(shape_num, shape_id)))
-			;	complicated(list(list(pair(shape_num, shape_id)))).
-
-:- type shape_table	==	pair(map(shape_id, pair(shape_num, shape)),int).
 
 %-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.204
diff -u -r1.204 llds.m
--- llds.m	1997/04/17 07:47:14	1.204
+++ llds.m	1997/05/26 02:18:44
@@ -16,7 +16,7 @@
 
 :- interface.
 
-:- import_module tree, shapes.
+:- import_module tree, prog_data.
 :- import_module bool, list, set, term, std_util.
 
 %-----------------------------------------------------------------------------%
@@ -120,7 +120,7 @@
 	;	call(code_addr, code_addr, list(liveinfo), call_model)
 			% call(Target, Continuation, _, _) is the same as
 			% succip = Continuation; goto(Target).
-			% The third argument is the shape table for the
+			% The third argument is the live value info for the
 			% values live on return. The last gives the model
 			% of the called procedure, and if it is nondet,
 			% says whether tail recursion is applicable to the call.
@@ -230,24 +230,38 @@
 				% where to put the output val, type and name
 				% of variable containing the output val
 
-	% Each call instruction has a list of liveinfo,
-	% which stores information about which variables
-	% are live at the point of that call.  The information
-	% is intended for use by the non-conservative garbage collector.
+	% Each call instruction has a list of liveinfo, which stores
+	% information about which variables are live after the call
+	% (that is, on return).  The information is intended for use by
+	% the non-conservative garbage collector.
 :- type liveinfo
 	--->	live_lvalue(
 			lval,
 				% What stackslot/reg does
 				% this lifeinfo structure
 				% refer to?
-			shape_num,
-				% What is the shape of this (bound) variable?
-			maybe(list(lval))
+			live_value_type,
+				% What is the type of this live value?
+			assoc_list(tvar, lval)
 				% Where are the typeinfos that determine the
 				% types of the actual parameters of the type
-				% parameters of this shape (if it is
-				% polymorphic), in the order of the arguments.
+				% parameters of this type (if it is
+				% polymorphic), and the type variable
+				% for each one.
 		).
+
+	% live_value_type describes the different sorts of data that
+	% can be considered live.
+:- type live_value_type 
+	--->	succip		% a stored succip
+	;	curfr		% a stored curfr
+	;	maxfr		% a stored maxfr
+	;	redoip
+	;	hp
+	;	var(type, inst)	% a variable
+	;	unwanted.	% something we don't need, or used as
+				% a placeholder for non-accurate gc.
+	
 
 	% An lval represents a data location or register that can be used
 	% as the target of an assignment.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.46
diff -u -r1.46 llds_out.m
--- llds_out.m	1997/05/21 02:13:31	1.46
+++ llds_out.m	1997/05/26 02:38:46
@@ -80,9 +80,9 @@
 
 :- implementation.
 
-:- import_module shapes, export.
-:- import_module exprn_aux, prog_data, prog_out, hlds_pred.
-:- import_module bool, int, list, char, string, set, std_util, term.
+:- import_module export.
+:- import_module exprn_aux, prog_data, prog_out, hlds_pred, mercury_to_mercury.
+:- import_module bool, int, list, char, string, set, std_util, term, varset.
 :- import_module require, globals, options.
 :- import_module library.	% for the version number.
 
@@ -1204,28 +1204,42 @@
 :- mode output_gc_livevals_2(in, di, uo) is det.
 
 output_gc_livevals_2([]) --> [].
-output_gc_livevals_2([live_lvalue(Lval, Shape, TypeParams)|Lvals]) -->
+output_gc_livevals_2([live_lvalue(Lval, LiveValueType, TypeParams)|Lvals]) -->
 	io__write_string(" *\t"),
 	output_lval(Lval),
 	io__write_string("\t"),
-	shapes__write_shape_num(Shape),
-	(
-		{ TypeParams = yes(ParamLocs) },
-		io__write_string("\t"),
-		output_gc_livevals_params(ParamLocs)
-	;
-		{ TypeParams = no }
-	),
+	output_live_value_type(LiveValueType),
+	io__write_string("\t"),
+	output_gc_livevals_params(TypeParams),
 	io__write_string("\n"),
 	output_gc_livevals_2(Lvals).
 
-:- pred output_gc_livevals_params(list(lval), io__state, io__state).
+:- pred output_gc_livevals_params(assoc_list(var, lval), io__state, io__state).
 :- mode output_gc_livevals_params(in, di, uo) is det.
 output_gc_livevals_params([]) --> [].
-output_gc_livevals_params([L|Lvals]) -->
-	output_lval(L),
+output_gc_livevals_params([Var - Lval | Lvals]) -->
+	{ term__var_to_int(Var, VarInt) },
+	io__write_int(VarInt),
+	io__write_string(" - "),
+	output_lval(Lval),
 	io__write_string("  "),
 	output_gc_livevals_params(Lvals).
+
+:- pred output_live_value_type(live_value_type, io__state, io__state).
+:- mode output_live_value_type(in, di, uo) is det.
+output_live_value_type(succip) --> io__write_string("succip").
+output_live_value_type(curfr) --> io__write_string("curfr").
+output_live_value_type(maxfr) --> io__write_string("maxfr").
+output_live_value_type(redoip) --> io__write_string("redoip").
+output_live_value_type(hp) --> io__write_string("hp").
+output_live_value_type(unwanted) --> io__write_string("unwanted").
+output_live_value_type(var(Type, Inst)) --> 
+	io__write_string("var("),
+	{ varset__init(NewVarset) },
+	mercury_output_term(Type, NewVarset, no),
+	io__write_string(", "),
+	mercury_output_inst(Inst, NewVarset),
+	io__write_string(")").
 
 :- pred output_temp_decls(int, string, io__state, io__state).
 :- mode output_temp_decls(in, in, di, uo) is det.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.229
diff -u -r1.229 make_hlds.m
--- make_hlds.m	1997/05/05 11:17:15	1.229
+++ make_hlds.m	1997/05/23 06:37:25
@@ -57,7 +57,7 @@
 
 :- import_module prog_io, prog_io_goal, prog_io_util, prog_out, hlds_out.
 :- import_module module_qual, prog_util, globals, options.
-:- import_module make_tags, quantification, shapes.
+:- import_module make_tags, quantification.
 :- import_module code_util, unify_proc, special_pred, type_util, mode_util.
 :- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
 :- import_module fact_table.
@@ -758,20 +758,7 @@
 			{ special_pred_list(SpecialPredIds) },
 			{ add_special_pred_list(SpecialPredIds,
 					Module1, TVarSet, Type, TypeId,
-					Body, Context, Status, Module2a) },
-			( 
-				{ Status \= imported },
-				{ Status \= opt_imported },
-				{ Status \= abstract_imported }
-				% Only want to handle exports for types that 
-				% are defined locally (cuts down on 
-				% duplicates). 
-			->
-				{ add_abstract_export(Module2a, Type, 
-					TypeId, Module2) }
-			;
-				{ Module2 = Module2a }
-			)
+					Body, Context, Status, Module2) }
 		),
 		{ module_info_set_types(Module2, Types, Module) },
 		( { Body = uu_type(_) } ->
@@ -849,17 +836,6 @@
 	;
 		Status = abstract_imported
 	).
-
-:- pred add_abstract_export(module_info, type, type_id, module_info).
-:- mode add_abstract_export(in, in, in, out) is det.
-
-add_abstract_export(Module0, Type, TypeId, Module) :-
-	module_info_shape_info(Module0, Shape_Info0),
-	Shape_Info0 = shape_info(Shapes, Abs_Exports0, SpecialPredShapes),
-	S_Num = no(Type),
-	map__set(Abs_Exports0, TypeId, S_Num, Abs_Exports1),
-	Shape_Info = shape_info(Shapes, Abs_Exports1, SpecialPredShapes),
-	module_info_set_shape_info(Module0, Shape_Info, Module).
 
 :- pred add_special_preds(module_info, tvarset, type, type_id, 
 		hlds_type_body, term__context, import_status, module_info).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.37
diff -u -r1.37 mercury_compile.m
--- mercury_compile.m	1997/05/21 02:13:33	1.37
+++ mercury_compile.m	1997/05/26 04:17:15
@@ -43,7 +43,7 @@
 	% miscellaneous compiler modules
 :- import_module prog_data, hlds_module, hlds_pred, hlds_out, llds.
 :- import_module mercury_to_c, mercury_to_mercury, mercury_to_goedel.
-:- import_module dependency_graph, garbage_out, shapes.
+:- import_module dependency_graph.
 :- import_module options, globals, passes_aux.
 
 
@@ -797,11 +797,12 @@
 		"% Allocating storage locations for live vars in ",
 				PredId, ProcId, ModuleInfo3),
 	{ store_alloc_in_proc(ProcInfo5, ModuleInfo3, ProcInfo6) },
-	{ module_info_get_shapes(ModuleInfo3, Shapes0) },
+	{ module_info_get_continuation_info(ModuleInfo3, ContInfo0) },
 	{ module_info_get_cell_count(ModuleInfo3, CellCount0) },
 	generate_proc_code(ProcInfo6, ProcId, PredId, ModuleInfo3,
-		Shapes0, CellCount0, Shapes, CellCount, Proc0),
-	{ module_info_set_shapes(ModuleInfo3, Shapes, ModuleInfo4) },
+		ContInfo0, CellCount0, ContInfo, CellCount, Proc0),
+	{ module_info_set_continuation_info(ModuleInfo3, ContInfo, 
+		ModuleInfo4) },
 	{ module_info_set_cell_count(ModuleInfo4, CellCount, ModuleInfo) },
 	globals__io_lookup_bool_option(optimize, Optimize),
 	( { Optimize = yes } ->
@@ -1378,29 +1379,22 @@
 	bool, io__state, io__state).
 :- mode mercury_compile__output_pass(in, in, in, out, di, uo) is det.
 
-mercury_compile__output_pass(HLDS0, LLDS0, ModuleName, CompileErrors) -->
+mercury_compile__output_pass(HLDS, LLDS0, ModuleName, CompileErrors) -->
 	globals__io_lookup_bool_option(verbose, Verbose),
 	globals__io_lookup_bool_option(statistics, Stats),
 
-	{ base_type_info__generate_llds(HLDS0, BaseTypeInfos) },
-	{ base_type_layout__generate_llds(HLDS0, BaseTypeLayouts) },
+	{ base_type_info__generate_llds(HLDS, BaseTypeInfos) },
+	{ base_type_layout__generate_llds(HLDS, BaseTypeLayouts) },
 
 	{ llds_common(LLDS0, BaseTypeLayouts, ModuleName, LLDS1, 
 		StaticData, CommonData) },
 
 	{ list__append(BaseTypeInfos, StaticData, AllData) },
-	mercury_compile__chunk_llds(HLDS0, LLDS1, AllData, CommonData,
+	mercury_compile__chunk_llds(HLDS, LLDS1, AllData, CommonData,
 		LLDS2, NumChunks),
 	mercury_compile__output_llds(ModuleName, LLDS2, Verbose, Stats),
 
-	mercury_compile__maybe_find_abstr_exports(HLDS0, Verbose, Stats,
-		HLDS1),
-
-	{ module_info_shape_info(HLDS1, Shape_Info) },
-	mercury_compile__maybe_write_gc(ModuleName, Shape_Info, LLDS2,
-		Verbose, Stats),
-
-	export__produce_header_file(HLDS1, ModuleName),
+	export__produce_header_file(HLDS, ModuleName),
 
 	globals__io_lookup_bool_option(compile_to_c, CompileToC),
 	( { CompileToC = no } ->
@@ -1482,44 +1476,6 @@
 	maybe_flush_output(Verbose),
 	maybe_report_stats(Stats).
 
-:- pred mercury_compile__maybe_write_gc(module_name, shape_info, c_file,
-	bool, bool, io__state, io__state).
-:- mode mercury_compile__maybe_write_gc(in, in, in, in, in, di, uo) is det.
-
-mercury_compile__maybe_write_gc(ModuleName, ShapeInfo, LLDS, Verbose, Stats) -->
-	globals__io_get_gc_method(GarbageCollectionMethod),
-	( { GarbageCollectionMethod = accurate } ->
-		maybe_write_string(Verbose, "% Writing gc info to `"),
-		maybe_write_string(Verbose, ModuleName),
-		maybe_write_string(Verbose, ".garb'..."),
-		maybe_flush_output(Verbose),
-		garbage_out__do_garbage_out(ShapeInfo, LLDS),
-		maybe_write_string(Verbose, " done.\n"),
-		maybe_report_stats(Stats)
-	;
-		[]
-	).
-
-:- pred mercury_compile__maybe_find_abstr_exports(module_info, bool, bool,
-	module_info, io__state, io__state).
-:- mode mercury_compile__maybe_find_abstr_exports(in, in, in, out, di, uo)
-	is det.
-
-mercury_compile__maybe_find_abstr_exports(HLDS0, Verbose, Stats, HLDS) -->
-	globals__io_get_gc_method(GarbageCollectionMethod),
-	(
-		{ GarbageCollectionMethod = accurate }
-	->
-		maybe_write_string(Verbose, "% Looking up abstract type "),
-		maybe_write_string(Verbose, "exports..."),
-		maybe_flush_output(Verbose),
-		{ shapes__do_abstract_exports(HLDS0, HLDS) },
-		maybe_write_string(Verbose, " done.\n"),
-		maybe_report_stats(Stats)
-	;
-		{ HLDS = HLDS0 }
-	).
-
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -1840,6 +1796,12 @@
 	    )
 	).
 
+	% join_string_list(Strings, Prefix, Suffix, Serarator, Result)
+	%
+	% Appends the strings in the list `Strings' together into the
+	% string Result. Each string is prefixed by Prefix, suffixed by
+	% Suffix and separated by Separator.
+
 :- pred join_string_list(list(string), string, string, string, string).
 :- mode join_string_list(in, in, in, in, out) is det.
 
@@ -1852,6 +1814,13 @@
 		string__append_list([Prefix, String, Suffix, Separator,
 			Result0], Result)
 	).
+
+	% join_module_list(Strings, Separator, Terminator, Result)
+	%
+	% The list of strings `Result' is the list of strings `Strings',
+	% where each string in `Strings' has had any directory path 
+	% removed, and is separated by `Separator' from the next string, 
+	% followed by the list of strings `Terminator'.
 
 :- pred join_module_list(list(string), string, list(string), list(string)).
 :- mode join_module_list(in, in, in, out) is det.

New: runtime/mercury_accurate_gc.h
===================================================================
/*
** Copyright (C) 1997 University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/

/*
** mercury_accurate_gc.h -
**	Definitions for use by the accurate garbage collector (and
**	supporting code).
*/

#ifndef MERCURY_ACCURATE_GC_H
#define MERCURY_ACCURATE_GC_H

/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_ACCURATE_GC_H */



More information about the developers mailing list