[m-rev.] abandoned diff: stubborn allocation

Zoltan Somogyi zs at cs.mu.OZ.AU
Wed May 4 17:44:02 AEST 2005


Provide a mechanism for enabling stubborn allocations (allocations of memory
blocks whose contents don't change once they are initialized). The hope was
that this would make the Boehm collector more efficient, but this turned out
not to be the case:

	EXTRA_MCFLAGS = 
	EXTRA_CFLAGS = -DMR_ENABLE_STUBBORN -DMR_ENABLE_INCREMENTAL_GC
	mercury_compile.01 average of 6 with ignore=1     84.77
	EXTRA_MCFLAGS = 
	EXTRA_CFLAGS = -DMR_ENABLE_STUBBORN
	mercury_compile.02 average of 6 with ignore=1     55.74
	EXTRA_MCFLAGS = 
	EXTRA_CFLAGS = 
	mercury_compile.03 average of 6 with ignore=1     50.78

Therefore this diff is mostly of historical interest only, though it is
possible (though unlikely) that someday the overhead of incremental gc
will be reduced to the point where it is worth enabling it.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
Index: boehm_gc/Makefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/boehm_gc/Makefile,v
retrieving revision 1.58
diff -u -r1.58 Makefile
--- boehm_gc/Makefile	19 Oct 2004 06:01:35 -0000	1.58
+++ boehm_gc/Makefile	31 Mar 2005 14:53:36 -0000
@@ -82,7 +82,7 @@
 
 # Mercury-specific CFLAGS:
 CFLAGS= -I$(srcdir)/include \
-	-DSILENT -DNO_DEBUGGING -DNO_EXECUTE_PERMISSION \
+	-DSILENT -DNO_DEBUGGING -DNO_EXECUTE_PERMISSION -DSTUBBORN_ALLOC \
 	$(CFLAGS_FOR_PIC) $(DLL_CFLAGS) $(EXTRA_CFLAGS)
 # Note that the `mgnuc' script also passes -DNO_SIGNALS, unless
 # profiling was enabled (see comments in runtime/mercury_prof_mem.h for why).
Index: boehm_gc/dbg_mlc.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/boehm_gc/dbg_mlc.c,v
retrieving revision 1.17
diff -u -r1.17 dbg_mlc.c
--- boehm_gc/dbg_mlc.c	28 Oct 2003 08:48:40 -0000	1.17
+++ boehm_gc/dbg_mlc.c	31 Mar 2005 11:31:00 -0000
@@ -561,6 +561,31 @@
     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 }
 
+# ifdef __STDC__
+    GC_PTR GC_debug_malloc_stubborn_mercury(size_t lb, GC_EXTRA_PARAMS)
+# else
+    GC_PTR GC_debug_malloc_stubborn_mercury(lb, s, i)
+    size_t lb;
+    char * s;
+    int i;
+# endif
+{
+    GC_PTR result = GC_malloc_stubborn_mercury(lb + DEBUG_BYTES);
+    
+    if (result == 0) {
+        GC_err_printf1("GC_debug_malloc_stubborn_mercury(%ld) returning NIL (",
+        	       (unsigned long) lb);
+        GC_err_puts(s);
+        GC_err_printf1(":%ld)\n", (unsigned long)i);
+        return(0);
+    }
+    if (!GC_debugging_started) {
+    	GC_start_debugging();
+    }
+    ADD_CALL_CHAIN(result, ra);
+    return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
 void GC_debug_change_stubborn(p)
 GC_PTR p;
 {
Index: boehm_gc/stubborn.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/boehm_gc/stubborn.c,v
retrieving revision 1.5
diff -u -r1.5 stubborn.c
--- boehm_gc/stubborn.c	25 Jul 2002 09:02:49 -0000	1.5
+++ boehm_gc/stubborn.c	2 Apr 2005 10:02:30 -0000
@@ -235,6 +235,95 @@
    return((GC_PTR)GC_clear_stack(result));
 }
 
+/*
+** End the previous stubborn allocation, and start a new one.
+*/
+#ifdef __STDC__
+	GC_PTR GC_malloc_stubborn_mercury(size_t lb)
+#else
+	GC_PTR GC_malloc_stubborn_mercury(lb)
+	size_t lb;
+#endif
+{
+	static GC_PTR prev = NULL;
+	register ptr_t op;
+	register ptr_t *opp;
+	register word lw;
+	ptr_t result;
+	DCL_LOCK_STATE;
+
+	if (prev != NULL) {
+#ifdef THREADS
+		register VOLATILE GC_PTR *my_current;
+#else
+		register GC_PTR *my_current;
+#endif
+		DCL_LOCK_STATE;
+	    
+		my_current = GC_changing_list_current;
+		/* Hopefully the normal case.				   */
+		/* Compaction could not have been running when we started. */
+		*my_current = 0;
+#ifdef THREADS
+		if (my_current == GC_changing_list_current) {
+			/* Compaction can't have run in the interim. 	*/
+			/* We got away with the quick and dirty approach.   */
+			goto allocate;
+		}
+#else
+		goto allocate;
+#endif
+		DISABLE_SIGNALS();
+		LOCK();
+		my_current = GC_changing_list_current;
+		for (; my_current >= GC_changing_list_start; my_current--) {
+			if (*my_current == prev) {
+				*my_current = 0;
+				UNLOCK();
+				ENABLE_SIGNALS();
+				goto allocate;
+			}
+		}
+
+		UNLOCK();
+		ENABLE_SIGNALS();
+	}
+
+allocate:
+
+	if (SMALL_OBJ(lb)) {
+#ifdef MERGE_SIZES
+		lw = GC_size_map[lb];
+#else
+		lw = ALIGNED_WORDS(lb);
+#endif
+		opp = &(GC_sobjfreelist[lw]);
+		FASTLOCK();
+		if (!FASTLOCK_SUCCEEDED() || (op = *opp) == 0) {
+			FASTUNLOCK();
+			result = GC_generic_malloc((word) lb, STUBBORN);
+			goto record;
+		}
+		*opp = obj_link(op);
+		obj_link(op) = 0;
+		GC_words_allocd += lw;
+		result = (GC_PTR) op;
+		ADD_CHANGING(result);
+		FASTUNLOCK();
+		prev = (GC_PTR) result;
+		return prev;
+	} else {
+		result = (GC_PTR) GC_generic_malloc((word) lb, STUBBORN);
+	}
+record:
+	DISABLE_SIGNALS();
+	LOCK();
+	ADD_CHANGING(result);
+	UNLOCK();
+	ENABLE_SIGNALS();
+	prev = (GC_PTR) GC_clear_stack(result);
+	return prev;
+}
 
 /* Functions analogous to GC_read_dirty and GC_page_was_dirty.	*/
 /* Report pages on which stubborn objects were changed.		*/
@@ -301,6 +390,16 @@
     GC_PTR GC_malloc_stubborn(size_t lb)
 # else
     GC_PTR GC_malloc_stubborn(lb)
+    size_t lb;
+# endif
+{
+    return(GC_malloc(lb));
+}
+
+# ifdef __STDC__
+    GC_PTR GC_malloc_stubborn_mercury(size_t lb)
+# else
+    GC_PTR GC_malloc_stubborn_mercury(lb)
     size_t lb;
 # endif
 {
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
Index: boehm_gc/include/gc.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/boehm_gc/include/gc.h,v
retrieving revision 1.14
diff -u -r1.14 gc.h
--- boehm_gc/include/gc.h	28 Oct 2003 08:48:43 -0000	1.14
+++ boehm_gc/include/gc.h	31 Mar 2005 11:28:58 -0000
@@ -267,6 +267,7 @@
 GC_API GC_PTR GC_malloc_atomic GC_PROTO((size_t size_in_bytes));
 GC_API GC_PTR GC_malloc_uncollectable GC_PROTO((size_t size_in_bytes));
 GC_API GC_PTR GC_malloc_stubborn GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_stubborn_mercury GC_PROTO((size_t size_in_bytes));
 
 /* The following is only defined if the library has been suitably	*/
 /* compiled:								*/
@@ -517,6 +518,8 @@
 	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
 GC_API GC_PTR GC_debug_malloc_stubborn
 	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_stubborn_mercury
+	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
 GC_API GC_PTR GC_debug_malloc_ignore_off_page
 	GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
 GC_API GC_PTR GC_debug_malloc_atomic_ignore_off_page
@@ -562,6 +565,7 @@
 #   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
 	GC_debug_register_finalizer_no_order(p, f, d, of, od)
 #   define GC_MALLOC_STUBBORN(sz) GC_debug_malloc_stubborn(sz, GC_EXTRAS);
+#   define GC_MALLOC_STUBBORN_MERCURY(sz) GC_debug_malloc_stubborn_mercury(sz, GC_EXTRAS);
 #   define GC_CHANGE_STUBBORN(p) GC_debug_change_stubborn(p)
 #   define GC_END_STUBBORN_CHANGE(p) GC_debug_end_stubborn_change(p)
 #   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
@@ -584,6 +588,7 @@
 #   define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
 	GC_register_finalizer_no_order(p, f, d, of, od)
 #   define GC_MALLOC_STUBBORN(sz) GC_malloc_stubborn(sz)
+#   define GC_MALLOC_STUBBORN_MERCURY(sz) GC_malloc_stubborn_mercury(sz)
 #   define GC_CHANGE_STUBBORN(p) GC_change_stubborn(p)
 #   define GC_END_STUBBORN_CHANGE(p) GC_end_stubborn_change(p)
 #   define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.297
diff -u -r1.297 code_info.m
--- compiler/code_info.m	24 Mar 2005 02:00:17 -0000	1.297
+++ compiler/code_info.m	31 Mar 2005 12:33:39 -0000
@@ -3101,8 +3101,8 @@
 	% code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector,
 	% 	Size, TypeMsg, Code, !CI):
 :- pred code_info__assign_cell_to_var(prog_var::in, bool::in, tag::in,
-	list(maybe(rval))::in, maybe(term_size_value)::in, string::in,
-	code_tree::out, code_info::in, code_info::out) is det.
+	list(maybe(rval))::in, maybe(term_size_value)::in, stubborn::in,
+	string::in, code_tree::out, code_info::in, code_info::out) is det.
 
 :- pred code_info__place_var(prog_var::in, lval::in, code_tree::out,
 	code_info::in, code_info::out) is det.
@@ -3238,11 +3238,11 @@
 	code_info__set_var_locn_info(VarLocnInfo, !CI).
 
 code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, Size,
-		TypeMsg, Code, !CI) :-
+		Stubborn, TypeMsg, Code, !CI) :-
 	code_info__get_var_locn_info(!.CI, VarLocnInfo0),
 	code_info__get_static_cell_info(!.CI, StaticCellInfo0),
 	var_locn__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector,
-		Size, TypeMsg, Code, StaticCellInfo0, StaticCellInfo,
+		Size, Stubborn, TypeMsg, Code, StaticCellInfo0, StaticCellInfo,
 		VarLocnInfo0, VarLocnInfo),
 	code_info__set_static_cell_info(StaticCellInfo, !CI),
 	code_info__set_var_locn_info(VarLocnInfo, !CI).
@@ -3634,7 +3634,8 @@
 code_info__generate_resume_layout(Label, ResumeMap, !CI) :-
 	code_info__get_globals(!.CI, Globals),
 	globals__lookup_bool_option(Globals, agc_stack_layout, AgcStackLayout),
-	( AgcStackLayout = yes ->
+	(
+		AgcStackLayout = yes,
 		code_info__get_active_temps_data(!.CI, Temps),
 		code_info__get_instmap(!.CI, InstMap),
 		code_info__get_proc_info(!.CI, ProcInfo),
@@ -3643,7 +3644,7 @@
 			Temps, InstMap, ProcInfo, ModuleInfo, Layout),
 		code_info__add_resume_layout_for_label(Label, Layout, !CI)
 	;
-		true
+		AgcStackLayout = no
 	).
 
 %---------------------------------------------------------------------------%
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.63
diff -u -r1.63 dupelim.m
--- compiler/dupelim.m	24 Mar 2005 02:00:24 -0000	1.63
+++ compiler/dupelim.m	31 Mar 2005 11:41:20 -0000
@@ -343,10 +343,12 @@
 		standardize_rval(Rval1, Rval),
 		Instr = if_val(Rval, CodeAddr)
 	;
-		Instr1 = incr_hp(Lval1, MaybeTag, MaybeOffset, Rval1, Msg),
+		Instr1 = incr_hp(Lval1, MaybeTag, MaybeOffset, Rval1, Stubborn,
+			Msg),
 		standardize_lval(Lval1, Lval),
 		standardize_rval(Rval1, Rval),
-		Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Msg)
+		Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Stubborn,
+			Msg)
 	;
 		Instr1 = mark_hp(Lval1),
 		standardize_lval(Lval1, Lval),
@@ -650,11 +652,14 @@
 		most_specific_rval(Rval1, Rval2, Rval),
 		Instr = if_val(Rval, CodeAddr)
 	;
-		Instr1 = incr_hp(Lval1, MaybeTag, MaybeOffset, Rval1, Msg),
-		Instr2 = incr_hp(Lval2, MaybeTag, MaybeOffset, Rval2, Msg),
+		Instr1 = incr_hp(Lval1, MaybeTag, MaybeOffset, Rval1, Stubborn,
+			Msg),
+		Instr2 = incr_hp(Lval2, MaybeTag, MaybeOffset, Rval2, Stubborn,
+			Msg),
 		most_specific_lval(Lval1, Lval2, Lval),
 		most_specific_rval(Rval1, Rval2, Rval),
-		Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Msg)
+		Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Stubborn,
+			Msg)
 	;
 		Instr1 = mark_hp(Lval1),
 		Instr2 = mark_hp(Lval2),
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.55
diff -u -r1.55 exprn_aux.m
--- compiler/exprn_aux.m	24 Mar 2005 02:00:24 -0000	1.55
+++ compiler/exprn_aux.m	31 Mar 2005 12:15:41 -0000
@@ -327,165 +327,155 @@
 	exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval,
 		0, _SubstCount).
 
-exprn_aux__substitute_lval_in_instr(OldLval, NewLval, Instr0, Instr, N0, N) :-
+exprn_aux__substitute_lval_in_instr(OldLval, NewLval, Instr0, Instr, !N) :-
 	Instr0 = Uinstr0 - Comment,
 	exprn_aux__substitute_lval_in_uinstr(OldLval, NewLval,
-		Uinstr0, Uinstr, N0, N),
+		Uinstr0, Uinstr, !N),
 	Instr = Uinstr - Comment.
 
 :- pred exprn_aux__substitute_lval_in_uinstr(lval::in, lval::in,
 	instr::in, instr::out, int::in, int::out) is det.
 
-exprn_aux__substitute_lval_in_uinstr(OldLval, NewLval, Uinstr0, Uinstr, N0, N)
-		:-
+exprn_aux__substitute_lval_in_uinstr(OldLval, NewLval, Uinstr0, Uinstr, !N) :-
 	(
 		Uinstr0 = comment(_Comment),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = livevals(LvalSet0),
 		set__to_sorted_list(LvalSet0, Lvals0),
 		list__map_foldl(
 			exprn_aux__substitute_lval_in_lval_count(OldLval,
 				NewLval),
-			Lvals0, Lvals, N0, N),
+			Lvals0, Lvals, !N),
 		set__list_to_set(Lvals, LvalSet),
 		Uinstr = livevals(LvalSet)
 	;
 		Uinstr0 = block(TempR, TempF, Instrs0),
 		list__map_foldl(
 			exprn_aux__substitute_lval_in_instr(OldLval, NewLval),
-			Instrs0, Instrs, N0, N),
+			Instrs0, Instrs, !N),
 		Uinstr = block(TempR, TempF, Instrs)
 	;
 		Uinstr0 = assign(Lval0, Rval0),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N1),
+			Lval0, Lval, !N),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N1, N),
+			Rval0, Rval, !N),
 		Uinstr = assign(Lval, Rval)
 	;
 		Uinstr0 = call(_, _, _, _, _, _),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = mkframe(_, _),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = label(_),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = goto(_),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = computed_goto(Rval0, Labels),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Uinstr = computed_goto(Rval, Labels)
 	;
 		Uinstr0 = c_code(Code, LiveLvals0),
 		exprn_aux__substitute_lval_in_live_lval_info(OldLval, NewLval,
-			LiveLvals0, LiveLvals, N0, N),
+			LiveLvals0, LiveLvals, !N),
 		Uinstr = c_code(Code, LiveLvals)
 	;
 		Uinstr0 = if_val(Rval0, CodeAddr),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Uinstr = if_val(Rval, CodeAddr)
 	;
-		Uinstr0 = incr_hp(Lval0, MaybeTag, MO, Rval0, TypeCtor),
+		Uinstr0 = incr_hp(Lval0, MaybeTag, MO, Rval0, Stubborn,
+			TypeCtor),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N1),
+			Lval0, Lval, !N),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N1, N),
-		Uinstr = incr_hp(Lval, MaybeTag, MO, Rval, TypeCtor)
+			Rval0, Rval, !N),
+		Uinstr = incr_hp(Lval, MaybeTag, MO, Rval, Stubborn, TypeCtor)
 	;
 		Uinstr0 = mark_hp(Lval0),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Uinstr = mark_hp(Lval)
 	;
 		Uinstr0 = restore_hp(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Uinstr = restore_hp(Rval)
 	;
 		Uinstr0 = free_heap(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Uinstr = free_heap(Rval)
 	;
 		Uinstr0 = store_ticket(Lval0),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Uinstr = store_ticket(Lval)
 	;
 		Uinstr0 = reset_ticket(Rval0, Reason),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Uinstr = reset_ticket(Rval, Reason)
 	;
 		Uinstr0 = prune_ticket,
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = discard_ticket,
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = mark_ticket_stack(Lval0),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Uinstr = mark_ticket_stack(Lval)
 	;
 		Uinstr0 = prune_tickets_to(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Uinstr = prune_tickets_to(Rval)
 %	;
 %		% discard_tickets_to(_) is used only in hand-written code
 %		Uinstr0 = discard_tickets_to(Rval0),
 %		exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
-%			Rval0, Rval, N0, N),
+%			Rval0, Rval, !N),
 %		Uinstr = discard_tickets_to(Rval)
 	;
 		Uinstr0 = incr_sp(_, _),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = decr_sp(_),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = pragma_c(Decls, Components0, MayCallMercury,
 			MaybeLabel1, MaybeLabel2, MaybeLabel3, MaybeLabel4,
 			ReferStackSlot, MayDupl),
 		list__map_foldl(exprn_aux__substitute_lval_in_component(
-			OldLval, NewLval), Components0, Components, N0, N),
+			OldLval, NewLval), Components0, Components, !N),
 		Uinstr = pragma_c(Decls, Components, MayCallMercury,
 			MaybeLabel1, MaybeLabel2, MaybeLabel3, MaybeLabel4,
 			ReferStackSlot, MayDupl)
 	;
 		Uinstr0 = init_sync_term(Lval0, BranchCount),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Uinstr = init_sync_term(Lval, BranchCount)
 	;
 		Uinstr0 = fork(_, _, _),
-		Uinstr = Uinstr0,
-		N = N0
+		Uinstr = Uinstr0
 	;
 		Uinstr0 = join_and_terminate(Lval0),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Uinstr = join_and_terminate(Lval)
 	;
 		Uinstr0 = join_and_continue(Lval0, Label),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Uinstr = join_and_continue(Lval, Label)
 	).
 
@@ -494,34 +484,31 @@
 	is det.
 
 exprn_aux__substitute_lval_in_component(OldLval, NewLval,
-		Component0, Component, N0, N) :-
+		Component0, Component, !N) :-
 	(
 		Component0 = pragma_c_inputs(Inputs0),
 		list__map_foldl(exprn_aux__substitute_lval_in_pragma_c_input(
-			OldLval, NewLval), Inputs0, Inputs, N0, N),
+			OldLval, NewLval), Inputs0, Inputs, !N),
 		Component = pragma_c_inputs(Inputs)
 	;
 		Component0 = pragma_c_outputs(Outputs0),
 		list__map_foldl(exprn_aux__substitute_lval_in_pragma_c_output(
-			OldLval, NewLval), Outputs0, Outputs, N0, N),
+			OldLval, NewLval), Outputs0, Outputs, !N),
 		Component = pragma_c_outputs(Outputs)
 	;
 		Component0 = pragma_c_user_code(_, _),
-		Component = Component0,
-		N = N0
+		Component = Component0
 	;
 		Component0 = pragma_c_raw_code(Code, LvalSet0),
 		exprn_aux__substitute_lval_in_live_lval_info(OldLval, NewLval,
-			LvalSet0, LvalSet, N0, N),
+			LvalSet0, LvalSet, !N),
 		Component = pragma_c_raw_code(Code, LvalSet)
 	;
 		Component0 = pragma_c_fail_to(_),
-		Component = Component0,
-		N = N0
+		Component = Component0
 	;
 		Component0 = pragma_c_noop,
-		Component = Component0,
-		N = N0
+		Component = Component0
 	).
 
 :- pred exprn_aux__substitute_lval_in_live_lval_info(lval::in, lval::in,
@@ -529,215 +516,200 @@
 	is det.
 
 exprn_aux__substitute_lval_in_live_lval_info(_OldLval, _NewLval,
-		no_live_lvals_info, no_live_lvals_info, N, N).
+		no_live_lvals_info, no_live_lvals_info, !N).
 exprn_aux__substitute_lval_in_live_lval_info(OldLval, NewLval,
-		live_lvals_info(LvalSet0), live_lvals_info(LvalSet), N0, N) :-
+		live_lvals_info(LvalSet0), live_lvals_info(LvalSet), !N) :-
 	Lvals0 = set__to_sorted_list(LvalSet0),
 	list__map_foldl(
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval),
-		Lvals0, Lvals, N0, N),
+		Lvals0, Lvals, !N),
 	set__list_to_set(Lvals, LvalSet).
 
 :- pred exprn_aux__substitute_lval_in_pragma_c_input(lval::in, lval::in,
 	pragma_c_input::in, pragma_c_input::out, int::in, int::out) is det.
 
 exprn_aux__substitute_lval_in_pragma_c_input(OldLval, NewLval, Out0, Out,
-		N0, N) :-
+		!N) :-
 	Out0 = pragma_c_input(Name, VarType, OrigType, Rval0, MaybeForeign),
 	exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval,
-		N0, N),
+		!N),
 	Out = pragma_c_input(Name, VarType, OrigType, Rval, MaybeForeign).
 
 :- pred exprn_aux__substitute_lval_in_pragma_c_output(lval::in, lval::in,
 	pragma_c_output::in, pragma_c_output::out, int::in, int::out) is det.
 
 exprn_aux__substitute_lval_in_pragma_c_output(OldLval, NewLval, Out0, Out,
-		N0, N) :-
+		!N) :-
 	Out0 = pragma_c_output(Lval0, VarType, OrigType, Name, MaybeForeign),
 	exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval, Lval0, Lval,
-		N0, N),
+		!N),
 	Out = pragma_c_output(Lval, VarType, OrigType, Name, MaybeForeign).
 
 :- pred exprn_aux__substitute_lval_in_rval_count(lval::in, lval::in,
 	rval::in, rval::out, int::in, int::out) is det.
 
-exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval,
-		N0, N) :-
+exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval, !N) :-
 	(
 		Rval0 = lval(Lval0),
 		exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
-			Lval0, Lval, N0, N),
+			Lval0, Lval, !N),
 		Rval = lval(Lval)
 	;
 		Rval0 = var(_Var),
-		Rval = Rval0,
-		N = N0
+		Rval = Rval0
 	;
 		Rval0 = mkword(Tag, Rval1),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval1, Rval2, N0, N),
+			Rval1, Rval2, !N),
 		Rval = mkword(Tag, Rval2)
 	;
 		Rval0 = const(_Const),
-		Rval = Rval0,
-		N = N0
+		Rval = Rval0
 	;
 		Rval0 = unop(Unop, Rval1),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval1, Rval2, N0, N),
+			Rval1, Rval2, !N),
 		Rval = unop(Unop, Rval2)
 	;
 		Rval0 = binop(Binop, Rval1, Rval2),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval1, Rval3, N0, N1),
+			Rval1, Rval3, !N),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval2, Rval4, N1, N),
+			Rval2, Rval4, !N),
 		Rval = binop(Binop, Rval3, Rval4)
 	;
 		Rval0 = mem_addr(MemRef0),
 		exprn_aux__substitute_lval_in_mem_ref(OldLval, NewLval,
-			MemRef0, MemRef, N0, N),
+			MemRef0, MemRef, !N),
 		Rval = mem_addr(MemRef)
 	).
 
 :- pred exprn_aux__substitute_lval_in_mem_ref(lval::in, lval::in,
 	mem_ref::in, mem_ref::out, int::in, int::out) is det.
 
-exprn_aux__substitute_lval_in_mem_ref(OldLval, NewLval, MemRef0, MemRef,
-		N0, N) :-
+exprn_aux__substitute_lval_in_mem_ref(OldLval, NewLval, MemRef0, MemRef, !N) :-
 	(
 		MemRef0 = stackvar_ref(_SlotNum),
-		MemRef = MemRef0,
-		N = N0
+		MemRef = MemRef0
 	;
 		MemRef0 = framevar_ref(_SlotNum),
-		MemRef = MemRef0,
-		N = N0
+		MemRef = MemRef0
 	;
 		MemRef0 = heap_ref(Rval0, Tag, FieldNum),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		MemRef = heap_ref(Rval, Tag, FieldNum)
 	).
 
 :- pred exprn_aux__substitute_lval_in_lval_count(lval::in, lval::in,
 	lval::in, lval::out, int::in, int::out) is det.
 
-exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval, Lval0, Lval,
-		N0, N) :-
+exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval, Lval0, Lval, !N) :-
 	( Lval0 = OldLval ->
 		Lval = NewLval,
-		N = N0 + 1
+		!:N = !.N + 1
 	;
 		exprn_aux__substitute_lval_in_lval_count_2(OldLval, NewLval,
-			Lval0, Lval, N0, N)
+			Lval0, Lval, !N)
 	).
 
 :- pred exprn_aux__substitute_lval_in_lval_count_2(lval::in, lval::in,
 	lval::in, lval::out, int::in, int::out) is det.
 
 exprn_aux__substitute_lval_in_lval_count_2(OldLval, NewLval, Lval0, Lval,
-		N0, N) :-
+		!N) :-
 	(
 		Lval0 = reg(_Type, _RegNum),
-		Lval = Lval0,
-		N = N0
+		Lval = Lval0
 	;
 		Lval0 = succip,
-		Lval = succip,
-		N = N0
+		Lval = succip
 	;
 		Lval0 = maxfr,
-		Lval = maxfr,
-		N = N0
+		Lval = maxfr
 	;
 		Lval0 = curfr,
-		Lval = curfr,
-		N = N0
+		Lval = curfr
 	;
 		Lval0 = hp,
-		Lval = hp,
-		N = N0
+		Lval = hp
 	;
 		Lval0 = sp,
-		Lval = sp,
-		N = N0
+		Lval = sp
 	;
 		Lval0 = temp(_Type, _TmpNum),
-		Lval = Lval0,
-		N = N0
+		Lval = Lval0
 	;
 		Lval0 = stackvar(_SlotNum),
-		Lval = Lval0,
-		N = N0
+		Lval = Lval0
 	;
 		Lval0 = framevar(_SlotNum),
-		Lval = Lval0,
-		N = N0
+		Lval = Lval0
 	;
 		Lval0 = succip(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Lval = succip(Rval)
 	;
 		Lval0 = redoip(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Lval = redoip(Rval)
 	;
 		Lval0 = redofr(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Lval = redofr(Rval)
 	;
 		Lval0 = succfr(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Lval = succfr(Rval)
 	;
 		Lval0 = prevfr(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Lval = prevfr(Rval)
 	;
 		Lval0 = field(Tag, Rval1, Rval2),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval1, Rval3, N0, N1),
+			Rval1, Rval3, !N),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval2, Rval4, N1, N),
+			Rval2, Rval4, !N),
 		Lval = field(Tag, Rval3, Rval4)
 	;
 		Lval0 = mem_ref(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
+			Rval0, Rval, !N),
 		Lval = mem_ref(Rval)
 	;
 		Lval0 = lvar(_Var),
-		Lval = Lval0,
-		N = N0
+		Lval = Lval0
 	).
 
 :- pred exprn_aux__substitute_lval_in_args(lval::in, lval::in,
 	list(maybe(rval))::in, list(maybe(rval))::out, int::in, int::out)
 	is det.
 
-exprn_aux__substitute_lval_in_args(_OldLval, _NewLval, [], [], N, N).
+exprn_aux__substitute_lval_in_args(_OldLval, _NewLval, [], [], !N).
 exprn_aux__substitute_lval_in_args(OldLval, NewLval, [M0 | Ms0], [M | Ms],
-		N0, N) :-
-	exprn_aux__substitute_lval_in_arg(OldLval, NewLval, M0, M, N0, N1),
-	exprn_aux__substitute_lval_in_args(OldLval, NewLval, Ms0, Ms, N1, N).
+		!N) :-
+	exprn_aux__substitute_lval_in_arg(OldLval, NewLval, M0, M, !N),
+	exprn_aux__substitute_lval_in_args(OldLval, NewLval, Ms0, Ms, !N).
 
 :- pred exprn_aux__substitute_lval_in_arg(lval::in, lval::in,
 	maybe(rval)::in, maybe(rval)::out, int::in, int::out) is det.
 
-exprn_aux__substitute_lval_in_arg(OldLval, NewLval, M0, M, N0, N) :-
-	( M0 = yes(Rval0) ->
+exprn_aux__substitute_lval_in_arg(OldLval, NewLval, MaybeRval0, MaybeRval,
+		!N) :-
+	(
+		MaybeRval0 = yes(Rval0),
 		exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval,
-			Rval0, Rval, N0, N),
-		M = yes(Rval)
+			Rval0, Rval, !N),
+		MaybeRval = yes(Rval)
 	;
-		M = M0,
-		N = N0
+		MaybeRval0 = no,
+		MaybeRval = MaybeRval0
 	).
 
 exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval) :-
@@ -883,23 +855,23 @@
 :- pred exprn_aux__substitute_rval_in_arg(rval::in, rval::in,
 	maybe(rval)::in, maybe(rval)::out) is det.
 
-exprn_aux__substitute_rval_in_arg(OldRval, NewRval, M0, M) :-
+exprn_aux__substitute_rval_in_arg(OldRval, NewRval, MaybeRval0, MaybeRval) :-
 	(
-		M0 = yes(Rval0)
-	->
+		MaybeRval0 = yes(Rval0),
 		exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
 			Rval0, Rval),
-		M = yes(Rval)
+		MaybeRval = yes(Rval)
 	;
-		M = M0
+		MaybeRval0 = no,
+		MaybeRval = MaybeRval0
 	).
 
 %------------------------------------------------------------------------------%
 
-exprn_aux__substitute_vars_in_rval([], Rval, Rval).
-exprn_aux__substitute_vars_in_rval([Var - Sub | Rest], Rval0, Rval) :-
-	exprn_aux__substitute_rval_in_rval(var(Var), Sub, Rval0, Rval1),
-	exprn_aux__substitute_vars_in_rval(Rest, Rval1, Rval).
+exprn_aux__substitute_vars_in_rval([], !Rval).
+exprn_aux__substitute_vars_in_rval([Var - Sub | Rest], !Rval) :-
+	exprn_aux__substitute_rval_in_rval(var(Var), Sub, !Rval),
+	exprn_aux__substitute_vars_in_rval(Rest, !Rval).
 
 % When we substitute one set of rvals for another, we face the problem
 % that the substitution may not be idempotent. We finesse this problem by
@@ -907,11 +879,11 @@
 % the replacement rvals for these unique rvals. We guarantee the uniqueness
 % of these rvals by using framevars with negative numbers for them.
 
-exprn_aux__substitute_rvals_in_rval(RvalPairs, Rval0, Rval) :-
+exprn_aux__substitute_rvals_in_rval(RvalPairs, !Rval) :-
 	exprn_aux__substitute_rvals_in_rval_1(RvalPairs, 0,
 		RvalUniqPairs, UniqRvalPairs),
-	exprn_aux__substitute_rvals_in_rval_2(RvalUniqPairs, Rval0, Rval1),
-	exprn_aux__substitute_rvals_in_rval_2(UniqRvalPairs, Rval1, Rval).
+	exprn_aux__substitute_rvals_in_rval_2(RvalUniqPairs, !Rval),
+	exprn_aux__substitute_rvals_in_rval_2(UniqRvalPairs, !Rval).
 
 :- pred exprn_aux__substitute_rvals_in_rval_1(assoc_list(rval, rval)::in,
 	int::in, assoc_list(rval, rval)::out, assoc_list(rval, rval)::out)
@@ -928,17 +900,15 @@
 :- pred exprn_aux__substitute_rvals_in_rval_2(assoc_list(rval, rval)::in,
 	rval::in, rval::out) is det.
 
-exprn_aux__substitute_rvals_in_rval_2([], Rval, Rval).
-exprn_aux__substitute_rvals_in_rval_2([Left - Right | Rest], Rval0, Rval2) :-
-	exprn_aux__substitute_rval_in_rval(Left, Right, Rval0, Rval1),
-	exprn_aux__substitute_rvals_in_rval_2(Rest, Rval1, Rval2).
+exprn_aux__substitute_rvals_in_rval_2([], !Rval).
+exprn_aux__substitute_rvals_in_rval_2([Left - Right | Rest], !Rval) :-
+	exprn_aux__substitute_rval_in_rval(Left, Right, !Rval),
+	exprn_aux__substitute_rvals_in_rval_2(Rest, !Rval).
 
 %---------------------------------------------------------------------------%
 
 exprn_aux__simplify_rval(Rval0, Rval) :-
-	(
-		exprn_aux__simplify_rval_2(Rval0, Rval1)
-	->
+	( exprn_aux__simplify_rval_2(Rval0, Rval1) ->
 		exprn_aux__simplify_rval(Rval1, Rval)
 	;
 		Rval = Rval0
@@ -981,14 +951,14 @@
 
 :- pred exprn_aux__simplify_arg(maybe(rval)::in, maybe(rval)::out) is det.
 
-exprn_aux__simplify_arg(MR0, MR) :-
+exprn_aux__simplify_arg(MaybeRval0, MaybeRval) :-
 	(
-		MR0 = yes(Rval0),
+		MaybeRval0 = yes(Rval0),
 		exprn_aux__simplify_rval_2(Rval0, Rval)
 	->
-		MR = yes(Rval)
+		MaybeRval = yes(Rval)
 	;
-		MR = MR0
+		MaybeRval = MaybeRval0
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.63
diff -u -r1.63 livemap.m
--- compiler/livemap.m	22 Mar 2005 06:40:03 -0000	1.63
+++ compiler/livemap.m	31 Mar 2005 11:50:03 -0000
@@ -213,7 +213,7 @@
 			true
 		)
 	;
-		Uinstr0 = incr_hp(Lval, _, _, Rval, _),
+		Uinstr0 = incr_hp(Lval, _, _, Rval, _, _),
 
 		% Make dead the variable assigned, but make any variables
 		% needed to access it live. Make the variables in the size
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.311
diff -u -r1.311 llds.m
--- compiler/llds.m	24 Mar 2005 13:33:33 -0000	1.311
+++ compiler/llds.m	31 Mar 2005 11:18:42 -0000
@@ -302,7 +302,7 @@
 	;	if_val(rval, code_addr)
 			% If rval is true, then goto code_addr.
 
-	;	incr_hp(lval, maybe(tag), maybe(int), rval, string)
+	;	incr_hp(lval, maybe(tag), maybe(int), rval, stubborn, string)
 			% Get a memory block of a size given by an rval
 			% and put its address in the given lval,
 			% possibly after incrementing it by N words
@@ -504,6 +504,10 @@
 			% in the current parallel conjunction, then branch to
 			% the given label. The synchronisation
 			% term is specified by the given lval.
+
+:- type stubborn
+	--->	stubborn
+	;	not_stubborn.
 
 :- type nondet_frame_info
 	--->	temp_frame(
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.248
diff -u -r1.248 llds_out.m
--- compiler/llds_out.m	22 Mar 2005 06:40:04 -0000	1.248
+++ compiler/llds_out.m	31 Mar 2005 12:15:53 -0000
@@ -1834,7 +1834,7 @@
 output_instr_decls(_, if_val(Rval, Target), !DeclSet, !IO) :-
 	output_rval_decls(Rval, !DeclSet, !IO),
 	output_code_addr_decls(Target, !DeclSet, !IO).
-output_instr_decls(_, incr_hp(Lval, _Tag, _, Rval, _), !DeclSet, !IO) :-
+output_instr_decls(_, incr_hp(Lval, _Tag, _, Rval, _, _), !DeclSet, !IO) :-
 	output_lval_decls(Lval, !DeclSet, !IO),
 	output_rval_decls(Rval, !DeclSet, !IO).
 output_instr_decls(_, mark_hp(Lval), !DeclSet, !IO) :-
@@ -2159,18 +2159,20 @@
 	output_goto(Target, CallerLabel, !IO),
 	io__write_string("\t}\n", !IO).
 
-output_instruction(incr_hp(Lval, MaybeTag, MaybeOffset, Rval, TypeMsg),
-		ProfInfo, !IO) :-
+output_instruction( incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Stubborn,
+		TypeMsg), ProfInfo, !IO) :-
 	globals__io_lookup_bool_option(profile_memory, ProfMem, !IO),
 	(
 		ProfMem = yes,
 		(
 			MaybeTag = no,
-			io__write_string("\tMR_offset_incr_hp_msg(", !IO),
+			io__write_string("\tMR_offset_incr_hp_msg", !IO),
+			output_stubborn_and_lparen(Stubborn, !IO),
 			output_lval_as_word(Lval, !IO)
 		;
 			MaybeTag = yes(Tag),
-			io__write_string("\tMR_tag_offset_incr_hp_msg(", !IO),
+			io__write_string("\tMR_tag_offset_incr_hp_msg", !IO),
+			output_stubborn_and_lparen(Stubborn, !IO),
 			output_lval_as_word(Lval, !IO),
 			io__write_string(", ", !IO),
 			output_tag(Tag, !IO)
@@ -2197,24 +2199,27 @@
 			MaybeTag = no,
 			(
 				MaybeOffset = yes(_),
-				io__write_string("\tMR_offset_incr_hp(", !IO)
+				io__write_string("\tMR_offset_incr_hp", !IO)
 			;
 				MaybeOffset = no,
-				io__write_string("\tMR_alloc_heap(", !IO)
+				io__write_string("\tMR_alloc_heap", !IO)
 			),
+			output_stubborn_and_lparen(Stubborn, !IO),
 			output_lval_as_word(Lval, !IO)
 		;
 			MaybeTag = yes(Tag),
 			(
 				MaybeOffset = yes(_),
-				io__write_string("\tMR_tag_offset_incr_hp(",
+				io__write_string("\tMR_tag_offset_incr_hp",
 					!IO),
+				output_stubborn_and_lparen(Stubborn, !IO),
 				output_lval_as_word(Lval, !IO),
 				io__write_string(", ", !IO),
 				output_tag(Tag, !IO)
 			;
 				MaybeOffset = no,
-				io__write_string("\tMR_tag_alloc_heap(", !IO),
+				io__write_string("\tMR_tag_alloc_heap", !IO),
+				output_stubborn_and_lparen(Stubborn, !IO),
 				output_lval_as_word(Lval, !IO),
 				io__write_string(", ", !IO),
 				io__write_int(Tag, !IO)
@@ -2325,6 +2330,13 @@
 	io__write_string(", ", !IO),
 	output_label_as_code_addr(Label, !IO),
 	io__write_string(");\n", !IO).
+
+:- pred output_stubborn_and_lparen(stubborn::in, io::di, io::uo) is det.
+
+output_stubborn_and_lparen(not_stubborn, !IO) :-
+	io__write_string("(", !IO).
+output_stubborn_and_lparen(stubborn, !IO) :-
+	io__write_string("_stubborn(", !IO).
 
 :- pred output_pragma_c_component(pragma_c_component::in, io::di, io::uo)
 	is det.
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.103
diff -u -r1.103 middle_rec.m
--- compiler/middle_rec.m	20 Mar 2005 02:24:35 -0000	1.103
+++ compiler/middle_rec.m	31 Mar 2005 11:50:45 -0000
@@ -418,7 +418,8 @@
 middle_rec__find_used_registers_instr(c_code(_, _), !Used).
 middle_rec__find_used_registers_instr(if_val(Rval, _), !Used) :-
 	middle_rec__find_used_registers_rval(Rval, !Used).
-middle_rec__find_used_registers_instr(incr_hp(Lval, _, _, Rval, _), !Used) :-
+middle_rec__find_used_registers_instr(incr_hp(Lval, _, _, Rval, _, _),
+		!Used) :-
 	middle_rec__find_used_registers_lval(Lval, !Used),
 	middle_rec__find_used_registers_rval(Rval, !Used).
 middle_rec__find_used_registers_instr(mark_hp(Lval), !Used) :-
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.150
diff -u -r1.150 opt_debug.m
--- compiler/opt_debug.m	31 Mar 2005 04:44:21 -0000	1.150
+++ compiler/opt_debug.m	31 Mar 2005 11:51:49 -0000
@@ -762,7 +762,7 @@
 	dump_rval(Rval, R_str),
 	dump_code_addr(CodeAddr, C_str),
 	string__append_list(["if_val(", R_str, ", ", C_str, ")"], Str).
-dump_instr(incr_hp(Lval, MaybeTag, MaybeOffset, Size, _), Str) :-
+dump_instr(incr_hp(Lval, MaybeTag, MaybeOffset, Size, Stubborn, _), Str) :-
 	dump_lval(Lval, L_str),
 	(
 		MaybeTag = no,
@@ -778,9 +778,16 @@
 		MaybeOffset = yes(Offset),
 		string__int_to_string(Offset, O_str)
 	),
+	(
+		Stubborn = stubborn,
+		St_str = ", stubborn"
+	;
+		Stubborn = not_stubborn,
+		St_str = ""
+	),
 	dump_rval(Size, S_str),
 	string__append_list(["incr_hp(", L_str, ", ", T_str, ", ", O_str,
-		", ", S_str, ")"], Str).
+		", ", S_str, St_str, ")"], Str).
 dump_instr(mark_hp(Lval), Str) :-
 	dump_lval(Lval, L_str),
 	string__append_list(["mark_hp(", L_str, ")"], Str).
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.129
diff -u -r1.129 opt_util.m
--- compiler/opt_util.m	22 Mar 2005 06:40:15 -0000	1.129
+++ compiler/opt_util.m	31 Mar 2005 11:53:06 -0000
@@ -723,7 +723,7 @@
 			Between = [Instr0 | Between0]
 		)
 	;
-		Uinstr0 = incr_hp(Lval, _, _, Rval, _),
+		Uinstr0 = incr_hp(Lval, _, _, Rval, _, _),
 		lval_refers_stackvars(Lval, no),
 		rval_refers_stackvars(Rval, no),
 		no_stackvars_til_decr_sp(Instrs0, FrameSize,
@@ -788,7 +788,7 @@
 			Need = no
 		)
 	;
-		Uinstr0 = incr_hp(Lval, _, _, Rval, _),
+		Uinstr0 = incr_hp(Lval, _, _, Rval, _, _),
 		lval_refers_stackvars(Lval, Use1),
 		rval_refers_stackvars(Rval, Use2),
 		bool__or(Use1, Use2, Use),
@@ -967,7 +967,7 @@
 can_instr_branch_away(computed_goto(_, _), yes).
 can_instr_branch_away(c_code(_, _), no).
 can_instr_branch_away(if_val(_, _), yes).
-can_instr_branch_away(incr_hp(_, _, _, _, _), no).
+can_instr_branch_away(incr_hp(_, _, _, _, _, _), no).
 can_instr_branch_away(mark_hp(_), no).
 can_instr_branch_away(restore_hp(_), no).
 can_instr_branch_away(free_heap(_), no).
@@ -1034,7 +1034,7 @@
 can_instr_fall_through(computed_goto(_, _), no).
 can_instr_fall_through(c_code(_, _), yes).
 can_instr_fall_through(if_val(_, _), yes).
-can_instr_fall_through(incr_hp(_, _, _, _, _), yes).
+can_instr_fall_through(incr_hp(_, _, _, _, _, _), yes).
 can_instr_fall_through(mark_hp(_), yes).
 can_instr_fall_through(restore_hp(_), yes).
 can_instr_fall_through(free_heap(_), yes).
@@ -1078,7 +1078,7 @@
 can_use_livevals(computed_goto(_, _), no).
 can_use_livevals(c_code(_, _), no).
 can_use_livevals(if_val(_, _), yes).
-can_use_livevals(incr_hp(_, _, _, _, _), no).
+can_use_livevals(incr_hp(_, _, _, _, _, _), no).
 can_use_livevals(mark_hp(_), no).
 can_use_livevals(restore_hp(_), no).
 can_use_livevals(free_heap(_), no).
@@ -1141,7 +1141,7 @@
 instr_labels_2(computed_goto(_, Labels), Labels, []).
 instr_labels_2(c_code(_, _), [], []).
 instr_labels_2(if_val(_, Addr), [], [Addr]).
-instr_labels_2(incr_hp(_, _, _, _, _), [], []).
+instr_labels_2(incr_hp(_, _, _, _, _, _), [], []).
 instr_labels_2(mark_hp(_), [], []).
 instr_labels_2(restore_hp(_), [], []).
 instr_labels_2(free_heap(_), [], []).
@@ -1189,7 +1189,7 @@
 	;
 		Targets = []
 	).
-possible_targets(incr_hp(_, _, _, _, _), []).
+possible_targets(incr_hp(_, _, _, _, _, _), []).
 possible_targets(mark_hp(_), []).
 possible_targets(restore_hp(_), []).
 possible_targets(free_heap(_), []).
@@ -1253,7 +1253,7 @@
 instr_rvals_and_lvals(computed_goto(Rval, _), [Rval], []).
 instr_rvals_and_lvals(c_code(_, _), [], []).
 instr_rvals_and_lvals(if_val(Rval, _), [Rval], []).
-instr_rvals_and_lvals(incr_hp(Lval, _, _, Rval, _), [Rval], [Lval]).
+instr_rvals_and_lvals(incr_hp(Lval, _, _, Rval, _, _), [Rval], [Lval]).
 instr_rvals_and_lvals(mark_hp(Lval), [], [Lval]).
 instr_rvals_and_lvals(restore_hp(Rval), [Rval], []).
 instr_rvals_and_lvals(free_heap(Rval), [Rval], []).
@@ -1382,7 +1382,7 @@
 count_temps_instr(if_val(Rval, _), !R, !F) :-
 	count_temps_rval(Rval, !R, !F).
 count_temps_instr(c_code(_, _), !R, !F).
-count_temps_instr(incr_hp(Lval, _, _, Rval, _), !R, !F) :-
+count_temps_instr(incr_hp(Lval, _, _, Rval, _, _), !R, !F) :-
 	count_temps_lval(Lval, !R, !F),
 	count_temps_rval(Rval, !R, !F).
 count_temps_instr(mark_hp(Lval), !R, !F) :-
@@ -1498,7 +1498,7 @@
 		touches_nondet_ctrl_lval(Lval, TouchLval),
 		touches_nondet_ctrl_rval(Rval, TouchRval),
 		bool__or(TouchLval, TouchRval, Touch)
-	; Uinstr = incr_hp(Lval, _, _, Rval, _) ->
+	; Uinstr = incr_hp(Lval, _, _, Rval, _, _) ->
 		touches_nondet_ctrl_lval(Lval, TouchLval),
 		touches_nondet_ctrl_rval(Rval, TouchRval),
 		bool__or(TouchLval, TouchRval, Touch)
@@ -1636,14 +1636,14 @@
 
 :- pred count_incr_hp_2(list(instruction)::in, int::in, int::out) is det.
 
-count_incr_hp_2([], N, N).
-count_incr_hp_2([Uinstr0 - _ | Instrs], N0, N) :-
-	( Uinstr0 = incr_hp(_, _, _, _, _) ->
-		N1 = N0 + 1
+count_incr_hp_2([], !N).
+count_incr_hp_2([Uinstr0 - _ | Instrs], !N) :-
+	( Uinstr0 = incr_hp(_, _, _, _, _, _) ->
+		!:N = !.N + 1
 	;
-		N1 = N0
+		true
 	),
-	count_incr_hp_2(Instrs, N1, N).
+	count_incr_hp_2(Instrs, !N).
 
 %-----------------------------------------------------------------------------%
 
@@ -1761,8 +1761,9 @@
 		Rval = Rval0
 	),
 	replace_labels_code_addr(Target0, ReplMap, Target).
-replace_labels_instr(incr_hp(Lval0, MaybeTag, MO, Rval0, Msg),
-		ReplMap, ReplData, incr_hp(Lval, MaybeTag, MO, Rval, Msg)) :-
+replace_labels_instr(incr_hp(Lval0, MaybeTag, MO, Rval0, Stubborn, Msg),
+		ReplMap, ReplData,
+		incr_hp(Lval, MaybeTag, MO, Rval, Stubborn, Msg)) :-
 	(
 		ReplData = yes,
 		replace_labels_lval(Lval0, ReplMap, Lval),
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.18
diff -u -r1.18 par_conj_gen.m
--- compiler/par_conj_gen.m	22 Mar 2005 06:40:16 -0000	1.18
+++ compiler/par_conj_gen.m	31 Mar 2005 11:54:37 -0000
@@ -165,7 +165,7 @@
 		assign(SpSlot, lval(sp))
 			- "save the parent stack pointer",
 		incr_hp(RegLval, no, no, const(int_const(STSize)),
-			"synchronization vector")
+			not_stubborn, "synchronization vector")
 			- "allocate a synchronization vector",
 		init_sync_term(RegLval, NumGoals)
 			- "initialize sync term",
@@ -181,10 +181,9 @@
 	code_info__clear_all_registers(no, !CI),
 	par_conj_gen__place_all_outputs(Outputs, !CI).
 
-:- pred par_conj_gen__generate_det_par_conj_2(list(hlds_goal), int, lval, lval,
-		instmap, branch_end, code_tree, code_info, code_info).
-:- mode par_conj_gen__generate_det_par_conj_2(in, in, in, in,
-		in, in, out, in, out) is det.
+:- pred par_conj_gen__generate_det_par_conj_2(list(hlds_goal)::in, int::in,
+	lval::in, lval::in, instmap::in, branch_end::in, code_tree::out,
+	code_info::in, code_info::out) is det.
 
 par_conj_gen__generate_det_par_conj_2([], _N, _SyncTerm, _SpSlot, _Initial,
 		_, empty, !CI).
@@ -209,8 +208,7 @@
 			[], TheseOutputs),
 	par_conj_gen__copy_outputs(!.CI, TheseOutputs, SpSlot, CopyCode),
 	(
-		Goals = [_ | _]
-	->
+		Goals = [_ | _],
 		code_info__reset_to_position(StartPos, !CI),
 		code_info__get_total_stackslot_count(!.CI, NumSlots),
 		ForkCode = node([
@@ -226,6 +224,7 @@
 				- "start of the next conjunct"
 		])
 	;
+		Goals = [],
 		code_info__get_next_label(ContLab, !CI),
 		ForkCode = empty,
 		JoinCode = node([
@@ -239,8 +238,7 @@
 		ForkCode,
 		tree(ThisGoalCode, tree(tree(SaveCode, CopyCode), JoinCode))
 	),
-	N1 = N + 1,
-	par_conj_gen__generate_det_par_conj_2(Goals, N1, SyncTerm, SpSlot,
+	par_conj_gen__generate_det_par_conj_2(Goals, N + 1, SyncTerm, SpSlot,
 		Initial, MaybeEnd, RestCode, !CI),
 	Code = tree(ThisCode, RestCode).
 
Index: compiler/reassign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/reassign.m,v
retrieving revision 1.10
diff -u -r1.10 reassign.m
--- compiler/reassign.m	22 Mar 2005 06:40:21 -0000	1.10
+++ compiler/reassign.m	31 Mar 2005 11:54:44 -0000
@@ -225,7 +225,7 @@
 		KnownContentsMap = KnownContentsMap0,
 		DepLvalMap = DepLvalMap0
 	;
-		Uinstr0 = incr_hp(Target, _, _, _, _),
+		Uinstr0 = incr_hp(Target, _, _, _, _, _),
 		RevInstrs1 = [Instr0 | RevInstrs0],
 		clobber_dependents(Target,
 			KnownContentsMap0, KnownContentsMap1,
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.148
diff -u -r1.148 unify_gen.m
--- compiler/unify_gen.m	22 Mar 2005 06:40:30 -0000	1.148
+++ compiler/unify_gen.m	31 Mar 2005 12:46:51 -0000
@@ -44,6 +44,7 @@
 :- import_module backend_libs__proc_label.
 :- import_module backend_libs__rtti.
 :- import_module backend_libs__type_class_info.
+:- import_module check_hlds__inst_match.
 :- import_module check_hlds__mode_util.
 :- import_module check_hlds__type_util.
 :- import_module hlds__arg_info.
@@ -51,6 +52,7 @@
 :- import_module hlds__hlds_module.
 :- import_module hlds__hlds_out.
 :- import_module hlds__hlds_pred.
+:- import_module hlds__instmap.
 :- import_module libs__globals.
 :- import_module libs__options.
 :- import_module libs__tree.
@@ -59,11 +61,11 @@
 :- import_module ll_backend__continuation_info.
 :- import_module ll_backend__layout.
 :- import_module ll_backend__stack_layout.
+:- import_module mdbcomp__prim_data.
 :- import_module parse_tree__error_util.
 :- import_module parse_tree__prog_data.
 :- import_module parse_tree__prog_out.
 :- import_module parse_tree__prog_type.
-:- import_module mdbcomp__prim_data.
 
 :- import_module bool.
 :- import_module int.
@@ -365,7 +367,10 @@
 	code_info__assign_const_to_var(Var, const(float_const(Float)), !CI).
 unify_gen__generate_construction_2(no_tag, Var, Args, Modes, _, _, Code,
 		!CI) :-
-	( Args = [Arg], Modes = [Mode] ->
+	(
+		Args = [Arg],
+		Modes = [Mode]
+	->
 		Type = code_info__variable_type(!.CI, Arg),
 		unify_gen__generate_sub_unify(ref(Var), ref(Arg),
 			Mode, Type, Code, !CI)
@@ -384,7 +389,9 @@
 	unify_gen__var_types(!.CI, Args, ArgTypes),
 	unify_gen__generate_cons_args(Args, ArgTypes, Modes, ModuleInfo,
 		Rvals),
-	unify_gen__construct_cell(Var, Ptag, Rvals, Size, Code, !CI).
+	code_info__get_instmap(!.CI, InstMap),
+	unify_gen__compute_stubbornness(ModuleInfo, InstMap, Args, Stubborn),
+	unify_gen__construct_cell(Var, Ptag, Rvals, Size, Stubborn, Code, !CI).
 unify_gen__generate_construction_2(shared_remote_tag(Ptag, Sectag),
 		Var, Args, Modes, Size, _, Code, !CI) :-
 	code_info__get_module_info(!.CI, ModuleInfo),
@@ -393,16 +400,19 @@
 		Rvals0),
 		% the first field holds the secondary tag
 	Rvals = [yes(const(int_const(Sectag))) | Rvals0],
-	unify_gen__construct_cell(Var, Ptag, Rvals, Size, Code, !CI).
+	code_info__get_instmap(!.CI, InstMap),
+	unify_gen__compute_stubbornness(ModuleInfo, InstMap, Args, Stubborn),
+	unify_gen__construct_cell(Var, Ptag, Rvals, Size, Stubborn, Code, !CI).
 unify_gen__generate_construction_2(shared_local_tag(Bits1, Num1),
 		Var, _Args, _Modes, _, _, empty, !CI) :-
 	code_info__assign_const_to_var(Var,
 		mkword(Bits1, unop(mkbody, const(int_const(Num1)))), !CI).
 unify_gen__generate_construction_2(type_ctor_info_constant(ModuleName,
 		TypeName, TypeArity), Var, Args, _Modes, _, _, empty, !CI) :-
-	( Args = [] ->
-		true
+	(
+		Args = []
 	;
+		Args = [_ | _],
 		error("unify_gen: type-info constant has args")
 	),
 	RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
@@ -411,9 +421,10 @@
 		const(data_addr_const(DataAddr, no)), !CI).
 unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
 		ClassId, Instance), Var, Args, _Modes, _, _, empty, !CI) :-
-	( Args = [] ->
-		true
+	(
+		Args = []
 	;
+		Args = [_ | _],
 		error("unify_gen: typeclass-info constant has args")
 	),
 	TCName = generate_class_name(ClassId),
@@ -423,9 +434,10 @@
 			no)), !CI).
 unify_gen__generate_construction_2(tabling_pointer_constant(PredId, ProcId),
 		Var, Args, _Modes, _, _, empty, !CI) :-
-	( Args = [] ->
-		true
+	(
+		Args = []
 	;
+		Args = [_ | _],
 		error("unify_gen: tabling pointer constant has args")
 	),
 	code_info__get_module_info(!.CI, ModuleInfo),
@@ -437,9 +449,10 @@
 unify_gen__generate_construction_2(
 		deep_profiling_proc_layout_tag(PredId, ProcId),
 		Var, Args, _Modes, _, _, empty, !CI) :-
-	( Args = [] ->
-		true
+	(
+		Args = []
 	;
+		Args = [_ | _],
 		error("unify_gen: deep_profiling_proc_static has args")
 	),
 	code_info__get_module_info(!.CI, ModuleInfo),
@@ -456,9 +469,10 @@
 		const(data_addr_const(DataAddr, no)), !CI).
 unify_gen__generate_construction_2(table_io_decl_tag(PredId, ProcId),
 		Var, Args, _Modes, _, _, empty, !CI) :-
-	( Args = [] ->
-		true
+	(
+		Args = []
 	;
+		Args = [_ | _],
 		error("unify_gen: table_io_decl has args")
 	),
 	code_info__get_module_info(!.CI, ModuleInfo),
@@ -468,9 +482,10 @@
 		const(data_addr_const(DataAddr, no)), !CI).
 unify_gen__generate_construction_2(reserved_address(RA),
 		Var, Args, _Modes, _, _, empty, !CI) :-
-	( Args = [] ->
-		true
+	(
+		Args = []
 	;
+		Args = [_ | _],
 		error("unify_gen: reserved_address constant has args")
 	),
 	code_info__assign_const_to_var(Var,
@@ -573,7 +588,8 @@
 					- "get number of arguments",
 				incr_hp(NewClosure, no, no,
 					binop(+, lval(NumOldArgs),
-					NumNewArgsPlusThree_Rval), "closure")
+					NumNewArgsPlusThree_Rval),
+					stubborn, "closure")
 					- "allocate new closure",
 				assign(field(yes(0), lval(NewClosure), Zero),
 					lval(field(yes(0), OldClosure, Zero)))
@@ -688,7 +704,7 @@
 			| PredArgs
 		],
 		code_info__assign_cell_to_var(Var, no, 0, Vector, no,
-			"closure", Code, !CI)
+			stubborn, "closure", Code, !CI)
 	).
 
 :- pred unify_gen__generate_extra_closure_args(list(prog_var)::in, lval::in,
@@ -762,11 +778,24 @@
 	unify_gen__generate_cons_args_2(Vars, Types, UniModes, ModuleInfo,
 		RVals).
 
+:- pred unify_gen__compute_stubbornness(module_info::in, instmap::in,
+	list(prog_var)::in, stubborn::out) is det.
+
+unify_gen__compute_stubbornness(_ModuleInfo, _InstMap, [], stubborn).
+unify_gen__compute_stubbornness(ModuleInfo, InstMap, [Var | Vars], Stubborn) :-
+	instmap__lookup_var(InstMap, Var, Inst),
+	( inst_is_ground(ModuleInfo, Inst) ->
+		unify_gen__compute_stubbornness(ModuleInfo, InstMap, Vars,
+			Stubborn)
+	;
+		Stubborn = not_stubborn
+	).
+
 :- pred unify_gen__construct_cell(prog_var::in, tag::in, list(maybe(rval))::in,
-	maybe(term_size_value)::in, code_tree::out,
+	maybe(term_size_value)::in, stubborn::in, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-unify_gen__construct_cell(Var, Ptag, Rvals, Size, Code, !CI) :-
+unify_gen__construct_cell(Var, Ptag, Rvals, Size, Stubborn, Code, !CI) :-
 	VarType = code_info__variable_type(!.CI, Var),
 	unify_gen__var_type_msg(VarType, VarTypeMsg),
 	% If we're doing accurate GC, then for types which hold RTTI that
@@ -786,7 +815,7 @@
 		ReserveWordAtStart = no
 	),
 	code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Rvals,
-		Size, VarTypeMsg, Code, !CI).
+		Size, Stubborn, VarTypeMsg, Code, !CI).
 
 %---------------------------------------------------------------------------%
 
Index: compiler/use_local_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/use_local_vars.m,v
retrieving revision 1.12
diff -u -r1.12 use_local_vars.m
--- compiler/use_local_vars.m	22 Mar 2005 06:40:31 -0000	1.12
+++ compiler/use_local_vars.m	31 Mar 2005 11:56:45 -0000
@@ -212,8 +212,11 @@
 		MaybeEndLiveLvals) :-
 	Instr0 = Uinstr0 - _Comment0,
 	(
-		( Uinstr0 = assign(ToLval, _FromRval)
-		; Uinstr0 = incr_hp(ToLval, _MaybeTag, _SizeRval, _MO, _Type)
+		(
+			Uinstr0 = assign(ToLval, _FromRval)
+		;
+			Uinstr0 = incr_hp(ToLval, _MaybeTag, _SizeRval,
+				_MaybeOffset, _Stubborn, _Type)
 		),
 		base_lval_worth_replacing(NumRealRRegs, ToLval)
 	->
@@ -352,10 +355,11 @@
 		require(unify(ToLval, OldLval),
 			"substitute_lval_in_defn: mismatch in assign"),
 		Uinstr = assign(NewLval, FromRval)
-	; Uinstr0 = incr_hp(ToLval, MaybeTag, SizeRval, MO, Type) ->
+	; Uinstr0 = incr_hp(ToLval, MaybeTag, SizeRval, MO, Stubborn, Type) ->
 		require(unify(ToLval, OldLval),
 			"substitute_lval_in_defn: mismatch in incr_hp"),
-		Uinstr = incr_hp(NewLval, MaybeTag, SizeRval, MO, Type)
+		Uinstr = incr_hp(NewLval, MaybeTag, SizeRval, MO, Stubborn,
+			Type)
 	;
 		error("substitute_lval_in_defn: unexpected instruction")
 	),
@@ -443,7 +447,7 @@
 		exprn_aux__substitute_lval_in_instr(OldLval, NewLval,
 			!Instr, !N)
 	;
-		Uinstr0 = incr_hp(Lval, _, _, _, _),
+		Uinstr0 = incr_hp(Lval, _, _, _, _, _),
 		( Lval = OldLval ->
 			% If we alter any lval that occurs in OldLval,
 			% we must stop the substitutions. At the
Index: compiler/var_locn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/var_locn.m,v
retrieving revision 1.24
diff -u -r1.24 var_locn.m
--- compiler/var_locn.m	22 Mar 2005 06:40:32 -0000	1.24
+++ compiler/var_locn.m	31 Mar 2005 12:11:47 -0000
@@ -36,294 +36,330 @@
 
 :- type var_locn_info.
 
-%	init_state(Arguments, Liveness, VarSet, VarTypes, StackSlots,
-%			FollowVars, Opts, VarLocnInfo)
-%		Produces an initial state of the VarLocnInfo given
-%		an association list of variables and lvalues. The initial
-%		state places the given variables at their corresponding
-%		locations, with the exception of variables which are not in
-%		Liveness (this corresponds to input arguments that are not
-%		used in the body). The VarSet parameter contains a mapping from
-%		variables to names, which is used when code is generated
-%		to provide meaningful comments. VarTypes gives the types of
-%		of all the procedure's variables. StackSlots maps each variable
-%		to its stack slot, if it has one. FollowVars is the initial
-%		follow_vars set; such sets give guidance as to what lvals
-%		(if any) each variable will be needed in next. Opts gives
-%		the table of options; this is used to decide what expressions
-%		are considered constants.
-
+	% init_state(Arguments, Liveness, VarSet, VarTypes, StackSlots,
+	%	FollowVars, Opts, VarLocnInfo)
+	%
+	% Produces an initial state of the VarLocnInfo given
+	% an association list of variables and lvalues. The initial
+	% state places the given variables at their corresponding
+	% locations, with the exception of variables which are not in
+	% Liveness (this corresponds to input arguments that are not
+	% used in the body). The VarSet parameter contains a mapping from
+	% variables to names, which is used when code is generated
+	% to provide meaningful comments. VarTypes gives the types of
+	% of all the procedure's variables. StackSlots maps each variable
+	% to its stack slot, if it has one. FollowVars is the initial
+	% follow_vars set; such sets give guidance as to what lvals
+	% (if any) each variable will be needed in next. Opts gives
+	% the table of options; this is used to decide what expressions
+	% are considered constants.
+	%
 :- pred init_state(assoc_list(prog_var, lval)::in, set(prog_var)::in,
 	prog_varset::in, vartypes::in, stack_slots::in, abs_follow_vars::in,
 	option_table::in, var_locn_info::out) is det.
 
-%	reinit_state(VarLocs, !VarLocnInfo)
-%		Produces a new state of the VarLocnInfo in which the static
-%		and mostly static information (stack slot map, follow vars map,
-%		varset, option settings) comes from VarLocnInfo0 but the
-%		dynamic state regarding variable locations is thrown away
-%		and then rebuilt from the information in VarLocs, an
-%		association list of variables and lvals. The new state
-%		places the given variables at their corresponding locations.
-
+	% reinit_state(VarLocs, !VarLocnInfo)
+	%
+	% Produces a new state of the VarLocnInfo in which the static
+	% and mostly static information (stack slot map, follow vars map,
+	% varset, option settings) comes from VarLocnInfo0 but the
+	% dynamic state regarding variable locations is thrown away
+	% and then rebuilt from the information in VarLocs, an
+	% association list of variables and lvals. The new state
+	% places the given variables at their corresponding locations.
+	%
 :- pred reinit_state(assoc_list(prog_var, lval)::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	clobber_all_regs(OkToDeleteAny, !VarLocnInfo)
-%		Modifies the state VarLocnInfo0 to produce VarLocnInfo
-%		in which all variables stored in registers are clobbered.
-%		Aborts if this deletes the last record of the state of a
-%		variable unless OkToDeleteAny is `yes'.
-
+	% clobber_all_regs(OkToDeleteAny, !VarLocnInfo)
+	%
+	% Modifies the state VarLocnInfo0 to produce VarLocnInfo
+	% in which all variables stored in registers are clobbered.
+	% Aborts if this deletes the last record of the state of a
+	% variable unless OkToDeleteAny is `yes'.
+	%
 :- pred clobber_all_regs(bool::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	clobber_regs(Regs, !VarLocnInfo)
-%		Modifies the state VarLocnInfo0 to produce VarLocnInfo
-%		in which all variables stored in Regs (a list of lvals
-%		which should contain only registers) are clobbered.
-
+	% clobber_regs(Regs, !VarLocnInfo)
+	%
+	% Modifies the state VarLocnInfo0 to produce VarLocnInfo
+	% in which all variables stored in Regs (a list of lvals
+	% which should contain only registers) are clobbered.
+	%
 :- pred clobber_regs(list(lval)::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	set_magic_var_location(Var, Lval, !VarLocnInfo)
-%		Modifies VarLocnInfo0 to produce VarLocnInfo in which
-%		Var is *magically* stored in Lval. Does not care if Lval
-%		is already in use; it overwrites it with the new information.
-%		Used to implement the ends of erroneous branches.
-
+	% set_magic_var_location(Var, Lval, !VarLocnInfo)
+	%
+	% Modifies VarLocnInfo0 to produce VarLocnInfo in which
+	% Var is *magically* stored in Lval. Does not care if Lval
+	% is already in use; it overwrites it with the new information.
+	% Used to implement the ends of erroneous branches.
+	%
 :- pred set_magic_var_location(prog_var::in, lval::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	check_and_set_magic_var_location(Var, Lval, !VarLocnInfo)
-%		Modifies VarLocnInfo0 to produce VarLocnInfo in which
-%		Var is *magically* stored in Lval. (The caller usually
-%		generates code to perform this magic.) Aborts if Lval
-%		is already in use.
-
+	% check_and_set_magic_var_location(Var, Lval, !VarLocnInfo)
+	%
+	% Modifies VarLocnInfo0 to produce VarLocnInfo in which
+	% Var is *magically* stored in Lval. (The caller usually
+	% generates code to perform this magic.) Aborts if Lval
+	% is already in use.
+	%
 :- pred check_and_set_magic_var_location(prog_var::in, lval::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	lval_in_use(VarLocnInfo, Lval)
-%		Succeeds iff Lval, which should be a register or stack slot,
-%		holds (a path to) a variable or is otherwise reserved.
-
+	% lval_in_use(VarLocnInfo, Lval)
+	%
+	% Succeeds iff Lval, which should be a register or stack slot,
+	% holds (a path to) a variable or is otherwise reserved.
+	%
 :- pred lval_in_use(var_locn_info::in, lval::in) is semidet.
 
-%	var_becomes_dead(Var, FirstTime, !VarLocnInfo)
-%		Frees any code generator resources used by Var in VarLocnInfo0
-%		to produce VarLocnInfo. FirstTime should be no if this same
-%		operation may already have been executed on Var; otherwise,
-%		var_becomes_dead will throw an exception if it does
-%		not know about Var.
-
+	% var_becomes_dead(Var, FirstTime, !VarLocnInfo)
+	%
+	% Frees any code generator resources used by Var in VarLocnInfo0
+	% to produce VarLocnInfo. FirstTime should be no if this same
+	% operation may already have been executed on Var; otherwise,
+	% var_becomes_dead will throw an exception if it does
+	% not know about Var.
+	%
 :- pred var_becomes_dead(prog_var::in, bool::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	assign_var_to_var(Var, AssignedVar, !VarLocnInfo)
-%		Reflects the effect of the assignment Var := AssignedVar in the
-%		state of VarLocnInfo0 to yield VarLocnInfo.
-
+	% assign_var_to_var(Var, AssignedVar, !VarLocnInfo)
+	%
+	% Reflects the effect of the assignment Var := AssignedVar in the
+	% state of VarLocnInfo0 to yield VarLocnInfo.
+	%
 :- pred assign_var_to_var(prog_var::in, prog_var::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	assign_lval_to_var(Var, Lval, StaticCellInfo, Code, !VarLocnInfo)
-%		Reflects the effect of the assignment Var := lval(Lval) in the
-%		state of VarLocnInfo0 to yield VarLocnInfo; any code required
-%		to effect the assignment will be returned in Code.
-
+	% assign_lval_to_var(Var, Lval, StaticCellInfo, Code, !VarLocnInfo)
+	%
+	% Reflects the effect of the assignment Var := lval(Lval) in the
+	% state of VarLocnInfo0 to yield VarLocnInfo; any code required
+	% to effect the assignment will be returned in Code.
+	%
 :- pred assign_lval_to_var(prog_var::in, lval::in,
 	static_cell_info::in, code_tree::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	assign_const_to_var(Var, ConstRval, !VarLocnInfo)
-%		Reflects the effect of the assignment Var := const(ConstRval)
-%		in the state of VarLocnInfo0 to yield VarLocnInfo.
-
+	% assign_const_to_var(Var, ConstRval, !VarLocnInfo)
+	%
+	% Reflects the effect of the assignment Var := const(ConstRval)
+	% in the state of VarLocnInfo0 to yield VarLocnInfo.
+	%
 :- pred assign_const_to_var(prog_var::in, rval::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	assign_expr_to_var(Var, Rval, Code, !VarLocnInfo)
-%		Generates code to execute the assignment Var := Expr, and
-%		updates the state of VarLocnInfo0 accordingly.
-%
-%		Expr must contain no lvals, although it may (and typically
-%		will) refer to the values of other variables through rvals
-%		of the form var(_).
-
+	% assign_expr_to_var(Var, Rval, Code, !VarLocnInfo)
+	%
+	% Generates code to execute the assignment Var := Expr, and
+	% updates the state of VarLocnInfo0 accordingly.
+	%
+	% Expr must contain no lvals, although it may (and typically
+	% will) refer to the values of other variables through rvals
+	% of the form var(_).
+	%
 :- pred assign_expr_to_var(prog_var::in, rval::in, code_tree::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, SizeInfo,
-%			TypeMsg, Code, !StaticCellInfo, !VarLocnInfo)
-%		Generates code to assign to Var a pointer, tagged by Ptag, to
-%		the cell whose contents are given by the other arguments,
-%		and updates the state of VarLocnInfo0 accordingly.
-%		If ReserveWordAtStart is yes, and the cell is allocated on
-%		the heap (rather than statically), then reserve an extra
-%		word immediately before the allocated object, for the
-%		garbage collector to use to hold a forwarding pointer.
-%		If SizeInfo is yes(SizeVal), then reserve an extra word
-%		immediately before the allocated object (regardless
-%		of whether it is allocated statically or dynamically),
-%		and initialize this word with the value determined by
-%		SizeVal.
-%		NOTE: ReserveWordAtStart and SizeInfo should not both be
-%		yes / yes(_), because that will cause an obvious conflict!
-
+	% assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, SizeInfo,
+	%	Stubborn, TypeMsg, Code, !StaticCellInfo, !VarLocnInfo)
+	%
+	% Generates code to assign to Var a pointer, tagged by Ptag, to
+	% the cell whose contents are given by the other arguments,
+	% and updates the state of VarLocnInfo0 accordingly.
+	% Stubborn should be stubborn only if the contents of the cell are
+	% guaranteed not to change after being filled in, and if the
+	% filling-in process itself will be complete before the next cell
+	% is allocated.
+	% If ReserveWordAtStart is yes, and the cell is allocated on
+	% the heap (rather than statically), then reserve an extra
+	% word immediately before the allocated object, for the
+	% garbage collector to use to hold a forwarding pointer.
+	% If SizeInfo is yes(SizeVal), then reserve an extra word
+	% immediately before the allocated object (regardless
+	% of whether it is allocated statically or dynamically),
+	% and initialize this word with the value determined by
+	% SizeVal.
+	% NOTE: ReserveWordAtStart and SizeInfo should not both be
+	% yes / yes(_), because that will cause an obvious conflict!
+	%
 :- pred assign_cell_to_var(prog_var::in, bool::in, tag::in,
-	list(maybe(rval))::in, maybe(term_size_value)::in, string::in,
-	code_tree::out, static_cell_info::in, static_cell_info::out,
-	var_locn_info::in, var_locn_info::out) is det.
-
-%	place_var(Var, Lval, Code, !VarLocnInfo)
-%		Produces Code and a modified version of VarLocnInfo0,
-%		VarLocnInfo which places the value of Var in Lval.
+	list(maybe(rval))::in, maybe(term_size_value)::in, stubborn::in,
+	string::in, code_tree::out, static_cell_info::in,
+	static_cell_info::out, var_locn_info::in, var_locn_info::out) is det.
 
+	% place_var(Var, Lval, Code, !VarLocnInfo)
+	%
+	% Produces Code and a modified version of VarLocnInfo0,
+	% VarLocnInfo which places the value of Var in Lval.
+	%
 :- pred place_var(prog_var::in, lval::in, code_tree::out,
 		var_locn_info::in, var_locn_info::out) is det.
 
-%	place_vars(VarLocns, Code, !VarLocnInfo)
-%		Produces Code and a modified version of VarLocnInfo0,
-%		VarLocnInfo which places the value of each variable
-%		mentioned in VarLocns into the corresponding location.
-
+	% place_vars(VarLocns, Code, !VarLocnInfo)
+	%
+	% Produces Code and a modified version of VarLocnInfo0,
+	% VarLocnInfo which places the value of each variable
+	% mentioned in VarLocns into the corresponding location.
+	%
 :- pred place_vars(assoc_list(prog_var, lval)::in, code_tree::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	produce_var(Var, Rval, Code, !VarLocnInfo)
-%		Return the preferred way to refer to the value of Var
-%		(which may be a const rval, or the value in an lval).
-%
-% 		If Var is currently a cached expression, then produce_var
-%		will generate Code to evaluate the expression and put it
-%		into an lval. (Since the code generator can ask for a variable
-%		to be produced more than once, this is necessary to prevent
-%		the expression, which may involve a possibly large number
-%		of operations, from being evaluated several times.) Otherwise,
-%		Code will be empty.
-
+	% produce_var(Var, Rval, Code, !VarLocnInfo)
+	%
+	% Return the preferred way to refer to the value of Var
+	% (which may be a const rval, or the value in an lval).
+	%
+	% If Var is currently a cached expression, then produce_var
+	% will generate Code to evaluate the expression and put it
+	% into an lval. (Since the code generator can ask for a variable
+	% to be produced more than once, this is necessary to prevent
+	% the expression, which may involve a possibly large number
+	% of operations, from being evaluated several times.) Otherwise,
+	% Code will be empty.
+	%
 :- pred produce_var(prog_var::in, rval::out, code_tree::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	produce_var_in_reg(Var, Lval, Code, !VarLocnInfo)
-%		Produces a code fragment Code to evaluate Var if necessary
-%		and provide it as an Lval of the form reg(_).
-
+	% produce_var_in_reg(Var, Lval, Code, !VarLocnInfo)
+	%
+	% Produces a code fragment Code to evaluate Var if necessary
+	% and provide it as an Lval of the form reg(_).
+	%
 :- pred produce_var_in_reg(prog_var::in, lval::out, code_tree::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	produce_var_in_reg_or_stack(Var, FollowVars, Lval, Code, !VarLocnInfo)
-%		Produces a code fragment Code to evaluate Var if necessary
-%		and provide it as an Lval of the form reg(_), stackvar(_),
-%		or framevar(_).
-
+	% produce_var_in_reg_or_stack(Var, FollowVars, Lval, Code, !VarLocnInfo)
+	%
+	% Produces a code fragment Code to evaluate Var if necessary
+	% and provide it as an Lval of the form reg(_), stackvar(_),
+	% or framevar(_).
+	%
 :- pred produce_var_in_reg_or_stack(prog_var::in, lval::out,
 	code_tree::out, var_locn_info::in, var_locn_info::out) is det.
 
-%	acquire_reg(Lval, !VarLocnInfo)
-%		Finds an unused register and marks it as 'in use'.
-
+	% acquire_reg(Lval, !VarLocnInfo)
+	%
+	% Finds an unused register and marks it as 'in use'.
+	%
 :- pred acquire_reg(lval::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	acquire_reg_require_given(Reg, Lval, !VarLocInfo)
-%		Marks Reg, which must be an unused register, as 'in use'.
-
+	% acquire_reg_require_given(Reg, Lval, !VarLocInfo)
+	%
+	% Marks Reg, which must be an unused register, as 'in use'.
+	%
 :- pred acquire_reg_require_given(lval::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	acquire_reg_prefer_given(Pref, Lval, !VarLocInfo)
-%		Finds an unused register, and marks it as 'in use'.
-%		If Pref itself is free, assigns that.
-
+	% acquire_reg_prefer_given(Pref, Lval, !VarLocInfo)
+	%
+	% Finds an unused register, and marks it as 'in use'.
+	% If Pref itself is free, assigns that.
+	%
 :- pred acquire_reg_prefer_given(int::in, lval::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	acquire_reg_start_at_given(Start, Lval, !VarLocInfo)
-%		Finds an unused register, and marks it as 'in use'.
-%		It starts the search at the one numbered Start,
-%		continuing towards higher register numbers.
-
+	% acquire_reg_start_at_given(Start, Lval, !VarLocInfo)
+	%
+	% Finds an unused register, and marks it as 'in use'.
+	% It starts the search at the one numbered Start,
+	% continuing towards higher register numbers.
+	%
 :- pred acquire_reg_start_at_given(int::in, lval::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	release_reg(Lval, !VarLocnInfo)
-%		Marks a previously acquired reg as no longer 'in use'.
-
+	% release_reg(Lval, !VarLocnInfo)
+	%
+	% Marks a previously acquired reg as no longer 'in use'.
+	%
 :- pred release_reg(lval::in, var_locn_info::in, var_locn_info::out) is det.
 
-%	lock_regs(N, Exceptions, !VarLocnInfo)
-%		Prevents registers r1 through rN from being reused, even if
-%		there are no variables referring to them, with the exceptions
-%		of the registers named in Exceptions, which however can only be
-%		used to store their corresponding variables. Should be followed
-%		by a call to unlock_regs.
-
+	% lock_regs(N, Exceptions, !VarLocnInfo)
+	%
+	% Prevents registers r1 through rN from being reused, even if
+	% there are no variables referring to them, with the exceptions
+	% of the registers named in Exceptions, which however can only be
+	% used to store their corresponding variables. Should be followed
+	% by a call to unlock_regs.
+	%
 :- pred lock_regs(int::in, assoc_list(prog_var, lval)::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	unlock_regs(!VarLocnInfo)
-%		Undoes a lock operation.
-
+	% unlock_regs(!VarLocnInfo)
+	%
+	% Undoes a lock operation.
+	%
 :- pred unlock_regs(var_locn_info::in, var_locn_info::out) is det.
 
-%	clear_r1(Code)
-%		Produces a code fragment Code to move whatever is in r1
-%		to some other register, if r1 is live.  This is used
-%		prior to semidet pragma c_codes.
-
+	% clear_r1(Code)
+	%
+	% Produces a code fragment Code to move whatever is in r1
+	% to some other register, if r1 is live.  This is used
+	% prior to semidet pragma c_codes.
+	%
 :- pred clear_r1(code_tree::out, var_locn_info::in, var_locn_info::out) is det.
 
-%	materialize_vars_in_lval(Lval, FinalLval, Code,
-%			!VarLocnInfo)
-%		For every variable in Lval, substitutes the value of the
-%		variable and returns it as FinalLval. If we need to save the
-%		values of some of the substituted variables somewhere so as to
-%		prevent them from being evaluated again (and again ...), the
-%		required code will be returned in Code.
-
+	% materialize_vars_in_lval(Lval, FinalLval, Code, !VarLocnInfo)
+	%
+	% For every variable in Lval, substitutes the value of the
+	% variable and returns it as FinalLval. If we need to save the
+	% values of some of the substituted variables somewhere so as to
+	% prevent them from being evaluated again (and again ...), the
+	% required code will be returned in Code.
+	%
 :- pred materialize_vars_in_lval(lval::in, lval::out, code_tree::out,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	get_var_locations(VarLocnInfo, Locations)
-%		Returns a map from each live variable that occurs in
-%		VarLocnInfo to the set of locations in which it may be found
-%		(which may be empty, if the variable's value is either a known
-%		constant, or an as-yet unevaluated expression).
-
+	% get_var_locations(VarLocnInfo, Locations)
+	%
+	% Returns a map from each live variable that occurs in
+	% VarLocnInfo to the set of locations in which it may be found
+	% (which may be empty, if the variable's value is either a known
+	% constant, or an as-yet unevaluated expression).
+	%
 :- pred get_var_locations(var_locn_info::in, map(prog_var, set(lval))::out)
 	is det.
 
-%	get_stack_slots(VarLocnInfo, StackSlots)
-%		Returns the table mapping each variable to its stack slot
-%		(if any).
-
+	% get_stack_slots(VarLocnInfo, StackSlots)
+	%
+	% Returns the table mapping each variable to its stack slot
+	% (if any).
+	%
 :- pred get_stack_slots(var_locn_info::in, stack_slots::out) is det.
 
-%	get_follow_vars(VarLocnInfo, FollowVars)
-%		Returns the table mapping each variable to the lval (if any)
-%		where it is desired next.
-
+	% get_follow_vars(VarLocnInfo, FollowVars)
+	%
+	% Returns the table mapping each variable to the lval (if any)
+	% where it is desired next.
+	%
 :- pred get_follow_var_map(var_locn_info::in, abs_follow_vars_map::out) is det.
 
-%	get_next_non_reserved(VarLocnInfo, NonRes)
-%		Returns the number of the first register which is free for
-%		general use. It does not reserve the register.
-
+	% get_next_non_reserved(VarLocnInfo, NonRes)
+	%
+	% Returns the number of the first register which is free for
+	% general use. It does not reserve the register.
+	%
 :- pred get_next_non_reserved(var_locn_info::in, int::out) is det.
 
-%	set_follow_vars(FollowVars)
-%		Sets the table mapping each variable to the lval (if any)
-%		where it is desired next, and the number of the first
-%		non-reserved register.
-
+	% set_follow_vars(FollowVars)
+	%
+	% Sets the table mapping each variable to the lval (if any)
+	% where it is desired next, and the number of the first
+	% non-reserved register.
+	%
 :- pred set_follow_vars(abs_follow_vars::in,
 	var_locn_info::in, var_locn_info::out) is det.
 
-%	max_reg_in_use(MaxReg)
-%		Returns the number of the highest numbered rN register in use.
-
+	% max_reg_in_use(MaxReg)
+	%
+	% Returns the number of the highest numbered rN register in use.
+	%
 :- pred max_reg_in_use(var_locn_info::in, int::out) is det.
 
 %----------------------------------------------------------------------------%
@@ -780,7 +816,7 @@
 %----------------------------------------------------------------------------%
 
 assign_cell_to_var(Var, ReserveWordAtStart, Ptag, MaybeRvals0, SizeInfo,
-		TypeMsg, Code, !StaticCellInfo, !VLI) :-
+		Stubborn, TypeMsg, Code, !StaticCellInfo, !VLI) :-
 	(
 		SizeInfo = yes(SizeSource),
 		(
@@ -807,37 +843,42 @@
 		Code = empty
 	;
 		assign_dynamic_cell_to_var(Var, ReserveWordAtStart,
-			Ptag, MaybeRvals, MaybeOffset, TypeMsg, Code, !VLI)
+			Ptag, MaybeRvals, MaybeOffset, Stubborn, TypeMsg,
+			Code, !VLI)
 	).
 
 :- pred assign_dynamic_cell_to_var(prog_var::in, bool::in, tag::in,
-	list(maybe(rval))::in, maybe(int)::in, string::in, code_tree::out,
-	var_locn_info::in, var_locn_info::out) is det.
+	list(maybe(rval))::in, maybe(int)::in, stubborn::in, string::in,
+	code_tree::out, var_locn_info::in, var_locn_info::out) is det.
 
 assign_dynamic_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, MaybeOffset,
-		TypeMsg, Code, !VLI) :-
+		Stubborn, TypeMsg, Code, !VLI) :-
 	check_var_is_unknown(!.VLI, Var),
 
 	select_preferred_reg_or_stack_check(!.VLI, Var, Lval),
 	get_var_name(!.VLI, Var, VarName),
 	list__length(Vector, Size),
-	( ReserveWordAtStart = yes ->
-		( MaybeOffset = yes(_) ->
+	(
+		ReserveWordAtStart = yes,
+		(
+			MaybeOffset = yes(_),
 			% Accurate GC and term profiling both want to own
 			% the word before this object
 			sorry(this_file, "accurate GC combined with " ++
 				"term size profiling")
 		;
+			MaybeOffset = no,
 			TotalOffset = yes(1)
 		),
 		TotalSize = Size + 1
 	;
+		ReserveWordAtStart = no,
 		TotalOffset = MaybeOffset,
 		TotalSize = Size
 	),
 	CellCode = node([
 		incr_hp(Lval, yes(Ptag), TotalOffset,
-			const(int_const(TotalSize)), TypeMsg)
+			const(int_const(TotalSize)), Stubborn, TypeMsg)
 			- string__append("Allocating heap for ", VarName)
 	]),
 	set_magic_var_location(Var, Lval, !VLI),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_heap.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_heap.h,v
retrieving revision 1.34
diff -u -r1.34 mercury_heap.h
--- runtime/mercury_heap.h	15 Feb 2005 05:22:32 -0000	1.34
+++ runtime/mercury_heap.h	4 Apr 2005 15:16:22 -0000
@@ -53,6 +53,12 @@
 
 #endif /* MR_DEBUG_HEAP_ALLOC */
 
+#ifdef MR_ENABLE_STUBBORN
+  #define MR_GC_MALLOC_OUR_STUBBORN GC_MALLOC_STUBBORN_MERCURY
+#else
+  #define MR_GC_MALLOC_OUR_STUBBORN GC_MALLOC
+#endif
+
 #ifdef MR_CONSERVATIVE_GC
 
   #define MR_tag_offset_incr_hp_base(dest, tag, offset, count,		\
@@ -70,6 +76,9 @@
   #define MR_tag_offset_incr_hp_n(dest, tag, offset, count)		\
 	MR_tag_offset_incr_hp_base(dest, tag, offset, count,		\
 		GC_MALLOC, 0)
+  #define MR_tag_offset_incr_hp_n_stubborn(dest, tag, offset, count)	\
+	MR_tag_offset_incr_hp_base(dest, tag, offset, count,		\
+		MR_GC_MALLOC_OUR_STUBBORN, 0)
   #define MR_tag_offset_incr_hp_atomic(dest, tag, offset, count)	\
 	MR_tag_offset_incr_hp_base(dest, tag, offset, count,		\
 		GC_MALLOC_ATOMIC, 1)
@@ -117,11 +126,25 @@
 	  })								\
 	: MR_tag_offset_incr_hp_n((dest), (tag), (offset), (count))	\
 	)
+    #define MR_tag_offset_incr_hp_stubborn(dest, tag, offset, count)	\
+	( __builtin_constant_p(count) && (count) < 16			\
+	? ({	void * temp;						\
+		/* if size > 1, round up to an even number of words */	\
+		MR_Word num_words = ((count) == 1 ? 1 :			\
+			2 * (((count) + 1) / 2));			\
+		GC_MALLOC_WORDS(temp, num_words);			\
+		temp = (void *) (((MR_Word *) temp) + (offset));	\
+		(dest) = (MR_Word) MR_mkword((tag), temp);		\
+	  })								\
+	: MR_tag_offset_incr_hp_n_stubborn((dest), (tag), (offset), (count)) \
+	)
 
   #else /* not MR_INLINE_ALLOC */
 
     #define MR_tag_offset_incr_hp(dest, tag, offset, count)		\
 	MR_tag_offset_incr_hp_n((dest), (tag), (offset), (count))
+    #define MR_tag_offset_incr_hp_stubborn(dest, tag, offset, count)	\
+	MR_tag_offset_incr_hp_n_stubborn((dest), (tag), (offset), (count))
 
   #endif /* not MR_INLINE_ALLOC */
 
@@ -233,6 +256,12 @@
 		MR_maybe_record_allocation((count), proclabel, (type)),	\
 		MR_tag_offset_incr_hp((dest), (tag), (offset), (count))	\
 	)
+#define MR_tag_offset_incr_hp_msg_stubborn(dest, tag, offset, count, proclabel, type) \
+	(								\
+		MR_maybe_record_allocation((count), proclabel, (type)),	\
+		MR_tag_offset_incr_hp_stubborn((dest), (tag), (offset), \
+			(count))					\
+	)
 #define MR_tag_offset_incr_hp_atomic_msg(dest, tag, offset, count, proclabel, type) \
 	(								\
 		MR_maybe_record_allocation((count), proclabel, (type)),	\
@@ -241,11 +270,16 @@
 
 #define MR_tag_incr_hp(dest, tag, count)				\
 	MR_tag_offset_incr_hp((dest), (tag), 0, (count))
-#define MR_tag_incr_hp_atomic(dest, tag, count)				\
-	MR_tag_offset_incr_hp_atomic((dest), (tag), 0, (count))
+#define MR_tag_incr_hp_stubborn(dest, tag, count)			\
+	MR_tag_offset_incr_hp_stubborn((dest), (tag), 0, (count))
+#define MR_tag_incr_hp_msg_stubborn(dest, tag, count, proclabel, type)	\
+	MR_tag_offset_incr_hp_msg_stubborn((dest), (tag), 0, (count),	\
+		proclabel, (type))
 #define MR_tag_incr_hp_msg(dest, tag, count, proclabel, type)		\
 	MR_tag_offset_incr_hp_msg((dest), (tag), 0, (count),		\
 		proclabel, (type))
+#define MR_tag_incr_hp_atomic(dest, tag, count)				\
+	MR_tag_offset_incr_hp_atomic((dest), (tag), 0, (count))
 #define MR_tag_incr_hp_atomic_msg(dest, tag, count, proclabel, type)	\
 	MR_tag_offset_incr_hp_atomic_msg((dest), (tag), 0, (count),	\
 		proclabel, (type))
@@ -259,9 +293,14 @@
 
 #define	MR_offset_incr_hp(dest, offset, count)				\
 	MR_tag_offset_incr_hp((dest), MR_mktag(0), (offset), (count))
+#define	MR_offset_incr_hp_stubborn(dest, offset, count)			\
+	MR_tag_offset_incr_hp_stubborn((dest), MR_mktag(0), (offset), (count))
 #define	MR_offset_incr_hp_msg(dest, offset, count, proclabel, type)	\
 	MR_tag_offset_incr_hp_msg((dest), MR_mktag(0),			\
 		(offset), (count), proclabel, (type))
+#define	MR_offset_incr_hp_msg_stubborn(dest, offset, count, proclabel, type) \
+	MR_tag_offset_incr_hp_msg_stubborn((dest), MR_mktag(0),		\
+		(offset), (count), proclabel, (type))
 #define	MR_offset_incr_hp_atomic(dest, offset, count)			\
 	MR_tag_offset_incr_hp_atomic((dest), MR_mktag(0), (offset), (count))
 #define	MR_offset_incr_hp_atomic_msg(dest, offset, count, proclabel, type) \
@@ -299,8 +338,12 @@
 
 #define	MR_alloc_heap(dest, count)					\
 	MR_tag_offset_incr_hp((dest), MR_mktag(0), 0, (count))
+#define	MR_alloc_heap_stubborn(dest, count)				\
+	MR_tag_offset_incr_hp_stubborn((dest), MR_mktag(0), 0, (count))
 #define	MR_tag_alloc_heap(dest, tag, count)				\
 	MR_tag_offset_incr_hp((dest), MR_mktag(tag), 0, (count))
+#define	MR_tag_alloc_heap_stubborn(dest, tag, count)			\
+	MR_tag_offset_incr_hp_stubborn((dest), MR_mktag(tag), 0, (count))
 
 #ifdef MR_HIGHLEVEL_CODE
 
@@ -493,7 +536,7 @@
 **
 ** There are intentionally no versions that do not specify an offset;
 ** this is to force anyone who wants to allocate cells on the saved heap
-** to think about the impliciations of their code for term size profiling.
+** to think about the implications of their code for term size profiling.
 */
 
 #define MR_offset_incr_saved_hp(dest, offset, count)		\
Index: runtime/mercury_timing.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_timing.c,v
retrieving revision 1.8
diff -u -r1.8 mercury_timing.c
--- runtime/mercury_timing.c	13 Feb 2002 09:56:42 -0000	1.8
+++ runtime/mercury_timing.c	4 Apr 2005 06:50:54 -0000
@@ -30,10 +30,10 @@
 	#define FILETIME_TO_MILLISEC(time, msec)			\
 	do								\
 	{								\
-	  SYSTEMTIME tmp;						\
-	  FileTimeToSystemTime(&time, &tmp);				\
-	  msec = tmp.wMilliseconds +					\
-	    1000 * (tmp.wSecond + 60 * (tmp.wMinute + 60 * tmp.wHour));	\
+		SYSTEMTIME tmp;						\
+		FileTimeToSystemTime(&time, &tmp);			\
+		msec = tmp.wMilliseconds + 1000 * 			\
+			(tmp.wSecond + 60 * (tmp.wMinute + 60 * tmp.wHour)); \
 	} while(0)
 
 	FILETIME creation_time;
@@ -43,8 +43,8 @@
 	int user_msec, kernel_msec;
 	
 	GetProcessTimes(GetCurrentProcess(),
-					&creation_time, &exit_time,
-					&kernel_time, &user_time);
+		&creation_time, &exit_time,
+		&kernel_time, &user_time);
 	FILETIME_TO_MILLISEC(user_time, user_msec);
 	FILETIME_TO_MILLISEC(kernel_time, kernel_msec);
 	return user_msec + kernel_msec;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list