for review: RTTI for closures

Zoltan Somogyi zs at cs.mu.OZ.AU
Sun Mar 21 19:22:45 AEDT 1999


Estimated hours taken: 16

Switch to a closure representation that includes runtime type information,
so that closures can be copied, garbage collected, printed, etc.

This RTTI information is not yet used. Adding code to use it would be futile
until Tyson finishes his changes to the other RTTI data structures.

runtime/mercury_ho_call.h:
	New file to define the structure of closures and macros for accessing
	closures.

runtime/Mmakefile:
	Add the new header file.

runtime/mercury_ho_call.c:
	Add an entry point to handle calls to new-style closures. The code
	to handle old-style closures, which was unnecessarily duplicated for
	each code model, stays until all the installed compilers use the new
	closure representation.

	Until that time, the new entry point will contain code to detect
	the use of old-style closures and invoke the old code instead.
	This allows stage1s compiled with old compilers to use the old style
	and stage2 to use the new style without any special tricks anywhere
	else.

	Add a new entry point to handle method calls of all code models.
	The old entry points, which had the same code, will also be deleted
	after this change has been bootstrapped.

runtime/mercury_calls.h:
	Remove the macros that call closures. Their interface sucked, they
	were not used, and their implementation is now out of date.

compiler/llds.m:
	Replace three code addresses for calling closures and another three
	for calling methods with one each.

compiler/call_gen.m:
compiler/dupelim.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/llds_out.m:
	Trivial updates in accordance with the change to llds.m

compiler/code_info.m:
	Move the code to handle layouts to continuation_info.m,
	since that's where it belongs. Leave only the code for picking
	up parameters from code_infos and for putting results back in there.

	Remove the redundant arguments of code_into__init, and extract
	them from ProcInfo, to make clear that they are related.

compiler/code_gen.m:
	Since we pass ProcInfo to code_into__init, don't pass its components.

compiler/continuation_info.m:
	Add the code moved from code_info.m, in a form which takes explicit
	arguments for things that used be hidden in the code_info.

	Add new code, closely related to the moved code, that creates
	layout info from a procedure's argument info, rather than from a
	(part of) the current code generator state. This way, it can be
	invoked from places that don't have a code_info for the procedure
	for which they want to generate layouts. This is the case when
	we generate layouts for closures.

compiler/par_conj_gen.m:
compiler/trace.m:
	Minor changes required by the move of stuff from code_info to
	continuation_info.

compiler/stack_layout.m:
	Export some predicates for use by unify_gen.

compiler/unify_gen.m:
	Switch to creating new style closures, complete with layout info.

compiler/code_util.m:
	Add a couple of utility predicates for continuation_info.m and
	unify_gen.m

library/benchmarking.m:
library/std_util.m:
	Refer to the new entry point for handling closures.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.129
diff -u -b -u -r1.129 call_gen.m
--- call_gen.m	1998/12/06 23:42:58	1.129
+++ call_gen.m	1999/03/18 09:32:44
@@ -84,7 +84,7 @@
 		% Save possibly unknown variables on the stack as well
 		% if they may be needed on backtracking, and figure out the
 		% call model.
-	call_gen__prepare_for_call(CodeModel, FlushCode, CallModel, _, _),
+	call_gen__prepare_for_call(CodeModel, FlushCode, CallModel),
 
 		% Move the input arguments to their registers.
 	code_info__setup_call(ArgsInfos, caller, SetupCode),
@@ -161,7 +161,7 @@
 	%
 	% For a higher-order call,
 	% we split the arguments into inputs and outputs, put the inputs
-	% in the locations expected by do_call_<detism>_closure in
+	% in the locations expected by mercury__do_call_closure in
 	% runtime/mercury_ho_call.c, generate the call to that code,
 	% and pick up the outputs from the locations that we know
 	% the runtime system leaves them in.
@@ -185,8 +185,7 @@
 	{ set__list_to_set(OutVars, OutArgs) },
 	call_gen__save_variables(OutArgs, SaveCode),
 
-	call_gen__prepare_for_call(CodeModel, FlushCode, CallModel,
-		DoHigherCall, _),
+	call_gen__prepare_for_call(CodeModel, FlushCode, CallModel),
 
 		% place the immediate input arguments in registers
 		% starting at r4.
@@ -242,7 +241,7 @@
 	{ CallCode = node([
 		livevals(LiveVals)
 			- "",
-		call(DoHigherCall, label(ReturnLabel), ReturnLiveLvalues,
+		call(do_call_closure, label(ReturnLabel), ReturnLiveLvalues,
 			CallModel)
 			- "Setup and call higher order pred",
 		label(ReturnLabel)
@@ -268,7 +267,7 @@
 	%
 	% For a class method call,
 	% we split the arguments into inputs and outputs, put the inputs
-	% in the locations expected by do_call_<detism>_class_method in
+	% in the locations expected by mercury__do_call_class_method in
 	% runtime/mercury_ho_call.c, generate the call to that code,
 	% and pick up the outputs from the locations that we know
 	% the runtime system leaves them in.
@@ -292,8 +291,7 @@
 	{ call_gen__partition_args(ArgsAndArgInfo, InVars, OutVars) },
 	{ set__list_to_set(OutVars, OutArgs) },
 	call_gen__save_variables(OutArgs, SaveCode),
-	call_gen__prepare_for_call(CodeModel, FlushCode, CallModel,
-		_, DoMethodCall),
+	call_gen__prepare_for_call(CodeModel, FlushCode, CallModel),
 
 		% place the immediate input arguments in registers
 		% starting at r5.
@@ -351,8 +349,8 @@
 	{ CallCode = node([
 		livevals(LiveVals)
 			- "",
-		call(DoMethodCall, label(ReturnLabel), ReturnLiveLvalues,
-			CallModel)
+		call(do_call_class_method, label(ReturnLabel),
+			ReturnLiveLvalues, CallModel)
 			- "Setup and call class method",
 		label(ReturnLabel)
 			- "Continuation label"
@@ -375,29 +373,23 @@
 %---------------------------------------------------------------------------%
 
 :- pred call_gen__prepare_for_call(code_model, code_tree, call_model,
-	code_addr, code_addr, code_info, code_info).
-:- mode call_gen__prepare_for_call(in, out, out, out, out, in, out) is det.
+	code_info, code_info).
+:- mode call_gen__prepare_for_call(in, out, out, in, out) is det.
 
-call_gen__prepare_for_call(CodeModel, FlushCode, CallModel, Higher, Method) -->
+call_gen__prepare_for_call(CodeModel, FlushCode, CallModel) -->
 	code_info__succip_is_used,
 	(
 		{ CodeModel = model_det },
 		{ CallModel = det },
-		{ Higher = do_det_closure },
-		{ Method = do_det_class_method },
 		{ FlushCode = empty }
 	;
 		{ CodeModel = model_semi },
 		{ CallModel = semidet },
-		{ Higher = do_semidet_closure },
-		{ Method = do_semidet_class_method },
 		{ FlushCode = empty }
 	;
 		{ CodeModel = model_non },
 		code_info__may_use_nondet_tailcall(TailCall),
 		{ CallModel = nondet(TailCall) },
-		{ Higher = do_nondet_closure },
-		{ Method = do_nondet_class_method },
 		code_info__flush_resume_vars_to_stack(FlushCode),
 		code_info__set_resume_point_and_frame_to_unknown
 	).
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.62
diff -u -b -u -r1.62 code_gen.m
--- code_gen.m	1998/12/06 23:43:00	1.62
+++ code_gen.m	1999/03/18 08:46:22
@@ -179,10 +179,6 @@
 	proc_info_interface_determinism(ProcInfo, Detism),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	proc_info_goal(ProcInfo, Goal),
-	proc_info_varset(ProcInfo, VarSet),
-	proc_info_liveness_info(ProcInfo, Liveness),
-	proc_info_stack_slots(ProcInfo, StackSlots),
-	proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InitialInst),
 	Goal = _ - GoalInfo,
 	goal_info_get_follow_vars(GoalInfo, MaybeFollowVars),
 	(
@@ -205,10 +201,9 @@
 		% procedures, always needed for model_semi procedures, and
 		% needed for model_non procedures only if we are doing
 		% execution tracing.
-	code_info__init(VarSet, Liveness, StackSlots, SaveSuccip, Globals,
-		PredId, ProcId, ProcInfo, InitialInst, FollowVars,
-		ModuleInfo, CellCount0, OutsideResumePoint, TraceSlotInfo,
-		CodeInfo0),
+	code_info__init(SaveSuccip, Globals, PredId, ProcId, ProcInfo,
+		FollowVars, ModuleInfo, CellCount0, OutsideResumePoint,
+		TraceSlotInfo, CodeInfo0),
 
 		% Generate code for the procedure.
 	generate_category_code(CodeModel, Goal, OutsideResumePoint,
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.236
diff -u -b -u -r1.236 code_info.m
--- code_info.m	1999/03/12 05:53:24	1.236
+++ code_info.m	1999/03/20 07:29:15
@@ -38,8 +38,8 @@
 
 :- import_module code_util, code_exprn, prog_out.
 :- import_module arg_info, type_util, mode_util, options.
-:- import_module term, varset.
 
+:- import_module term, varset.
 :- import_module set, stack.
 :- import_module string, require, char, bimap, tree, int.
 
@@ -65,11 +65,10 @@
 		% Create a new code_info structure. Also return the
 		% outermost resumption point, and info about the non-fixed
 		% stack slots used for tracing purposes.
-:- pred code_info__init(prog_varset, set(prog_var), stack_slots, bool, globals,
-	pred_id, proc_id, proc_info, instmap, follow_vars, module_info,
-	int, resume_point_info, trace_slot_info, code_info).
-:- mode code_info__init(in, in, in, in, in, in, in, in, in, in, in, in,
-	out, out, out) is det.
+:- pred code_info__init(bool, globals, pred_id, proc_id, proc_info,
+	follow_vars, module_info, int, resume_point_info,
+	trace_slot_info, code_info).
+:- mode code_info__init(in, in, in, in, in, in, in, in, out, out, out) is det.
 
 		% Get the globals table.
 :- pred code_info__get_globals(globals, code_info, code_info).
@@ -123,6 +122,9 @@
 :- pred code_info__get_cell_count(int, code_info, code_info).
 :- mode code_info__get_cell_count(out, in, out) is det.
 
+:- pred code_info__set_cell_count(int, code_info, code_info).
+:- mode code_info__set_cell_count(in, in, out) is det.
+
 		% Get the flag that indicates whether succip is used or not.
 :- pred code_info__get_succip_used(bool, code_info, code_info).
 :- mode code_info__get_succip_used(out, in, out) is det.
@@ -172,9 +174,6 @@
 :- pred code_info__set_label_count(int, code_info, code_info).
 :- mode code_info__set_label_count(in, in, out) is det.
 
-:- pred code_info__set_cell_count(int, code_info, code_info).
-:- mode code_info__set_cell_count(in, in, out) is det.
-
 :- pred code_info__set_succip_used(bool, code_info, code_info).
 :- mode code_info__set_succip_used(in, in, out) is det.
 
@@ -278,16 +277,19 @@
 
 %---------------------------------------------------------------------------%
 
-code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals,
-		PredId, ProcId, ProcInfo, Instmap, FollowVars, ModuleInfo,
-		CellCount, ResumePoint, TraceSlotInfo, CodeInfo) :-
+code_info__init(SaveSuccip, Globals, PredId, ProcId, ProcInfo, FollowVars,
+		ModuleInfo, CellCount, ResumePoint, TraceSlotInfo, CodeInfo) :-
+	proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap),
+	proc_info_liveness_info(ProcInfo, Liveness),
 	proc_info_headvars(ProcInfo, HeadVars),
 	proc_info_arg_info(ProcInfo, ArgInfos),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	assoc_list__from_corresponding_lists(HeadVars, ArgInfos, Args),
 	arg_info__build_input_arg_list(Args, ArgList),
 	globals__get_options(Globals, Options),
-	code_exprn__init_state(ArgList, Varset, StackSlots, FollowVars,
+	proc_info_varset(ProcInfo, VarSet),
+	proc_info_stack_slots(ProcInfo, StackSlots),
+	code_exprn__init_state(ArgList, VarSet, StackSlots, FollowVars,
 		Options, ExprnInfo),
 	stack__init(ResumePoints),
 	globals__lookup_bool_option(Globals, allow_hijacks, AllowHijack),
@@ -313,12 +315,12 @@
 		PredId,
 		ProcId,
 		ProcInfo,
-		Varset,
+		VarSet,
 		SlotMax,
 		no,
 
 		Liveness,
-		Instmap,
+		InstMap,
 		Zombies,
 		ExprnInfo,
 		TempsInUse,
@@ -556,12 +558,6 @@
 	code_info, code_info).
 :- mode code_info__lookup_type_defn(in, out, in, out) is det.
 
-	% For each type variable in the given list, find out where the
-	% typeinfo var for that type variable is.
-:- pred code_info__find_typeinfos_for_tvars(list(tvar),
-	map(tvar, set(layout_locn)), code_info, code_info).
-:- mode code_info__find_typeinfos_for_tvars(in, out, in, out) is det.
-
 	% Given a constructor id, and a variable (so that we can work out the
 	% type of the constructor), determine correct tag (representation)
 	% of that constructor.
@@ -730,44 +726,6 @@
 	{ module_info_types(ModuleInfo, TypeTable) },
 	{ map__lookup(TypeTable, TypeId, TypeDefn) }.
 
-code_info__find_typeinfos_for_tvars(TypeVars, TypeInfoDataMap) -->
-	code_info__variable_locations(VarLocs),
-	code_info__get_varset(VarSet),
-	code_info__get_proc_info(ProcInfo),
-	{ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap) },
-	{ map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns) },
-	{ FindLocn = lambda([TypeInfoLocn::in, Locns::out] is det, (
-		type_info_locn_var(TypeInfoLocn, TypeInfoVar),
-		(
-			map__search(VarLocs, TypeInfoVar, TypeInfoRvalSet)
-		->
-			ConvertRval = lambda([Locn::out] is nondet, (
-				set__member(Rval, TypeInfoRvalSet),
-				Rval = lval(Lval),
-				( 
-					TypeInfoLocn = typeclass_info(_,
-						FieldNum),
-					Locn = indirect(Lval, FieldNum)
-				;
-					TypeInfoLocn = type_info(_),
-					Locn = direct(Lval)
-				)
-			)),
-			solutions_set(ConvertRval, Locns)
-		;
-			varset__lookup_name(VarSet, TypeInfoVar,
-				VarString),
-			string__format("%s: %s %s",
-				[s("code_info__find_typeinfos_for_tvars"),
-				s("can't find lval for type_info var"),
-				s(VarString)], ErrStr),
-			error(ErrStr)
-		)
-	)) },
-	{ list__map(FindLocn, TypeInfoLocns, TypeInfoVarLocns) },
-	{ map__from_corresponding_lists(TypeVars, TypeInfoVarLocns,
-		TypeInfoDataMap) }.
-
 code_info__cons_id_to_tag(Var, ConsId, ConsTag) -->
 	code_info__variable_type(Var, Type),
 	code_info__get_module_info(ModuleInfo),
@@ -3193,174 +3151,33 @@
 
 code_info__generate_return_live_lvalues(OutputArgLocs, ReturnInstMap,
 		LiveLvalues) -->
+	code_info__variable_locations(VarLocs),
 	code_info__get_known_variables(Vars),
-	code_info__get_globals(Globals),
-	{ globals__want_return_var_layouts(Globals, WantReturnVarLayout) },
-	code_info__find_return_var_lvals(Vars, OutputArgLocs, VarLvals),
-	code_info__generate_var_live_lvalues(VarLvals,
-		ReturnInstMap, WantReturnVarLayout, VarLiveLvalues),
-
 	code_info__get_active_temps_data(Temps),
-	{ code_info__generate_temp_live_lvalues(Temps, TempLiveLvalues) },
-
-	{ list__append(VarLiveLvalues, TempLiveLvalues, LiveLvalues) }.
-
-:- pred code_info__find_return_var_lvals(list(prog_var)::in,
-	assoc_list(prog_var, arg_loc)::in, assoc_list(prog_var, lval)::out,
-	code_info::in, code_info::out) is det.
-
-code_info__find_return_var_lvals([], _, []) --> [].
-code_info__find_return_var_lvals([Var | Vars], OutputArgLocs,
-		[Var - Lval | VarLvals]) -->
-	( { assoc_list__search(OutputArgLocs, Var, ArgLoc) } ->
-		% On return, output arguments are in their registers.
-		{ code_util__arg_loc_to_register(ArgLoc, Lval) }
-	;
-		% On return, other live variables are in their stack slots.
-		code_info__get_variable_slot(Var, Lval)
-	),
-	code_info__find_return_var_lvals(Vars, OutputArgLocs, VarLvals).
-
-:- pred code_info__generate_temp_live_lvalues(
-	assoc_list(lval, slot_contents)::in, list(liveinfo)::out) is det.
-
-code_info__generate_temp_live_lvalues([], []).
-code_info__generate_temp_live_lvalues([Temp | Temps], [Live | Lives]) :-
-	Temp = Slot - Contents,
-	code_info__get_live_value_type(Contents, LiveLvalueType),
-	map__init(Empty),
-	Live = live_lvalue(direct(Slot), LiveLvalueType, Empty),
-	code_info__generate_temp_live_lvalues(Temps, Lives).
-
-:- pred code_info__generate_var_live_lvalues(assoc_list(prog_var, lval)::in,
-	instmap::in, bool::in, list(liveinfo)::out,
-	code_info::in, code_info::out) is det.
-
-code_info__generate_var_live_lvalues([], _, _, []) --> [].
-code_info__generate_var_live_lvalues([Var - Lval | VarLvals], InstMap,
-		WantReturnVarLayout, [Live | Lives]) -->
-	(
-		{ WantReturnVarLayout = yes }
-	->
-		code_info__get_varset(VarSet),
-		{ varset__lookup_name(VarSet, Var, Name) },
-		code_info__variable_type(Var, Type),
-		{ instmap__lookup_var(InstMap, Var, Inst) },
-		{ type_util__vars(Type, TypeVars) },
-		code_info__find_typeinfos_for_tvars(TypeVars, TypeParams),
-		{ VarInfo = var(Var, Name, Type, Inst) },
-		{ Live = live_lvalue(direct(Lval), VarInfo, TypeParams) }
-	;
-		{ map__init(Empty) },
-		{ Live = live_lvalue(direct(Lval), unwanted, Empty) }
-	),
-	code_info__generate_var_live_lvalues(VarLvals, InstMap,
-		WantReturnVarLayout, Lives).
-
-:- pred code_info__get_live_value_type(slot_contents::in, live_value_type::out)
-	is det.
-
-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(redofr(_)), 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). % XXX we may need to
-					% modify this, if the GC is going
-					% to garbage-collect the trail.
-code_info__get_live_value_type(ticket_counter, unwanted).
-code_info__get_live_value_type(sync_term, unwanted).
-code_info__get_live_value_type(trace_data, unwanted).
-
-%---------------------------------------------------------------------------%
+	code_info__get_proc_info(ProcInfo),
+	code_info__get_globals(Globals),
+	{ continuation_info__generate_return_live_lvalues(OutputArgLocs,
+		ReturnInstMap, Vars, VarLocs, Temps, ProcInfo, Globals,
+		LiveLvalues) }.
 
 :- pred code_info__generate_resume_layout(label::in, resume_map::in,
 	code_info::in, code_info::out) is det.
 
 code_info__generate_resume_layout(Label, ResumeMap) -->
 	code_info__get_globals(Globals),
-	{ globals__get_gc_method(Globals, GcMethod) },
-	( { GcMethod = accurate } ->
-		{ map__to_assoc_list(ResumeMap, ResumeList) },
-		code_info__get_instmap(InstMap),
-		code_info__get_var_types(VarTypes),
-		code_info__get_varset(VarSet),
-		{ set__init(TVars0) },
-		{ code_info__generate_resume_layout_for_vars(ResumeList,
-			VarSet, VarTypes, InstMap, VarInfos, TVars0, TVars) },
-		{ set__list_to_set(VarInfos, VarInfoSet) },
-		{ set__to_sorted_list(TVars, TVarList) },
-		code_info__find_typeinfos_for_tvars(TVarList, TVarInfoMap),
+	{ globals__lookup_bool_option(Globals, agc_stack_layout,
+		AgcStackLayout) },
+	( { AgcStackLayout = yes } ->
 		code_info__get_active_temps_data(Temps),
-		{ code_info__generate_temp_var_infos(Temps, TempInfos) },
-		{ set__list_to_set(TempInfos, TempInfoSet) },
-		{ set__union(VarInfoSet, TempInfoSet, AllInfoSet) },
-		{ Layout = layout_label_info(AllInfoSet, TVarInfoMap) },
+		code_info__get_instmap(InstMap),
+		code_info__get_proc_info(ProcInfo),
+		{ continuation_info__generate_resume_layout(ResumeMap,
+			Temps, InstMap, ProcInfo, Layout) },
 		code_info__add_gc_layout_for_label(Label, Layout)
 	;
 		[]
 	).
 
-:- pred code_info__generate_resume_layout_for_vars(
-	assoc_list(prog_var, set(rval))::in, prog_varset::in,
-	map(prog_var, type)::in, instmap::in, list(var_info)::out,
-	set(tvar)::in, set(tvar)::out) is det.
-
-code_info__generate_resume_layout_for_vars([], _, _, _, [], TVars, TVars).
-code_info__generate_resume_layout_for_vars([Var - RvalSet | VarRvals], VarSet,
-		VarTypes, InstMap, [VarInfo | VarInfos], TVars0, TVars) :-
-	code_info__generate_resume_layout_for_var(Var, RvalSet, VarSet,
-		VarTypes, InstMap, VarInfo, TypeVars),
-	set__insert_list(TVars0, TypeVars, TVars1),
-	code_info__generate_resume_layout_for_vars(VarRvals, VarSet,
-		VarTypes, InstMap, VarInfos, TVars1, TVars).
-
-:- pred code_info__generate_resume_layout_for_var(prog_var::in, set(rval)::in,
-	prog_varset::in, map(prog_var, type)::in, instmap::in,
-	var_info::out, list(tvar)::out) is det.
-
-code_info__generate_resume_layout_for_var(Var, RvalSet, VarSet,
-		VarTypes, InstMap, VarInfo, TypeVars) :-
-	set__to_sorted_list(RvalSet, RvalList),
-	( RvalList = [RvalPrime] ->
-		Rval = RvalPrime
-	;
-		error("var has more than one rval in stack resume map")
-	),
-	( Rval = lval(LvalPrime) ->
-		Lval = LvalPrime
-	;
-		error("var rval is not lval in stack resume map")
-	),
-	varset__lookup_name(VarSet, Var, "V_", Name),
-	instmap__lookup_var(InstMap, Var, Inst),
-	map__lookup(VarTypes, Var, Type),
-	LiveType = var(Var, Name, Type, Inst),
-	VarInfo = var_info(direct(Lval), LiveType),
-	type_util__vars(Type, TypeVars).
-
-:- pred code_info__generate_temp_var_infos(
-	assoc_list(lval, slot_contents)::in, list(var_info)::out) is det.
-
-code_info__generate_temp_var_infos([], []).
-code_info__generate_temp_var_infos([Temp | Temps], [Live | Lives]) :-
-	Temp = Slot - Contents,
-	code_info__get_live_value_type(Contents, LiveLvalueType),
-	Live = var_info(direct(Slot), LiveLvalueType),
-	code_info__generate_temp_var_infos(Temps, Lives).
-
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
 
@@ -3394,15 +3211,6 @@
 	% during code generation.
 
 :- interface.
-
-:- type slot_contents 
-	--->	ticket			% a ticket (trail pointer)
-	;	ticket_counter		% a copy of the ticket counter
-	;	trace_data
-	;	sync_term		% a syncronization term used
-					% at the end of par_conjs.
-					% see par_conj_gen.m for details.
-	;	lval(lval).
 
 	% Returns the total stackslot count, but not including space for
 	% succip. This total can change in the future if this call is
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.104
diff -u -b -u -r1.104 code_util.m
--- code_util.m	1998/11/24 03:56:57	1.104
+++ code_util.m	1999/03/18 22:16:30
@@ -57,6 +57,12 @@
 :- pred code_util__make_uni_label(module_info, type_id, proc_id, proc_label).
 :- mode code_util__make_uni_label(in, in, in, out) is det.
 
+:- pred code_util__extract_proc_label_from_code_addr(code_addr, proc_label).
+:- mode code_util__extract_proc_label_from_code_addr(in, out) is det.
+
+:- pred code_util__extract_proc_label_from_label(label, proc_label).
+:- mode code_util__extract_proc_label_from_label(in, out) is det.
+
 :- pred code_util__arg_loc_to_register(arg_loc, lval).
 :- mode code_util__arg_loc_to_register(in, out) is det.
 
@@ -318,6 +324,29 @@
 	;
 		error("code_util__make_uni_label: unqualified type_id")
 	).
+
+code_util__extract_proc_label_from_code_addr(CodeAddr, ProcLabel) :-
+	( code_util__proc_label_from_code_addr(CodeAddr, ProcLabelPrime) ->
+		ProcLabel = ProcLabelPrime
+	;
+		error("code_util__extract_label_from_code_addr failed")
+	).
+
+:- pred code_util__proc_label_from_code_addr(code_addr::in,
+	proc_label::out) is semidet.
+
+code_util__proc_label_from_code_addr(CodeAddr, ProcLabel) :-
+	(
+		CodeAddr = label(Label),
+		code_util__extract_proc_label_from_label(Label, ProcLabel)
+	;
+		CodeAddr = imported(ProcLabel)
+	).
+
+code_util__extract_proc_label_from_label(local(ProcLabel, _), ProcLabel).
+code_util__extract_proc_label_from_label(c_local(ProcLabel), ProcLabel).
+code_util__extract_proc_label_from_label(local(ProcLabel), ProcLabel).
+code_util__extract_proc_label_from_label(exported(ProcLabel), ProcLabel).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.19
diff -u -b -u -r1.19 continuation_info.m
--- continuation_info.m	1998/11/24 03:56:59	1.19
+++ continuation_info.m	1999/03/20 07:29:15
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1997-1998 The University of Melbourne.
+% Copyright (C) 1997-1999 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -22,7 +22,10 @@
 %
 %	2 During code generation for the procedure, provided the option
 %	  trace_stack_layouts is set, we add layout information for labels
-%	  that represent trace ports to the code generator state.
+%	  that represent trace ports to the code generator state. If
+%	  agc_stack_layouts is set, we add layout information for the stack
+%	  label in each resumption point. And regardless of option settings,
+%	  we also generate layouts to be attached to any closures we create.
 %
 % 	3 After we finish generating code for a procedure, we record
 %	  all the static information about the procedure (some of which
@@ -37,8 +40,8 @@
 %	  This info will also go straight into the global_data
 %	  in the HLDS.
 %
-% This module is really only concerned with pass 4, although it also defines
-% data structures and some auxiliary predicates for the other passes.
+% This module defines the data structures used by all passes. It also
+% implements the whole of pass 4, and various fractions of the other passes.
 %
 % stack_layout.m converts the information collected in this module into
 % stack_layout tables.
@@ -50,8 +53,8 @@
 :- interface.
 
 :- import_module llds, hlds_module, hlds_pred, hlds_data, prog_data.
-:- import_module trace, globals.
-:- import_module set, map, list, std_util, bool.
+:- import_module (inst), instmap, trace, globals.
+:- import_module std_util, bool, list, assoc_list, set, map.
 
 	%
 	% Information for any procedure, includes information about the
@@ -164,39 +167,83 @@
 			live_value_type % info about the variable
 		).
 
-	%
+:- type closure_layout_info
+	--->	closure_layout_info(
+			list(closure_arg_info),
+				% there is one closure_arg_info for each
+				% argument of the called procedure,
+				% even the args which are not in the closure
+			map(tvar, set(layout_locn))
+				% locations of polymorphic type vars,
+				% encoded so that rN refers to argument N
+		).
+
+:- type closure_arg_info
+	--->	closure_arg_info(
+			type,
+			(inst)
+		).
+
+:- type slot_contents 
+	--->	ticket			% a ticket (trail pointer)
+	;	ticket_counter		% a copy of the ticket counter
+	;	trace_data
+	;	sync_term		% a syncronization term used
+					% at the end of par_conjs.
+					% see par_conj_gen.m for details.
+	;	lval(lval).
+
 	% Call continuation_info__maybe_process_proc_llds on the code
 	% of every procedure in the list.
-	%
 :- pred continuation_info__maybe_process_llds(list(c_procedure)::in,
 	module_info::in, global_data::in, global_data::out) is det.
 
-	%
 	% Check whether this procedure ought to have any layout structures
 	% generated for it. If yes, then update the global_data to
 	% include all the continuation labels within a proc. Whether or not
 	% the information about a continuation label includes the variables
 	% live at that label depends on the values of options.
-	%
 :- pred continuation_info__maybe_process_proc_llds(list(instruction)::in,
 	pred_proc_id::in, module_info::in,
 	global_data::in, global_data::out) is det.
 
-	%
 	% Check whether the given procedure should have at least (a) a basic
 	% stack layout, and (b) a procedure id layout generated for it.
 	% The two bools returned answer these two questions respectively.
-	%
 :- pred continuation_info__basic_stack_layout_for_proc(pred_info::in,
 	globals::in, bool::out, bool::out) is det.
 
+	% Generate the layout information we need for the return point
+	% of a call.
+:- pred continuation_info__generate_return_live_lvalues(
+	assoc_list(prog_var, arg_loc)::in, instmap::in, list(prog_var)::in,
+	map(prog_var, set(rval))::in, assoc_list(lval, slot_contents)::in,
+	proc_info::in, globals::in, list(liveinfo)::out) is det.
+
+	% Generate the layout information we need for a resumption point,
+	% a label where forward execution can restart after backtracking.
+:- pred continuation_info__generate_resume_layout(map(prog_var, set(rval))::in,
+	assoc_list(lval, slot_contents)::in, instmap::in, proc_info::in,
+	layout_label_info::out) is det.
+
+	% Generate the layout information we need to include in a closure.
+:- pred continuation_info__generate_closure_layout(module_info::in,
+	pred_id::in, proc_id::in, closure_layout_info::out) is det.
+
+	% For each type variable in the given list, find out where the
+	% typeinfo var for that type variable is.
+:- pred continuation_info__find_typeinfos_for_tvars(list(tvar)::in,
+	map(prog_var, set(rval))::in, proc_info::in,
+	map(tvar, set(layout_locn))::out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module options, type_util.
-:- import_module require.
+:- import_module hlds_goal, code_util, type_util, options.
+:- import_module string, require, varset, term.
+
 
 %-----------------------------------------------------------------------------%
 
@@ -226,7 +273,7 @@
 
 	%
 	% Process the list of instructions for this proc, adding
-	% all internal label information to global_data..
+	% all internal label information to global_data.
 	%
 :- pred continuation_info__process_proc_llds(pred_proc_id::in,
 	list(instruction)::in, bool::in,
@@ -358,5 +405,252 @@
 		list__member(Type, ArgTypes),
 		type_is_higher_order(Type, _, _)
 	)).
+
+%-----------------------------------------------------------------------------%
+
+continuation_info__generate_return_live_lvalues(OutputArgLocs, ReturnInstMap,
+		Vars, VarLocs, Temps, ProcInfo, Globals, LiveLvalues) :-
+	globals__want_return_var_layouts(Globals, WantReturnVarLayout),
+	proc_info_stack_slots(ProcInfo, StackSlots),
+	continuation_info__find_return_var_lvals(Vars, StackSlots,
+		OutputArgLocs, VarLvals),
+	continuation_info__generate_var_live_lvalues(VarLvals, ReturnInstMap,
+		VarLocs, ProcInfo, WantReturnVarLayout, VarLiveLvalues),
+	continuation_info__generate_temp_live_lvalues(Temps, TempLiveLvalues),
+	list__append(VarLiveLvalues, TempLiveLvalues, LiveLvalues).
+
+:- pred continuation_info__find_return_var_lvals(list(prog_var)::in,
+	stack_slots::in, assoc_list(prog_var, arg_loc)::in,
+	assoc_list(prog_var, lval)::out) is det.
+
+continuation_info__find_return_var_lvals([], _, _, []).
+continuation_info__find_return_var_lvals([Var | Vars], StackSlots,
+		OutputArgLocs, [Var - Lval | VarLvals]) :-
+	( assoc_list__search(OutputArgLocs, Var, ArgLoc) ->
+		% On return, output arguments are in their registers.
+		code_util__arg_loc_to_register(ArgLoc, Lval)
+	;
+		% On return, other live variables are in their stack slots.
+		map__lookup(StackSlots, Var, Lval)
+	),
+	continuation_info__find_return_var_lvals(Vars, StackSlots,
+		OutputArgLocs, VarLvals).
+
+:- pred continuation_info__generate_temp_live_lvalues(
+	assoc_list(lval, slot_contents)::in, list(liveinfo)::out) is det.
+
+continuation_info__generate_temp_live_lvalues([], []).
+continuation_info__generate_temp_live_lvalues([Temp | Temps], [Live | Lives]) :-
+	Temp = Slot - Contents,
+	continuation_info__live_value_type(Contents, LiveLvalueType),
+	map__init(Empty),
+	Live = live_lvalue(direct(Slot), LiveLvalueType, Empty),
+	continuation_info__generate_temp_live_lvalues(Temps, Lives).
+
+:- pred continuation_info__generate_var_live_lvalues(
+	assoc_list(prog_var, lval)::in, instmap::in,
+	map(prog_var, set(rval))::in, proc_info::in,
+	bool::in, list(liveinfo)::out) is det.
+
+continuation_info__generate_var_live_lvalues([], _, _, _, _, []).
+continuation_info__generate_var_live_lvalues([Var - Lval | VarLvals], InstMap,
+		VarLocs, ProcInfo, WantReturnVarLayout, [Live | Lives]) :-
+	( WantReturnVarLayout = yes ->
+		continuation_info__generate_layout_for_var(Var, InstMap,
+			ProcInfo, LiveValueType, TypeVars),
+		continuation_info__find_typeinfos_for_tvars(TypeVars,
+			VarLocs, ProcInfo, TypeParams),
+		Live = live_lvalue(direct(Lval), LiveValueType, TypeParams)
+	;
+		map__init(Empty),
+		Live = live_lvalue(direct(Lval), unwanted, Empty)
+	),
+	continuation_info__generate_var_live_lvalues(VarLvals, InstMap,
+		VarLocs, ProcInfo, WantReturnVarLayout, Lives).
+
+%---------------------------------------------------------------------------%
+
+continuation_info__generate_resume_layout(ResumeMap, Temps, InstMap,
+		ProcInfo, Layout) :-
+	map__to_assoc_list(ResumeMap, ResumeList),
+	set__init(TVars0),
+	continuation_info__generate_resume_layout_for_vars(ResumeList,
+		InstMap, ProcInfo, VarInfos, TVars0, TVars),
+	set__list_to_set(VarInfos, VarInfoSet),
+	set__to_sorted_list(TVars, TVarList),
+	continuation_info__find_typeinfos_for_tvars(TVarList, ResumeMap,
+		ProcInfo, TVarInfoMap),
+	continuation_info__generate_temp_var_infos(Temps, TempInfos),
+	set__list_to_set(TempInfos, TempInfoSet),
+	set__union(VarInfoSet, TempInfoSet, AllInfoSet),
+	Layout = layout_label_info(AllInfoSet, TVarInfoMap).
+
+:- pred continuation_info__generate_resume_layout_for_vars(
+	assoc_list(prog_var, set(rval))::in, instmap::in, proc_info::in,
+	list(var_info)::out, set(tvar)::in, set(tvar)::out) is det.
+
+continuation_info__generate_resume_layout_for_vars([], _, _, [], TVars, TVars).
+continuation_info__generate_resume_layout_for_vars([Var - RvalSet | VarRvals],
+		InstMap, ProcInfo, [VarInfo | VarInfos], TVars0, TVars) :-
+	continuation_info__generate_resume_layout_for_var(Var, RvalSet,
+		InstMap, ProcInfo, VarInfo, TypeVars),
+	set__insert_list(TVars0, TypeVars, TVars1),
+	continuation_info__generate_resume_layout_for_vars(VarRvals,
+		InstMap, ProcInfo, VarInfos, TVars1, TVars).
+
+:- pred continuation_info__generate_resume_layout_for_var(prog_var::in,
+	set(rval)::in, instmap::in, proc_info::in,
+	var_info::out, list(tvar)::out) is det.
+
+continuation_info__generate_resume_layout_for_var(Var, RvalSet, InstMap,
+		ProcInfo, VarInfo, TypeVars) :-
+	set__to_sorted_list(RvalSet, RvalList),
+	( RvalList = [RvalPrime] ->
+		Rval = RvalPrime
+	;
+		error("var has more than one rval in stack resume map")
+	),
+	( Rval = lval(LvalPrime) ->
+		Lval = LvalPrime
+	;
+		error("var rval is not lval in stack resume map")
+	),
+	continuation_info__generate_layout_for_var(Var, InstMap, ProcInfo,
+		LiveValueType, TypeVars),
+	VarInfo = var_info(direct(Lval), LiveValueType).
+
+:- pred continuation_info__generate_temp_var_infos(
+	assoc_list(lval, slot_contents)::in, list(var_info)::out) is det.
+
+continuation_info__generate_temp_var_infos([], []).
+continuation_info__generate_temp_var_infos([Temp | Temps], [Live | Lives]) :-
+	Temp = Slot - Contents,
+	continuation_info__live_value_type(Contents, LiveLvalueType),
+	Live = var_info(direct(Slot), LiveLvalueType),
+	continuation_info__generate_temp_var_infos(Temps, Lives).
+
+%---------------------------------------------------------------------------%
+
+:- pred continuation_info__generate_layout_for_var(prog_var::in, instmap::in,
+	proc_info::in, live_value_type::out, list(tvar)::out) is det.
+
+continuation_info__generate_layout_for_var(Var, InstMap, ProcInfo,
+		LiveValueType, TypeVars) :-
+	proc_info_varset(ProcInfo, VarSet),
+	proc_info_vartypes(ProcInfo, VarTypes),
+	varset__lookup_name(VarSet, Var, "V_", Name),
+	instmap__lookup_var(InstMap, Var, Inst),
+	map__lookup(VarTypes, Var, Type),
+	LiveValueType = var(Var, Name, Type, Inst),
+	type_util__vars(Type, TypeVars).
+
+%---------------------------------------------------------------------------%
+
+continuation_info__generate_closure_layout(ModuleInfo, PredId, ProcId,
+		ClosureLayout) :-
+	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+	proc_info_headvars(ProcInfo, HeadVars),
+	proc_info_arg_info(ProcInfo, ArgInfos),
+	proc_info_vartypes(ProcInfo, VarTypes),
+	proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap),
+	map__init(VarLocs0),
+	set__init(TypeVars0),
+	assoc_list__from_corresponding_lists(HeadVars, ArgInfos, VarArgInfos),
+	continuation_info__build_closure_info(VarArgInfos, ArgLayouts,
+		VarTypes, InstMap, VarLocs0, VarLocs, TypeVars0, TypeVars),
+	set__to_sorted_list(TypeVars, TypeVarsList),
+	continuation_info__find_typeinfos_for_tvars(TypeVarsList, VarLocs,
+		ProcInfo, TypeInfoDataMap),
+	ClosureLayout = closure_layout_info(ArgLayouts, TypeInfoDataMap).
+
+:- pred continuation_info__build_closure_info(
+	assoc_list(prog_var, arg_info)::in,  list(closure_arg_info)::out,
+	map(prog_var, type)::in, instmap::in,
+	map(prog_var, set(rval))::in, map(prog_var, set(rval))::out,
+	set(tvar)::in, set(tvar)::out) is det.
+
+continuation_info__build_closure_info([], [], _, _, VarLocs, VarLocs,
+		TypeVars, TypeVars).
+continuation_info__build_closure_info([Var - ArgInfo | VarArgInfos],
+		[Layout | Layouts], VarTypes, InstMap,
+		VarLocs0, VarLocs, TypeVars0, TypeVars) :-
+	ArgInfo = arg_info(ArgLoc, _ArgMode),
+	map__lookup(VarTypes, Var, Type),
+	instmap__lookup_var(InstMap, Var, Inst),
+	Layout = closure_arg_info(Type, Inst),
+	set__singleton_set(Locations, lval(reg(r, ArgLoc))),
+	map__det_insert(VarLocs0, Var, Locations, VarLocs1),
+	type_util__vars(Type, VarTypeVars),
+	set__insert_list(TypeVars0, VarTypeVars, TypeVars1),
+	continuation_info__build_closure_info(VarArgInfos, Layouts,
+		VarTypes, InstMap, VarLocs1, VarLocs, TypeVars1, TypeVars).
+
+%---------------------------------------------------------------------------%
+
+continuation_info__find_typeinfos_for_tvars(TypeVars, VarLocs, ProcInfo,
+		TypeInfoDataMap) :-
+	proc_info_varset(ProcInfo, VarSet),
+	proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
+	map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns),
+	FindLocn = lambda([TypeInfoLocn::in, Locns::out] is det, (
+		type_info_locn_var(TypeInfoLocn, TypeInfoVar),
+		(
+			map__search(VarLocs, TypeInfoVar, TypeInfoRvalSet)
+		->
+			ConvertRval = lambda([Locn::out] is nondet, (
+				set__member(Rval, TypeInfoRvalSet),
+				Rval = lval(Lval),
+				( 
+					TypeInfoLocn = typeclass_info(_,
+						FieldNum),
+					Locn = indirect(Lval, FieldNum)
+				;
+					TypeInfoLocn = type_info(_),
+					Locn = direct(Lval)
+				)
+			)),
+			solutions_set(ConvertRval, Locns)
+		;
+			varset__lookup_name(VarSet, TypeInfoVar,
+				VarString),
+			string__format("%s: %s %s",
+				[s("code_info__find_typeinfos_for_tvars"),
+				s("can't find lval for type_info var"),
+				s(VarString)], ErrStr),
+			error(ErrStr)
+		)
+	)),
+	list__map(FindLocn, TypeInfoLocns, TypeInfoVarLocns),
+	map__from_corresponding_lists(TypeVars, TypeInfoVarLocns,
+		TypeInfoDataMap).
+
+%-----------------------------------------------------------------------------%
+
+:- pred continuation_info__live_value_type(slot_contents::in,
+	live_value_type::out) is det.
+
+continuation_info__live_value_type(lval(succip), succip).
+continuation_info__live_value_type(lval(hp), hp).
+continuation_info__live_value_type(lval(maxfr), maxfr).
+continuation_info__live_value_type(lval(curfr), curfr).
+continuation_info__live_value_type(lval(succfr(_)), unwanted).
+continuation_info__live_value_type(lval(prevfr(_)), unwanted).
+continuation_info__live_value_type(lval(redofr(_)), unwanted).
+continuation_info__live_value_type(lval(redoip(_)), unwanted).
+continuation_info__live_value_type(lval(succip(_)), unwanted).
+continuation_info__live_value_type(lval(sp), unwanted).
+continuation_info__live_value_type(lval(lvar(_)), unwanted).
+continuation_info__live_value_type(lval(field(_, _, _)), unwanted).
+continuation_info__live_value_type(lval(temp(_, _)), unwanted).
+continuation_info__live_value_type(lval(reg(_, _)), unwanted).
+continuation_info__live_value_type(lval(stackvar(_)), unwanted).
+continuation_info__live_value_type(lval(framevar(_)), unwanted).
+continuation_info__live_value_type(lval(mem_ref(_)), unwanted).	% XXX
+continuation_info__live_value_type(ticket, unwanted). % XXX we may need to
+					% modify this, if the GC is going
+					% to garbage-collect the trail.
+continuation_info__live_value_type(ticket_counter, unwanted).
+continuation_info__live_value_type(sync_term, unwanted).
+continuation_info__live_value_type(trace_data, unwanted).
 
 %-----------------------------------------------------------------------------%
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.37
diff -u -b -u -r1.37 dupelim.m
--- dupelim.m	1998/12/06 23:43:07	1.37
+++ dupelim.m	1999/03/18 09:47:01
@@ -946,14 +946,9 @@
 dupelim__replace_labels_code_addr(do_redo, _, do_redo).
 dupelim__replace_labels_code_addr(do_fail, _, do_fail).
 dupelim__replace_labels_code_addr(do_trace_redo_fail, _, do_trace_redo_fail).
-dupelim__replace_labels_code_addr(do_det_closure, _, do_det_closure).
-dupelim__replace_labels_code_addr(do_semidet_closure, _, do_semidet_closure).
-dupelim__replace_labels_code_addr(do_nondet_closure, _, do_nondet_closure).
-dupelim__replace_labels_code_addr(do_det_class_method, _, do_det_class_method).
-dupelim__replace_labels_code_addr(do_semidet_class_method, _,
-	do_semidet_class_method).
-dupelim__replace_labels_code_addr(do_nondet_class_method, _,
-	do_nondet_class_method).
+dupelim__replace_labels_code_addr(do_call_closure, _, do_call_closure).
+dupelim__replace_labels_code_addr(do_call_class_method, _,
+	do_call_class_method).
 dupelim__replace_labels_code_addr(do_det_aditi_call, _, do_det_aditi_call).
 dupelim__replace_labels_code_addr(do_semidet_aditi_call, _,
 		do_semidet_aditi_call).
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.32
diff -u -b -u -r1.32 exprn_aux.m
--- exprn_aux.m	1998/12/06 23:43:10	1.32
+++ exprn_aux.m	1999/03/18 09:47:43
@@ -149,12 +149,8 @@
 exprn_aux__addr_is_constant(do_redo, _, no).
 exprn_aux__addr_is_constant(do_fail, _, no).
 exprn_aux__addr_is_constant(do_trace_redo_fail, _, no).
-exprn_aux__addr_is_constant(do_det_closure, _, no).
-exprn_aux__addr_is_constant(do_semidet_closure, _, no).
-exprn_aux__addr_is_constant(do_nondet_closure, _, no).
-exprn_aux__addr_is_constant(do_det_class_method, _, no).
-exprn_aux__addr_is_constant(do_semidet_class_method, _, no).
-exprn_aux__addr_is_constant(do_nondet_class_method, _, no).
+exprn_aux__addr_is_constant(do_call_closure, _, no).
+exprn_aux__addr_is_constant(do_call_class_method, _, no).
 exprn_aux__addr_is_constant(do_det_aditi_call, _, no).
 exprn_aux__addr_is_constant(do_semidet_aditi_call, _, no).
 exprn_aux__addr_is_constant(do_nondet_aditi_call, _, no).
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.39
diff -u -b -u -r1.39 livemap.m
--- livemap.m	1998/12/06 23:43:29	1.39
+++ livemap.m	1999/03/18 09:48:13
@@ -395,12 +395,8 @@
 livemap__special_code_addr(do_redo, yes(redoip(lval(maxfr)))).
 livemap__special_code_addr(do_trace_redo_fail, no).
 livemap__special_code_addr(do_fail, no).
-livemap__special_code_addr(do_det_closure, no).
-livemap__special_code_addr(do_semidet_closure, no).
-livemap__special_code_addr(do_nondet_closure, no).
-livemap__special_code_addr(do_det_class_method, no).
-livemap__special_code_addr(do_semidet_class_method, no).
-livemap__special_code_addr(do_nondet_class_method, no).
+livemap__special_code_addr(do_call_closure, no).
+livemap__special_code_addr(do_call_class_method, no).
 livemap__special_code_addr(do_det_aditi_call, no).
 livemap__special_code_addr(do_semidet_aditi_call, no).
 livemap__special_code_addr(do_nondet_aditi_call, no).
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.235
diff -u -b -u -r1.235 llds.m
--- llds.m	1998/12/06 23:43:33	1.235
+++ llds.m	1999/03/18 09:32:24
@@ -759,12 +759,8 @@
 					% A label in the runtime, the code
 					% at which calls MR_trace with a
 					% REDO event and then fails.
-	;	do_det_closure
-	;	do_semidet_closure
-	;	do_nondet_closure
-	;	do_det_class_method
-	;	do_semidet_class_method
-	;	do_nondet_class_method
+	;	do_call_closure
+	;	do_call_class_method
 	;	do_det_aditi_call
 	;	do_semidet_aditi_call
 	;	do_nondet_aditi_call
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.103
diff -u -b -u -r1.103 llds_out.m
--- llds_out.m	1999/02/04 14:58:10	1.103
+++ llds_out.m	1999/03/18 10:01:42
@@ -2419,12 +2419,8 @@
 		{ NeedDecl = yes }
 	).
 need_code_addr_decls(do_trace_redo_fail, yes) --> [].
-need_code_addr_decls(do_det_closure, yes) --> [].
-need_code_addr_decls(do_semidet_closure, yes) --> [].
-need_code_addr_decls(do_nondet_closure, yes) --> [].
-need_code_addr_decls(do_det_class_method, yes) --> [].
-need_code_addr_decls(do_semidet_class_method, yes) --> [].
-need_code_addr_decls(do_nondet_class_method, yes) --> [].
+need_code_addr_decls(do_call_closure, yes) --> [].
+need_code_addr_decls(do_call_class_method, yes) --> [].
 need_code_addr_decls(do_det_aditi_call, yes) --> [].
 need_code_addr_decls(do_semidet_aditi_call, yes) --> [].
 need_code_addr_decls(do_nondet_aditi_call, yes) --> [].
@@ -2463,18 +2459,10 @@
 	).
 output_code_addr_decls(do_trace_redo_fail) -->
 	io__write_string("Declare_entry(MR_do_trace_redo_fail);\n").
-output_code_addr_decls(do_det_closure) -->
-	io__write_string("Declare_entry(do_call_det_closure);\n").
-output_code_addr_decls(do_semidet_closure) -->
-	io__write_string("Declare_entry(do_call_semidet_closure);\n").
-output_code_addr_decls(do_nondet_closure) -->
-	io__write_string("Declare_entry(do_call_nondet_closure);\n").
-output_code_addr_decls(do_det_class_method) -->
-	io__write_string("Declare_entry(do_call_det_class_method);\n").
-output_code_addr_decls(do_semidet_class_method) -->
-	io__write_string("Declare_entry(do_call_semidet_class_method);\n").
-output_code_addr_decls(do_nondet_class_method) -->
-	io__write_string("Declare_entry(do_call_nondet_class_method);\n").
+output_code_addr_decls(do_call_closure) -->
+	io__write_string("Declare_entry(mercury__do_call_closure);\n").
+output_code_addr_decls(do_call_class_method) -->
+	io__write_string("Declare_entry(mercury__do_call_class_method);\n").
 output_code_addr_decls(do_det_aditi_call) -->
 	io__write_string("Declare_entry(do_det_aditi_call);\n").
 output_code_addr_decls(do_semidet_aditi_call) -->
@@ -2676,28 +2664,12 @@
 	).
 output_goto(do_trace_redo_fail, _) -->
 	io__write_string("GOTO(ENTRY(MR_do_trace_redo_fail));\n").
-output_goto(do_det_closure, CallerLabel) -->
-	io__write_string("tailcall(ENTRY(do_call_det_closure),\n\t\t"),
+output_goto(do_call_closure, CallerLabel) -->
+	io__write_string("tailcall(ENTRY(mercury__do_call_closure),\n\t\t"),
 	output_label_as_code_addr(CallerLabel),
 	io__write_string(");\n").
-output_goto(do_semidet_closure, CallerLabel) -->
-	io__write_string("tailcall(ENTRY(do_call_semidet_closure),\n\t\t"),
-	output_label_as_code_addr(CallerLabel),
-	io__write_string(");\n").
-output_goto(do_nondet_closure, CallerLabel) -->
-	io__write_string("tailcall(ENTRY(do_call_nondet_closure),\n\t\t"),
-	output_label_as_code_addr(CallerLabel),
-	io__write_string(");\n").
-output_goto(do_det_class_method, CallerLabel) -->
-	io__write_string("tailcall(ENTRY(do_call_det_class_method),\n\t\t"),
-	output_label_as_code_addr(CallerLabel),
-	io__write_string(");\n").
-output_goto(do_semidet_class_method, CallerLabel) -->
-	io__write_string("tailcall(ENTRY(do_call_semidet_class_method),\n\t\t"),
-	output_label_as_code_addr(CallerLabel),
-	io__write_string(");\n").
-output_goto(do_nondet_class_method, CallerLabel) -->
-	io__write_string("tailcall(ENTRY(do_call_nondet_class_method),\n\t\t"),
+output_goto(do_call_class_method, CallerLabel) -->
+	io__write_string("tailcall(ENTRY(mercury__do_call_class_method),\n\t\t"),
 	output_label_as_code_addr(CallerLabel),
 	io__write_string(");\n").
 output_goto(do_det_aditi_call, CallerLabel) -->
@@ -2717,7 +2689,6 @@
 	output_label_as_code_addr(CallerLabel),
 	io__write_string(");\n").
 
-
 	% Note that we also do some optimization here by
 	% outputting `localcall' rather than `call' for
 	% calls to local labels, or `call_localret' for
@@ -2779,18 +2750,10 @@
 	io__write_string("ENTRY(do_fail)").
 output_code_addr(do_trace_redo_fail) -->
 	io__write_string("ENTRY(MR_do_trace_redo_fail)").
-output_code_addr(do_det_closure) -->
-	io__write_string("ENTRY(do_call_det_closure)").
-output_code_addr(do_semidet_closure) -->
-	io__write_string("ENTRY(do_call_semidet_closure)").
-output_code_addr(do_nondet_closure) -->
-	io__write_string("ENTRY(do_call_nondet_closure)").
-output_code_addr(do_det_class_method) -->
-	io__write_string("ENTRY(do_call_det_class_method)").
-output_code_addr(do_semidet_class_method) -->
-	io__write_string("ENTRY(do_call_semidet_class_method)").
-output_code_addr(do_nondet_class_method) -->
-	io__write_string("ENTRY(do_call_nondet_class_method)").
+output_code_addr(do_call_closure) -->
+	io__write_string("ENTRY(mercury__do_call_closure)").
+output_code_addr(do_call_class_method) -->
+	io__write_string("ENTRY(mercury__do_call_class_method)").
 output_code_addr(do_det_aditi_call) -->
 	io__write_string("ENTRY(do_det_aditi_call)").
 output_code_addr(do_semidet_aditi_call) -->
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.88
diff -u -b -u -r1.88 opt_debug.m
--- opt_debug.m	1998/12/06 23:44:01	1.88
+++ opt_debug.m	1999/03/18 09:50:15
@@ -761,12 +761,8 @@
 opt_debug__dump_code_addr(do_redo, "do_redo").
 opt_debug__dump_code_addr(do_fail, "do_fail").
 opt_debug__dump_code_addr(do_trace_redo_fail, "do_trace_redo_fail").
-opt_debug__dump_code_addr(do_det_closure, "do_det_closure").
-opt_debug__dump_code_addr(do_semidet_closure, "do_semidet_closure").
-opt_debug__dump_code_addr(do_nondet_closure, "do_nondet_closure").
-opt_debug__dump_code_addr(do_det_class_method, "do_det_class_method").
-opt_debug__dump_code_addr(do_semidet_class_method, "do_semidet_class_method").
-opt_debug__dump_code_addr(do_nondet_class_method, "do_nondet_class_method").
+opt_debug__dump_code_addr(do_call_closure, "do_nondet_closure").
+opt_debug__dump_code_addr(do_call_class_method, "do_nondet_class_method").
 opt_debug__dump_code_addr(do_det_aditi_call, "do_det_aditi_call").
 opt_debug__dump_code_addr(do_semidet_aditi_call, "do_semidet_aditi_call").
 opt_debug__dump_code_addr(do_nondet_aditi_call, "do_nondet_aditi_call").
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.97
diff -u -b -u -r1.97 opt_util.m
--- opt_util.m	1998/12/06 23:44:05	1.97
+++ opt_util.m	1999/03/18 09:50:03
@@ -1282,12 +1282,8 @@
 opt_util__livevals_addr(do_redo, no).
 opt_util__livevals_addr(do_fail, no).
 opt_util__livevals_addr(do_trace_redo_fail, no).
-opt_util__livevals_addr(do_det_closure, yes).
-opt_util__livevals_addr(do_semidet_closure, yes).
-opt_util__livevals_addr(do_nondet_closure, yes).
-opt_util__livevals_addr(do_det_class_method, yes).
-opt_util__livevals_addr(do_semidet_class_method, yes).
-opt_util__livevals_addr(do_nondet_class_method, yes).
+opt_util__livevals_addr(do_call_closure, yes).
+opt_util__livevals_addr(do_call_class_method, yes).
 opt_util__livevals_addr(do_det_aditi_call, yes).
 opt_util__livevals_addr(do_semidet_aditi_call, yes).
 opt_util__livevals_addr(do_nondet_aditi_call, yes).
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.3
diff -u -b -u -r1.3 par_conj_gen.m
--- par_conj_gen.m	1998/11/20 04:08:39	1.3
+++ par_conj_gen.m	1999/03/18 09:52:29
@@ -103,6 +103,7 @@
 
 :- import_module hlds_data, code_gen, code_util, options, globals, prog_data.
 :- import_module hlds_module, (inst), instmap, mode_util, code_info.
+:- import_module continuation_info.
 :- import_module set, tree, list, map, std_util, require, int.
 
 %---------------------------------------------------------------------------%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.26
diff -u -b -u -r1.26 stack_layout.m
--- stack_layout.m	1998/11/24 03:57:18	1.26
+++ stack_layout.m	1999/03/20 10:40:14
@@ -24,11 +24,10 @@
 %
 % Data Stucture: stack_layouts
 %
-% If the option basic_stack_layout is set, we generate a stack layout table
-% for each procedure. This table will be stored in the global variable
-% whose name is
+% If the option basic_stack_layout is set, we generate a MR_Stack_Layout_Entry
+% for each procedure. This will be stored in the global variable whose name is
 %	mercury_data__layout__mercury__<proc_label>.
-% This table will always contain the following information:
+% This structure will always contain the following information:
 %
 %	code address		(Code *) - address of entry
 % 	determinism		(Integer) actually, type MR_Determinism
@@ -38,7 +37,7 @@
 % 					if there is no succip available).
 %
 % If the option procid_stack_layout is set, i.e. if we are doing stack
-% tracing, execution tracing or profiling, the table will also include
+% tracing, execution tracing or profiling, the structure will also include
 % information on the identity of the procedure. This information will take
 % one of two forms. Almost all procedures use the first form:
 %
@@ -68,7 +67,7 @@
 % The meanings of the fields in both forms are the same as in procedure labels.
 %
 % If the option trace_stack_layout is set, i.e. if we are doing execution
-% tracing, the table will also include three extra fields:
+% tracing, the structure will also include three extra fields:
 %
 %	call trace info		(Word *) - pointer to label stack layout
 %	maybe from full		(Integer) - number of the stack slot of
@@ -175,19 +174,24 @@
 
 :- interface.
 
-:- import_module hlds_module, llds.
-:- import_module list, set_bbbtree.
+:- import_module continuation_info, hlds_module, llds.
+:- import_module std_util, list, set_bbbtree.
 
 :- pred stack_layout__generate_llds(module_info::in, module_info::out,
 	list(comp_gen_c_data)::out, list(comp_gen_c_data)::out,
 	set_bbbtree(label)::out) is det.
 
+:- pred stack_layout__construct_closure_layout(proc_label::in,
+	maybe(closure_layout_info)::in, list(maybe(rval))::out,
+	int::in, int::out) is det.
+
 :- implementation.
 
-:- import_module globals, options, continuation_info, llds_out, trace.
+:- import_module globals, options, llds_out, trace.
 :- import_module hlds_data, hlds_pred, base_type_layout, prog_data, prog_out.
+:- import_module (inst), code_util.
 :- import_module assoc_list, bool, string, int, require.
-:- import_module map, std_util, term, set.
+:- import_module map, term, set.
 
 :- type stack_layout_info 	--->	
 	stack_layout_info(
@@ -322,7 +326,8 @@
 	{
 		ProcIdLayout = yes
 	->
-		stack_layout__construct_procid_rvals(EntryLabel, IdRvals),
+		code_util__extract_proc_label_from_label(EntryLabel, ProcLabel),
+		stack_layout__construct_procid_rvals(ProcLabel, IdRvals),
 		list__append(MaybeRvals0, IdRvals, MaybeRvals1)
 	;
 		% Indicate the absence of the procedure id fields.
@@ -381,19 +386,10 @@
 
 %---------------------------------------------------------------------------%
 
-:- pred stack_layout__construct_procid_rvals(label::in,
+:- pred stack_layout__construct_procid_rvals(proc_label::in,
 	list(maybe(rval))::out) is det.
 
-stack_layout__construct_procid_rvals(Label, Rvals) :-
-	( 
-		Label = local(ProcLabel, _)
-	;
-		Label = c_local(ProcLabel)
-	;
-		Label = local(ProcLabel)
-	;
-		Label = exported(ProcLabel)
-	),
+stack_layout__construct_procid_rvals(ProcLabel, Rvals) :-
 	(
 		ProcLabel = proc(DefModule, PredFunc, DeclModule,
 			PredName, Arity, ProcId),
@@ -531,15 +527,11 @@
 		stack_layout__construct_liveval_pairs(SortedLiveLvals,
 			LiveValRval, NamesRval),
 
-		{ map__to_assoc_list(TVarLocnMap, TVarLocns) },
-		( { TVarLocns = [] } ->
+		( { map__is_empty(TVarLocnMap) } ->
 			{ TypeParamRval = const(int_const(0)) }
 		;
-			stack_layout__construct_type_param_locn_vector(
-				TVarLocns, 1, TypeParamLocs),
-			{ list__length(TypeParamLocs, TypeParamsLength) },
-			{ LengthRval = const(int_const(TypeParamsLength)) },
-			{ Vector = [yes(LengthRval) | TypeParamLocs] },
+			{ stack_layout__construct_tvar_rvals(TVarLocnMap,
+				Vector) },
 			stack_layout__get_next_cell_number(CNum1),
 			{ TypeParamRval = create(0, Vector, no, CNum1,
 				"stack_layout_type_param_locn_vector") }
@@ -550,6 +542,17 @@
 		{ RvalList = [yes(VarLengthRval)] }
 	).
 
+:- pred stack_layout__construct_tvar_rvals(map(tvar, set(layout_locn))::in,
+	list(maybe(rval))::out) is det.
+
+stack_layout__construct_tvar_rvals(TVarLocnMap, Vector) :-
+	map__to_assoc_list(TVarLocnMap, TVarLocns),
+	stack_layout__construct_type_param_locn_vector(TVarLocns, 1,
+		TypeParamLocs),
+	list__length(TypeParamLocs, TypeParamsLength),
+	LengthRval = const(int_const(TypeParamsLength)),
+	Vector = [yes(LengthRval) | TypeParamLocs].
+
 %---------------------------------------------------------------------------%
 
 	% Given a list of var_infos and the type variables that occur in them,
@@ -628,32 +631,31 @@
 
 :- pred stack_layout__construct_type_param_locn_vector(
 	assoc_list(tvar, set(layout_locn))::in,
-	int::in, list(maybe(rval))::out,
-	stack_layout_info::in, stack_layout_info::out) is det.
+	int::in, list(maybe(rval))::out) is det.
 
-stack_layout__construct_type_param_locn_vector([], _, []) --> [].
+stack_layout__construct_type_param_locn_vector([], _, []).
 stack_layout__construct_type_param_locn_vector([TVar - Locns | TVarLocns],
-		CurSlot, Vector) -->
-	{ term__var_to_int(TVar, TVarNum) },
-	{ NextSlot is CurSlot + 1 },
-	( { TVarNum = CurSlot } ->
-		{ set__remove_least(Locns, LeastLocn, _) ->
+		CurSlot, Vector) :-
+	term__var_to_int(TVar, TVarNum),
+	NextSlot is CurSlot + 1,
+	( TVarNum = CurSlot ->
+		( set__remove_least(Locns, LeastLocn, _) ->
 			Locn = LeastLocn
 		;
 			error("tvar has empty set of locations")
-		},
-		{ stack_layout__represent_locn(Locn, Rval) },
+		),
+		stack_layout__represent_locn(Locn, Rval),
 		stack_layout__construct_type_param_locn_vector(TVarLocns,
 			NextSlot, VectorTail),
-		{ Vector = [yes(Rval) | VectorTail] }
-	; { TVarNum > CurSlot } ->
+		Vector = [yes(Rval) | VectorTail]
+	; TVarNum > CurSlot ->
 		stack_layout__construct_type_param_locn_vector(TVarLocns,
 			NextSlot, VectorTail),
 			% This slot will never be referred to.
-		{ Vector = [yes(const(int_const(0))) | VectorTail] }
+		Vector = [yes(const(int_const(0))) | VectorTail]
 	;
 
-		{ error("unsorted tvars in construct_type_param_locn_vector") }
+		error("unsorted tvars in construct_type_param_locn_vector")
 	).
 
 	% Construct a vector of (locn, live_value_type) pairs,
@@ -716,10 +718,50 @@
 
 %---------------------------------------------------------------------------%
 
+	% The representation we build here should be kept in sync
+	% with runtime/mercury_ho_call.h, which contains macros to access
+	% the data structures we build here.
+
+stack_layout__construct_closure_layout(ProcLabel, MaybeClosureLayoutInfo,
+		Rvals, CNum0, CNum) :-
+	stack_layout__construct_procid_rvals(ProcLabel, ProcIdRvals),
+	( MaybeClosureLayoutInfo = yes(ClosureLayoutInfo) ->
+		ClosureLayoutInfo = closure_layout_info(ClosureArgs,
+			TVarLocnMap),
+		stack_layout__construct_closure_arg_rvals(ClosureArgs,
+			ClosureArgRvals, CNum0, CNum),
+		stack_layout__construct_tvar_rvals(TVarLocnMap, TVarRvals),
+		list__append(ClosureArgRvals, TVarRvals, LayoutRvals)
+	;
+		LayoutRvals = [yes(const(int_const(-1)))],
+		CNum = CNum0
+	),
+	list__append(ProcIdRvals, LayoutRvals, Rvals).
+
+:- pred stack_layout__construct_closure_arg_rvals(list(closure_arg_info)::in,
+	list(maybe(rval))::out, int::in, int::out) is det.
+
+stack_layout__construct_closure_arg_rvals(ClosureArgs, ClosureArgRvals,
+		CNum0, CNum) :-
+	list__map_foldl(stack_layout__construct_closure_arg_rval,
+		ClosureArgs, MaybeArgRvals, CNum0, CNum),
+	list__length(MaybeArgRvals, Length),
+	ClosureArgRvals = [yes(const(int_const(Length))) | MaybeArgRvals].
+
+:- pred stack_layout__construct_closure_arg_rval(closure_arg_info::in,
+	maybe(rval)::out, int::in, int::out) is det.
+
+stack_layout__construct_closure_arg_rval(ClosureArg, yes(ArgRval),
+		CNum0, CNum) :-
+	ClosureArg = closure_arg_info(Type, _Inst),
+	base_type_layout__construct_pseudo_type_info(Type, ArgRval,
+		CNum0, CNum).
+
+%---------------------------------------------------------------------------%
+
 	% The constants and representations here should be kept in sync
-	% with constants in the runtime system:
-	% 	mercury_stack_layout.h - contains macros to access these
-	%			 	constants.
+	% with runtime/mercury_stack_layout.h, which contains structure
+	% definitions and macros to access the data structures we build here.
 
 	% Construct a representation of a live_value_type without the name.
 	%
@@ -745,16 +787,23 @@
 	{ Rval = const(int_const(5)) }.
 stack_layout__represent_live_value_type(unwanted, Rval) -->
 	{ Rval = const(int_const(6)) }.
-stack_layout__represent_live_value_type(var(_, _, Type, _Inst), Rval) -->
+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,
+	{ stack_layout__represent_var_shape(Type, Inst, VarShape,
 		CNum0, CNum1) },
 	stack_layout__set_cell_number(CNum1),
-		% 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,
-		"stack_layout_pair") }.
+	{ Rval = create(0, VarShape, no, CNum2, "variable_shape") }.
+
+:- pred stack_layout__represent_var_shape((type)::in, (inst)::in,
+	list(maybe(rval))::out, int::in, int::out) is det.
+
+stack_layout__represent_var_shape(Type, _Inst, VarShape, CNum0, CNum) :-
+	base_type_layout__construct_pseudo_type_info(Type, TypeRval,
+		CNum0, CNum),
+	% XXX hack - don't yet write out insts
+	InstRval = const(int_const(-1)),
+	VarShape = [yes(TypeRval), yes(InstRval)].
 
 	% Construct a representation of a variable location.
 	%
@@ -815,15 +864,15 @@
 	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").
+	error("stack_layout: continuation live value stored in fixed slot").
 stack_layout__represent_lval(redoip(_), _) :-
-	error("stack_layout: continuation live value stored in code address").
+	error("stack_layout: continuation live value stored in fixed slot").
 stack_layout__represent_lval(redofr(_), _) :-
-	error("stack_layout: continuation live value stored in code address").
+	error("stack_layout: continuation live value stored in fixed slot").
 stack_layout__represent_lval(succfr(_), _) :-
-	error("stack_layout: continuation live value stored in code address").
+	error("stack_layout: continuation live value stored in fixed slot").
 stack_layout__represent_lval(prevfr(_), _) :-
-	error("stack_layout: continuation live value stored in code address").
+	error("stack_layout: continuation live value stored in fixed slot").
 
 stack_layout__represent_lval(field(_, _, _), _) :-
 	error("stack_layout: continuation live value stored in field").
@@ -1004,7 +1053,7 @@
 :- pred stack_layout__get_next_cell_number(int::out,
 	stack_layout_info::in, stack_layout_info::out) is det.
 
-stack_layout__get_next_cell_number(B0, LayoutInfo0, LayoutInfo) :-
+stack_layout__get_next_cell_number(B, LayoutInfo0, LayoutInfo) :-
 	LayoutInfo0 = stack_layout_info(A, B0, C, D, E, F, G, H, I),
 	B is B0 + 1,
 	LayoutInfo  = stack_layout_info(A, B,  C, D, E, F, G, H, I).
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.18
diff -u -b -u -r1.18 trace.m
--- trace.m	1998/12/14 16:05:10	1.18
+++ trace.m	1999/03/18 09:57:50
@@ -492,10 +492,13 @@
 	{ set__init(TvarSet0) },
 	trace__produce_vars(LiveVars, VarSet, InstMap, TvarSet0, TvarSet,
 		VarInfoList, ProduceCode),
-	{ set__to_sorted_list(TvarSet, TvarList) },
-	code_info__find_typeinfos_for_tvars(TvarList, TvarDataMap),
 	code_info__max_reg_in_use(MaxReg),
+	code_info__variable_locations(VarLocs),
+	code_info__get_proc_info(ProcInfo),
 	{
+	set__to_sorted_list(TvarSet, TvarList),
+	continuation_info__find_typeinfos_for_tvars(TvarList,
+		VarLocs, ProcInfo, TvarDataMap),
 	set__list_to_set(VarInfoList, VarInfoSet),
 	LayoutLabelInfo = layout_label_info(VarInfoSet, TvarDataMap),
 	llds_out__get_label(Label, yes, LabelStr),
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.93
diff -u -b -u -r1.93 unify_gen.m
--- unify_gen.m	1998/11/24 03:57:23	1.93
+++ unify_gen.m	1999/03/21 06:45:23
@@ -1,5 +1,5 @@
 %---------------------------------------------------------------------------%
-% Copyright (C) 1994-1998 The University of Melbourne.
+% Copyright (C) 1994-1999 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %---------------------------------------------------------------------------%
@@ -39,8 +39,8 @@
 
 :- import_module hlds_module, hlds_pred, prog_data, prog_out, code_util.
 :- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
-:- import_module term.
-:- import_module bool, string, int, list, map, require, std_util.
+:- import_module globals, options, continuation_info, stack_layout.
+:- import_module term, bool, string, int, list, map, require, std_util.
 
 :- type uni_val		--->	ref(prog_var)
 			;	lval(lval).
@@ -374,6 +374,9 @@
 	code_info__cache_expression(Var, const(code_addr_const(CodeAddr))).
 unify_gen__generate_construction_2(pred_closure_tag(PredId, ProcId),
 		Var, Args, _Modes, Code) -->
+	% This code constructs or extends a closure.
+	% The structure of closures is defined in runtime/mercury_ho_call.h.
+
 	code_info__get_module_info(ModuleInfo),
 	{ module_info_preds(ModuleInfo, Preds) },
 	{ map__lookup(Preds, PredId, PredInfo) },
@@ -429,46 +432,58 @@
 		% closure
 		code_info__produce_variable(CallPred, Code, Value)
 	    ;
-		code_info__get_next_label(LoopEnd),
 		code_info__get_next_label(LoopStart),
+		code_info__get_next_label(LoopTest),
 		code_info__acquire_reg(r, LoopCounter),
 		code_info__acquire_reg(r, NumOldArgs),
 		code_info__acquire_reg(r, NewClosure),
 		{ Zero = const(int_const(0)) },
 		{ One = const(int_const(1)) },
+		{ Two = const(int_const(2)) },
+		{ Three = const(int_const(3)) },
 		{ list__length(CallArgs, NumNewArgs) },
 		{ NumNewArgs_Rval = const(int_const(NumNewArgs)) },
-		{ NumNewArgsPlusTwo is NumNewArgs + 2 },
-		{ NumNewArgsPlusTwo_Rval =
-			const(int_const(NumNewArgsPlusTwo)) },
+		{ NumNewArgsPlusThree is NumNewArgs + 3 },
+		{ NumNewArgsPlusThree_Rval =
+			const(int_const(NumNewArgsPlusThree)) },
 		code_info__produce_variable(CallPred, Code1, OldClosure),
 		{ Code2 = node([
 			comment("build new closure from old closure") - "",
 			assign(NumOldArgs,
-				lval(field(yes(0), OldClosure, Zero)))
+				lval(field(yes(0), OldClosure, Two)))
 				- "get number of arguments",
 			incr_hp(NewClosure, no,
 				binop(+, lval(NumOldArgs),
-				NumNewArgsPlusTwo_Rval), "closure")
+				NumNewArgsPlusThree_Rval), "closure")
 				- "allocate new closure",
 			assign(field(yes(0), lval(NewClosure), Zero),
+				lval(field(yes(0), OldClosure, Zero)))
+				- "set closure layout structure",
+			assign(field(yes(0), lval(NewClosure), One),
+				lval(field(yes(0), OldClosure, One)))
+				- "set closure code pointer",
+			assign(field(yes(0), lval(NewClosure), Two),
 				binop(+, lval(NumOldArgs), NumNewArgs_Rval))
 				- "set new number of arguments",
-			assign(LoopCounter, Zero)
+			assign(NumOldArgs, binop(+, lval(NumOldArgs), Three))
+				- "set up loop limit",
+			assign(LoopCounter, Three)
 				- "initialize loop counter",
+			goto(label(LoopTest))
+				- "enter the loop at the conceptual top",
 			label(LoopStart) - "start of loop",
-			assign(LoopCounter,
-				binop(+, lval(LoopCounter), One))
-				- "increment loop counter",
 			assign(field(yes(0), lval(NewClosure),
 					lval(LoopCounter)),
 				lval(field(yes(0), OldClosure,
 					lval(LoopCounter))))
-				- "copy old field",
-			if_val(binop(<=, lval(LoopCounter),
-				lval(NumOldArgs)), label(LoopStart))
-				- "repeat the loop?",
-			label(LoopEnd) - "end of loop"
+				- "copy old hidden argument",
+			assign(LoopCounter,
+				binop(+, lval(LoopCounter), One))
+				- "increment loop counter",
+			label(LoopTest) - "the test of the loop",
+			if_val(binop(<, lval(LoopCounter), lval(NumOldArgs)),
+				label(LoopStart))
+				- "repeat the loop?"
 		]) },
 		unify_gen__generate_extra_closure_args(CallArgs,
 			LoopCounter, NewClosure, Code3),
@@ -480,15 +495,48 @@
 	    )
 	;
 		{ Code = empty },
-		{ proc_info_arg_info(ProcInfo, ArgInfo) },
 		code_info__make_entry_label(ModuleInfo, PredId, ProcId, no,
-				CodeAddress),
-		code_info__get_next_cell_number(CellNo),
+			CodeAddr),
+		{ code_util__extract_proc_label_from_code_addr(CodeAddr,
+			ProcLabel) },
+		{ globals__lookup_bool_option(Globals, typeinfo_liveness,
+			TypeInfoLiveness) },
+		{
+			TypeInfoLiveness = yes,
+			continuation_info__generate_closure_layout(
+				ModuleInfo, PredId, ProcId, ClosureInfo),
+			MaybeClosureInfo = yes(ClosureInfo)
+		;
+			TypeInfoLiveness = no,
+			% In the absence of typeinfo liveness, procedures
+			% are not guaranteed to have typeinfos for all the
+			% type variables in their signatures. Such a missing
+			% typeinfo would cause a compile-time abort in
+			% continuation_info__generate_closure_layout,
+			% and even if that predicate was modified,
+			% we still couldn't generate a usable layout
+			% structure.
+			MaybeClosureInfo = no
+		},
+		code_info__get_cell_count(CNum0),
+		{ stack_layout__construct_closure_layout(ProcLabel,
+			MaybeClosureInfo, ClosureLayoutMaybeRvals,
+			CNum0, CNum) },
+		code_info__set_cell_count(CNum),
+		code_info__get_next_cell_number(ClosureLayoutCellNo),
+		{ ClosureLayout = create(0, ClosureLayoutMaybeRvals, no,
+			ClosureLayoutCellNo, "closure_layout") },
 		{ list__length(Args, NumArgs) },
+		{ proc_info_arg_info(ProcInfo, ArgInfo) },
 		{ unify_gen__generate_pred_args(Args, ArgInfo, PredArgs) },
-		{ Vector = [yes(const(int_const(NumArgs))),
-			yes(const(code_addr_const(CodeAddress))) | PredArgs] },
-		{ Value = create(0, Vector, no, CellNo, "closure") }
+		{ Vector = [
+			yes(ClosureLayout),
+			yes(const(code_addr_const(CodeAddr))),
+			yes(const(int_const(NumArgs)))
+			| PredArgs
+		] },
+		code_info__get_next_cell_number(ClosureCellNo),
+		{ Value = create(0, Vector, no, ClosureCellNo, "closure") }
 	),
 	code_info__cache_expression(Var, Value).
 
@@ -502,12 +550,12 @@
 	code_info__produce_variable(Var, Code0, Value),
 	{ One = const(int_const(1)) },
 	{ Code1 = node([
-		assign(LoopCounter,
-			binop(+, lval(LoopCounter), One))
-			- "increment argument counter",
 		assign(field(yes(0), lval(NewClosure), lval(LoopCounter)),
 			Value)
-			- "set new argument field"
+			- "set new argument field",
+		assign(LoopCounter,
+			binop(+, lval(LoopCounter), One))
+			- "increment argument counter"
 	]) },
 	{ Code = tree(tree(Code0, Code1), Code2) },
 	unify_gen__generate_extra_closure_args(Vars, LoopCounter,
@@ -520,7 +568,8 @@
 unify_gen__generate_pred_args([], _, []).
 unify_gen__generate_pred_args([_|_], [], _) :-
 	error("unify_gen__generate_pred_args: insufficient args").
-unify_gen__generate_pred_args([Var|Vars], [ArgInfo|ArgInfos], [Rval|Rvals]) :-
+unify_gen__generate_pred_args([Var | Vars], [ArgInfo | ArgInfos],
+		[Rval | Rvals]) :-
 	ArgInfo = arg_info(_, ArgMode),
 	( ArgMode = top_in ->
 		Rval = yes(var(Var))
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/exceptions
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.20
diff -u -b -u -r1.20 benchmarking.m
--- benchmarking.m	1998/11/12 03:16:14	1.20
+++ benchmarking.m	1999/03/18 20:58:27
@@ -581,8 +581,7 @@
 MR_MAKE_INTERNAL_LAYOUT(mercury__benchmarking__benchmark_nondet_5_0, 1);
 MR_MAKE_INTERNAL_LAYOUT(mercury__benchmarking__benchmark_nondet_5_0, 2);
 
-Declare_entry(do_call_nondet_closure);
-Declare_entry(do_call_det_closure);
+Declare_entry(mercury__do_call_closure);
 
 BEGIN_MODULE(benchmark_nondet_module)
 	init_entry_sl(mercury__benchmarking__benchmark_nondet_5_0);
@@ -632,7 +631,7 @@
 	r2 = (Word) 1;	/* the higher-order call has 1 extra input argument  */
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
 	/* r4 already has the extra input argument */
-	call(ENTRY(do_call_nondet_closure),
+	call(ENTRY(mercury__do_call_closure),
 		LABEL(mercury__benchmarking__benchmark_nondet_5_0_i1),
 		LABEL(mercury__benchmarking__benchmark_nondet_5_0));
 
@@ -667,7 +666,7 @@
 		r2 = (Word) 1;
 		r3 = (Word) 1;
 		r4 = framevar(1);
-		call(ENTRY(do_call_nondet_closure),
+		call(ENTRY(mercury__do_call_closure),
 			LABEL(mercury__benchmarking__benchmark_nondet_5_0_i1),
 			LABEL(mercury__benchmarking__benchmark_nondet_5_0));
 	}
@@ -740,7 +739,7 @@
 	r2 = (Word) 1;	/* the higher-order call has 1 extra input argument  */
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
 	/* r4 already has the extra input argument */
-	call(ENTRY(do_call_det_closure),
+	call(ENTRY(mercury__do_call_closure),
 		LABEL(mercury__benchmarking__benchmark_det_5_0_i1),
 		LABEL(mercury__benchmarking__benchmark_det_5_0));
 
@@ -765,7 +764,7 @@
 		r2 = (Word) 1;
 		r3 = (Word) 1;
 		r4 = detstackvar(2);
-		call(ENTRY(do_call_det_closure),
+		call(ENTRY(mercury__do_call_closure),
 			LABEL(mercury__benchmarking__benchmark_det_5_0_i1),
 			LABEL(mercury__benchmarking__benchmark_det_5_0));
 	}
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.142
diff -u -b -u -r1.142 std_util.m
--- std_util.m	1999/03/12 01:20:28	1.142
+++ std_util.m	1999/03/18 20:58:55
@@ -498,8 +498,7 @@
 #include ""mercury_imp.h""
 #include ""mercury_deep_copy.h""
 
-Declare_entry(do_call_nondet_closure);
-Declare_entry(do_call_det_closure);
+Declare_entry(mercury__do_call_closure);
 
 Define_extern_entry(mercury__std_util__builtin_aggregate_4_0);
 Define_extern_entry(mercury__std_util__builtin_aggregate_4_1);
@@ -692,7 +691,7 @@
 	r2 = (Word) 0;	/* the higher-order call has 0 extra input arguments */
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
 
-	call(ENTRY(do_call_nondet_closure),
+	call(ENTRY(mercury__do_call_nondet_closure),
 		LABEL(mercury__std_util__builtin_aggregate_4_0_i1),
 		LABEL(mercury__std_util__builtin_aggregate_4_0));
 
@@ -730,7 +729,7 @@
 	r3 = (Word) 1;	/* higher-order call has 1 extra output arg */
 	r4 = copied_solution;
 	r5 = sofar_fv;
-	call(ENTRY(do_call_det_closure),
+	call(ENTRY(mercury__do_call_closure),
 		LABEL(mercury__std_util__builtin_aggregate_4_0_i2),
 		LABEL(mercury__std_util__builtin_aggregate_4_0));
 }
@@ -839,7 +838,7 @@
 	r1 = r3;
 	r2 = (Word) 0;	/* the higher-order call has 0 extra input arguments */
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
-	call(ENTRY(do_call_nondet_closure),
+	call(ENTRY(mercury__do_call_closure),
 		LABEL(mercury__std_util__builtin_aggregate_4_0_i1),
 		LABEL(mercury__std_util__builtin_aggregate_4_0));
 
@@ -861,7 +860,7 @@
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
 	r5 = sofar_fv;
 
-	call(ENTRY(do_call_det_closure),
+	call(ENTRY(mercury__do_call_closure),
 		LABEL(mercury__std_util__builtin_aggregate_4_0_i2),
 		LABEL(mercury__std_util__builtin_aggregate_4_0));
 
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing readline
cvs diff: Diffing readline/doc
cvs diff: Diffing readline/examples
cvs diff: Diffing readline/shlib
cvs diff: Diffing readline/support
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.44
diff -u -b -u -r1.44 Mmakefile
--- Mmakefile	1999/03/15 00:39:29	1.44
+++ Mmakefile	1999/03/18 09:14:08
@@ -44,6 +44,7 @@
 			mercury_hash_table.h	\
 			mercury_heap.h		\
 			mercury_heap_profile.h	\
+			mercury_ho_call.h	\
 			mercury_imp.h		\
 			mercury_init.h		\
 			mercury_label.h		\
Index: runtime/mercury_calls.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_calls.h,v
retrieving revision 1.4
diff -u -b -u -r1.4 mercury_calls.h
--- mercury_calls.h	1998/01/04 05:23:50	1.4
+++ mercury_calls.h	1999/03/18 10:26:49
@@ -97,27 +97,6 @@
 			noprof_call_localret(proc, succ_cont);	\
 		} while (0)
 
-#define	call_det_closure(succ_cont, current_label)		\
-		do {						\
-			Declare_entry(do_call_det_closure);	\
-			call(ENTRY(do_call_det_closure),	\
-				(succ_cont), (current_label));	\
-		} while (0)
-
-#define	call_semidet_closure(succ_cont, current_label)		\
-		do {						\
-			Declare_entry(do_call_semidet_closure); \
-			call(ENTRY(do_call_semidet_closure),	\
-				(succ_cont), (current_label));	\
-		} while (0)
-
-#define	call_nondet_closure(succ_cont, current_label)		\
-		do {						\
-			Declare_entry(do_call_nondet_closure);	\
-			call(ENTRY(do_call_nondet_closure),	\
-				(succ_cont), (current_label));	\
-		} while (0)
-
 #define	localtailcall(label, current_label)			\
 		do {						\
 			debugtailcall(LABEL(label));		\
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.14
diff -u -b -u -r1.14 mercury_ho_call.c
--- mercury_ho_call.c	1998/11/09 05:20:42	1.14
+++ mercury_ho_call.c	1999/03/18 21:02:04
@@ -3,7 +3,7 @@
 ENDINIT
 */
 /*
-** Copyright (C) 1995-1998 The University of Melbourne.
+** Copyright (C) 1995-1999 The 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.
 */
@@ -32,6 +32,7 @@
 */
 
 #include "mercury_imp.h"
+#include "mercury_ho_call.h"
 
 	/* 
 	** Number of input arguments to do_call_*_closure, 
@@ -50,6 +51,10 @@
 	*/
 #define MR_CLASS_METHOD_CALL_INPUTS	4
 
+/*
+** The following entries are obsolete, and are kept for bootstrapping only.
+*/
+
 Define_extern_entry(do_call_det_closure);
 Define_extern_entry(do_call_semidet_closure);
 Define_extern_entry(do_call_nondet_closure);
@@ -58,6 +63,17 @@
 Define_extern_entry(do_call_semidet_class_method);
 Define_extern_entry(do_call_nondet_class_method);
 
+/*
+** These are the real implementations of higher order calls and method calls.
+*/
+
+Define_extern_entry(mercury__do_call_closure);
+Define_extern_entry(mercury__do_call_class_method);
+
+/*
+** These are the real implementations of unify, index and compare.
+*/
+
 Define_extern_entry(mercury__unify_2_0);
 Define_extern_entry(mercury__index_2_0);
 Declare_label(mercury__index_2_0_i1);
@@ -93,10 +109,14 @@
 	init_entry_ai(do_call_semidet_closure);
 	init_entry_ai(do_call_nondet_closure);
 
+	init_entry_ai(mercury__do_call_closure);
+
 	init_entry_ai(do_call_det_class_method);
 	init_entry_ai(do_call_semidet_class_method);
 	init_entry_ai(do_call_nondet_class_method);
 
+	init_entry_ai(mercury__do_call_class_method);
+
 	init_entry_ai(mercury__unify_2_0);
 #ifdef	COMPACT_ARGS
 	init_entry_ai(mercury__index_2_0);
@@ -209,6 +229,49 @@
 	tailcall((Code *) field(0, closure, 1), LABEL(do_call_nondet_closure));
 }
 
+Define_entry(mercury__do_call_closure);
+{
+	Word	*closure;
+	int	num_extra_args;		/* # of args provided by our caller */
+	int	num_hidden_args;	/* # of args hidden in the closure */
+	int	i;
+
+	closure = (Word *) r1;
+
+	/* This check is for bootstrapping only. */
+	if (((Word) MR_CLOSURE_LAYOUT_VECTOR(closure)) < 1024) {
+		/* we found an old-style closure, call the old handler */
+		tailcall(ENTRY(do_call_det_closure),
+			LABEL(mercury__do_call_closure));
+	}
+
+	num_extra_args = r2;
+	num_hidden_args = MR_CLOSURE_HIDDEN_ARG_COUNT(closure);
+
+	save_registers();
+
+	if (num_hidden_args < MR_HO_CALL_INPUTS) {
+		for (i = 1; i <= num_extra_args; i++) {
+			virtual_reg(i + num_hidden_args) =
+				virtual_reg(i + MR_HO_CALL_INPUTS);
+		}
+	} else if (num_hidden_args > MR_HO_CALL_INPUTS) {
+		for (i = num_extra_args; i > 0; i--) {
+			virtual_reg(i + num_hidden_args) =
+				virtual_reg(i + MR_HO_CALL_INPUTS);
+		}
+	} /* else the new args are in the right place */
+
+	for (i = 1; i <= num_hidden_args; i++) {
+		virtual_reg(i) = MR_CLOSURE_HIDDEN_ARG(closure, i);
+	}
+
+	restore_registers();
+
+	tailcall(MR_CLOSURE_CODEADDR(closure),
+		LABEL(mercury__do_call_closure));
+}
+
 	/*
 	** r1: the typeclass_info
 	** r2: index of class method
@@ -331,6 +394,52 @@
 	restore_registers();
 
 	tailcall(destination, LABEL(do_call_nondet_class_method));
+}
+
+	/*
+	** r1: the typeclass_info
+	** r2: index of class method
+	** r3: number of immediate input arguments
+	** r4: number of output arguments
+	** r5+:input args
+	*/
+
+Define_entry(mercury__do_call_class_method);
+{
+	Code 	*destination;
+	int	num_in_args;
+	int	num_arg_typeclass_infos;
+	int	i;
+
+	destination = MR_typeclass_info_class_method(r1, r2);
+	num_arg_typeclass_infos = (int) MR_typeclass_info_instance_arity(r1);
+
+	num_in_args = r3; /* number of input args */
+
+	save_registers();
+
+	if (num_arg_typeclass_infos < MR_CLASS_METHOD_CALL_INPUTS) {
+			/* copy to the left, from the left */
+		for (i = 1; i <= num_in_args; i++) {
+			virtual_reg(i + num_arg_typeclass_infos) =
+				virtual_reg(i + MR_CLASS_METHOD_CALL_INPUTS);
+		}
+	} else if (num_arg_typeclass_infos > MR_CLASS_METHOD_CALL_INPUTS) {
+			/* copy to the right, from the right */
+		for (i = num_in_args; i > 0; i--) {
+			virtual_reg(i + num_arg_typeclass_infos) =
+				virtual_reg(i + MR_CLASS_METHOD_CALL_INPUTS);
+		}
+	} /* else the new args are in the right place */
+
+	for (i = num_arg_typeclass_infos; i > 0; i--) {
+		virtual_reg(i) = 
+			MR_typeclass_info_arg_typeclass_info(virtual_reg(1),i);
+	}
+
+	restore_registers();
+
+	tailcall(destination, LABEL(mercury__do_call_class_method));
 }
 
 /*
Index: runtime/mercury_ho_call.h
===================================================================
RCS file: mercury_ho_call.h
diff -N mercury_ho_call.h
--- /dev/null	Sun Mar 21 19:05:00 1999
+++ mercury_ho_call.h	Sat Mar 20 20:35:15 1999
@@ -0,0 +1,103 @@
+/*
+** Copyright (C) 1999 The 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_ho_call.h - defines the structure of closures.
+*/
+
+#ifndef	MERCURY_HO_CALL_H
+#define	MERCURY_HO_CALL_H
+
+#include "mercury_stack_layout.h"
+
+/*
+** A closure is a vector of words containing:
+**
+**	one word pointing to the closure layout structure of the procedure
+**	one word pointing to the code of the procedure
+**	one word giving the number of arguments hidden in the closure (N)
+**	N words representing the N hidden arguments
+**
+** The reason why the closure layout pointer is first is that most operations
+** on closures do not need to access that word, and this way it does not
+** have be brought into the cache.
+**
+** The closure layout structure of a procedure is a vector of words containing
+**
+**	a MR_Stack_Layout_Proc_Id structure
+**	one word giving the number of arguments of the procedure (M)
+**	M words giving pseudotypeinfos for the arguments
+**	one word giving the number of type vars in those pseudotypeinfos (T)
+**	T words giving the locations of the typeinfos for those type vars
+**
+** The reason why T is just before the typeinfo locatio vector and not
+** immediately next to M is that the typeinfo components of label layouts
+** have the same structure, and this should enable some code reuse.
+** (See MR_Stack_Layout_Vars in mercury_stack_layout.h.)
+**
+** Since a closure for a procedure cannot specify more arguments than the
+** procedure can support, N =< M. Since the typeinfos for type vars are
+** also arguments, inserted by polymorphism.m, T =< M (and if the procedure
+** has any real arguments, T < M).
+**
+** The typeinfo and typeclassinfo arguments describing the actual types bound
+** to type vars are always at the start of the argument list. A closure can
+** contain arg i but not arg j only if i < j; this means that if a closure
+** contains a non-typeinfo argument j, it also contains all the typeinfo
+** and typeclassinfo arguments of the procedure and therefore (directly or
+** indirectly) all the typeinfos that may be referred to in the pseudotypeinfo
+** for argument j. (If we ever allow code to take the address of a procedure
+** whose signature includes an existential type, we may have to rethink this.)
+**
+** The T words encoding the locations of the typeinfos assume that
+** argument i is in register ri. While this will be true at the time of the
+** call, code that wants to manipulate the closure as an independent entity
+** will have to substitute the argument vector in the closure itself
+** for the register file.
+**
+** Note that if a module is compiled without typeinfo liveness, then closures
+** will not have any layout information. This will be indicated by the value
+** of M being negative, which says that the words following M are not present,
+**
+** The places in the system that know about the layouts of closures are
+**
+**	compiler/unify_gen.m (unify_gen__generate_construction_2)
+**	runtime/mercury_ho_call.[ch]
+*/
+
+/*
+** These macros assume that
+**	- c is a Word * that points to a closure
+**	- i is an argument number, with the first argument being arg 1
+*/
+
+#define	MR_CLOSURE_LAYOUT_VECTOR(c)	((Word *) ((c)[0]))
+#define	MR_CLOSURE_CODEADDR(c)		((Code *) ((c)[1]))
+#define	MR_CLOSURE_HIDDEN_ARG_COUNT(c)	((Integer) ((c)[2]))
+#define	MR_CLOSURE_HIDDEN_ARG(c, i)	((Word) ((c)[2 + (i)]))
+
+/*
+** These macros assume that
+**	- lv is a Word * that points to a closure layout vector
+**	- i is an argument number, with the first one being numbered 1
+**	- p is a type parameter number, with the first one being numbered 1
+*/
+
+#define	MR_CLOSURELAYOUT_PROC_ARITY(lv)					\
+		((lv)[sizeof(MR_Stack_Layout_Proc_Id)])
+#define	MR_CLOSURELAYOUT_ARG_PSEUDO_TI(lv, i)				\
+		((lv)[sizeof(MR_Stack_Layout_Proc_Id) + (i)])
+#define	MR_CLOSURELAYOUT_TYPE_PARAM_COUNT(lv)				\
+		((lv)[sizeof(MR_Stack_Layout_Proc_Id) + 1 + 		\
+			MR_CLOSURELAYOUT_PROC_ARITY(lv))
+#define	MR_CLOSURELAYOUT_TYPE_PARAM_LOCN(lv, p)				\
+		((lv)[sizeof(MR_Stack_Layout_Proc_Id) + 1 + 		\
+			MR_CLOSURELAYOUT_PROC_ARITY(lv) + (p)])
+#define	MR_CLOSURELAYOUT_TYPE_PARAM_LOCN_VEC(lv)			\
+		&((lv)[sizeof(MR_Stack_Layout_Proc_Id) + 1 +		\
+			MR_CLOSURELAYOUT_PROC_ARITY(lv))
+
+#endif /* not MERCURY_HO_CALL_H */
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trial
cvs diff: Diffing util



More information about the developers mailing list