diff: bug fix for nondet pragma C code

[Zoltan Somogyi]

Fix a bug in nondet pragma C codes.

compiler/pragma_c_gen.m:
	Fix an off-by-one error that caused the C struct we define
	(to hold the items that must be saved from one success of a
	nondet pragma C code to the next) to start with the top word
	in the next lower nondet stack frame, instead of the word
	immediately after that. Therefore an assignment to the first
	field of the struct was clobbering the previous stack frame.

tests/hard_coded/nondet_c.{m,exp}:
	A new test case to check for this bug.

tests/hard_coded/Mmakefile:
	Enable the new test case.

Zoltan.

cvs diff: Diffing compiler
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.26
diff -u -b -u -r1.26 pragma_c_gen.m
--- pragma_c_gen.m	1999/01/27 08:34:30	1.26
+++ pragma_c_gen.m	1999/03/25 04:51:12
@@ -537,8 +537,8 @@
 	{ pragma_c_gen__struct_name(ModuleName, PredName, Arity, ProcId,
 		StructName) },
 	{ SaveStructDecl = pragma_c_struct_ptr_decl(StructName, "LOCALS") },
-	{ string__format("\tLOCALS = (struct %s *) (
-		(char *) (curfr - MR_ORDINARY_SLOTS - MR_NONDET_FIXED_SIZE)
+	{ string__format("\tLOCALS = (struct %s *) ((char *)
+		(MR_curfr + 1 - MR_ORDINARY_SLOTS - MR_NONDET_FIXED_SIZE)
 		- sizeof(struct %s));\n",
 		[s(StructName), s(StructName)],
 		InitSaveStruct) },
cvs diff: Diffing compiler/notes
cvs diff: Diffing tests/hard_coded/
Index: tests/hard_coded//Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.53
diff -u -b -u -r1.53 Mmakefile
--- Mmakefile	1999/03/24 04:22:17	1.53
+++ Mmakefile	1999/03/24 06:07:23
@@ -61,6 +61,7 @@
 	name_mangling \
 	no_fully_strict \
 	no_inline \
+	nondet_c \
 	nondet_ctrl_vn \
 	nullary_ho_func \
 	pragma_c_code \
Index: tests/hard_coded//nondet_c.exp
===================================================================
RCS file: nondet_c.exp
diff -N nondet_c.exp
--- /dev/null	Thu Mar 25 16:05:00 1999
+++ nondet_c.exp	Thu Mar 25 15:46:07 1999
@@ -0,0 +1,21 @@
+/abcdef
+a/bcdef
+ab/cdef
+abc/def
+abcd/ef
+abcde/f
+abcdef/
+/abcdef
+a/bcdef
+ab/cdef
+abc/def
+abcd/ef
+abcde/f
+abcdef/
+/abcdef
+a/bcdef
+ab/cdef
+abc/def
+abcd/ef
+abcde/f
+abcdef/
Index: tests/hard_coded//nondet_c.m
===================================================================
RCS file: nondet_c.m
diff -N nondet_c.m
--- /dev/null	Thu Mar 25 16:05:00 1999
+++ nondet_c.m	Thu Mar 25 16:03:51 1999
@@ -0,0 +1,179 @@
+% This test checks to see whether the compiler handles all three forms of
+% nondet C code OK.
+
+:- module nondet_c.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module std_util, list.
+
+main -->
+	{ solutions(split_pairs1("abcdef"), Pairs1) },
+	print_pairs(Pairs1),
+	{ solutions(split_pairs2("abcdef"), Pairs2) },
+	print_pairs(Pairs2),
+	{ solutions(split_pairs3("abcdef"), Pairs3) },
+	print_pairs(Pairs3).
+
+:- pred print_pairs(list(pair(string))::in, io__state::di, io__state::uo)
+	is det.
+
+print_pairs([]) --> [].
+print_pairs([Left - Right | Pairs]) -->
+	io__write_string(Left),
+	io__write_string("/"),
+	io__write_string(Right),
+	io__write_string("\n"),
+	print_pairs(Pairs).
+
+:- pred split_pairs1(string::in, pair(string)::out) is multi.
+
+split_pairs1(Whole, Left - Right) :-
+	break_string1(Left, Right, Whole).
+
+:- pred split_pairs2(string::in, pair(string)::out) is multi.
+
+split_pairs2(Whole, Left - Right) :-
+	break_string2(Left, Right, Whole).
+
+:- pred split_pairs3(string::in, pair(string)::out) is multi.
+
+split_pairs3(Whole, Left - Right) :-
+	break_string3(Left, Right, Whole).
+
+:- pred break_string1(string, string, string).
+:- mode break_string1(out, out, in) is multi.
+
+:- pragma c_code(break_string1(LeftHalf::out, RightHalf::out, WholeString::in),
+will_not_call_mercury,
+local_vars("
+	/* here we declare any local variables that we need to save */
+	String s;
+	size_t len;
+	size_t count;
+"),
+first_code(/* This comment tests whether
+the context of the following code is computed correctly
+*/ "
+	/* this code gets executed on a call, but not on a retry */
+	LOCALS->s = WholeString;
+	LOCALS->len = strlen(WholeString);
+	LOCALS->count = 0;
+"),
+retry_code("
+	/* this code gets executed on a retry */
+	LOCALS->count++;
+"),
+shared_code("
+	Word	temp;
+
+	/* this code gets executed for both calls and retries */
+	incr_hp_atomic(temp,
+		(LOCALS->count + sizeof(Word)) / sizeof(Word));
+	LeftHalf = (String) temp;
+	memcpy(LeftHalf, LOCALS->s, LOCALS->count);
+	LeftHalf[LOCALS->count] = '\\0';
+	incr_hp_atomic(temp,
+		(LOCALS->len - LOCALS->count + sizeof(Word))
+		/ sizeof(Word));
+	RightHalf = (String) temp;
+	strcpy(RightHalf, LOCALS->s + LOCALS->count);
+
+	if (LOCALS->count < LOCALS->len) {
+		SUCCEED;
+	} else {
+		SUCCEED_LAST;
+	}
+")).
+
+:- pred break_string2(string, string, string).
+:- mode break_string2(out, out, in) is multi.
+
+:- pragma c_code(break_string2(LeftHalf::out, RightHalf::out, WholeString::in),
+will_not_call_mercury,
+local_vars("
+	/* here we declare any local variables that we need to save */
+	String s;
+	size_t len;
+	size_t count;
+"),
+first_code("
+	/* this code gets executed on a call, but not on a retry */
+	LOCALS->s = WholeString;
+	LOCALS->len = strlen(WholeString);
+	LOCALS->count = 0;
+"),
+retry_code("
+	/* this code gets executed on a retry */
+	LOCALS->count++;
+"),
+duplicated_code("
+	Word	temp;
+
+	/* this code gets executed for both calls and retries */
+	incr_hp_atomic(temp,
+		(LOCALS->count + sizeof(Word)) / sizeof(Word));
+	LeftHalf = (String) temp;
+	memcpy(LeftHalf, LOCALS->s, LOCALS->count);
+	LeftHalf[LOCALS->count] = '\\0';
+	incr_hp_atomic(temp,
+		(LOCALS->len - LOCALS->count + sizeof(Word))
+		/ sizeof(Word));
+	RightHalf = (String) temp;
+	strcpy(RightHalf, LOCALS->s + LOCALS->count);
+
+	if (LOCALS->count < LOCALS->len) {
+		SUCCEED;
+	} else {
+		SUCCEED_LAST;
+	}
+")).
+
+:- pred break_string3(string, string, string).
+:- mode break_string3(out, out, in) is multi.
+
+:- pragma c_code(break_string3(LeftHalf::out, RightHalf::out, WholeString::in),
+will_not_call_mercury,
+local_vars("
+	/* here we declare any local variables that we need to save */
+	String s;
+	size_t len;
+	size_t count;
+"),
+first_code("
+	/* this code gets executed on a call, but not on a retry */
+	LOCALS->s = WholeString;
+	LOCALS->len = strlen(WholeString);
+	LOCALS->count = 0;
+"),
+retry_code("
+	/* this code gets executed on a retry */
+	LOCALS->count++;
+"),
+common_code("
+	Word	temp;
+
+	/* this code gets executed for both calls and retries */
+	incr_hp_atomic(temp,
+		(LOCALS->count + sizeof(Word)) / sizeof(Word));
+	LeftHalf = (String) temp;
+	memcpy(LeftHalf, LOCALS->s, LOCALS->count);
+	LeftHalf[LOCALS->count] = '\\0';
+	incr_hp_atomic(temp,
+		(LOCALS->len - LOCALS->count + sizeof(Word))
+		/ sizeof(Word));
+	RightHalf = (String) temp;
+	strcpy(RightHalf, LOCALS->s + LOCALS->count);
+
+	if (LOCALS->count < LOCALS->len) {
+		SUCCEED;
+	} else {
+		SUCCEED_LAST;
+	}
+")).
cvs diff: Diffing tests/hard_coded//sub-modules
cvs diff: Diffing tests/hard_coded//typeclasses