[m-rev.] for review: fix incorrect assumptions in extras/references/

[David Overton]

Estimated hours taken: 3
Branches: main

extras/references/nb_reference.m:
extras/references/reference.m:
extras/references/tests/glob_test.m:
extras/references/tests/ref_test.m:
	Fix places where the code previously assumed that `nb_reference(T)' and
	`reference(T)' had the same representation as `c_pointer'.
	This is not the case in some grades, e.g. the `--reserve-tag' grades.

Index: nb_reference.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/nb_reference.m,v
retrieving revision 1.5
diff -u -r1.5 nb_reference.m
--- nb_reference.m	13 Feb 2002 09:56:27 -0000	1.5
+++ nb_reference.m	10 Jan 2003 03:03:38 -0000
@@ -59,7 +59,13 @@
 :- pragma c_header_code("#include ""mercury_deep_copy.h""").
 
 :- pragma inline(new_nb_reference/2).
-:- pragma c_code(new_nb_reference(X::in, Ref::out), will_not_call_mercury, "
+
+new_nb_reference(X, nb_reference(Ref)) :-
+	impure new_nb_reference_2(X, Ref).
+
+:- impure pred new_nb_reference_2(T::in, c_pointer::out) is det.
+:- pragma inline(new_nb_reference_2/2).
+:- pragma c_code(new_nb_reference_2(X::in, Ref::out), will_not_call_mercury, "
 	MR_incr_hp(Ref, 1);
 #ifndef MR_CONSERVATIVE_GC
 	MR_save_transient_registers();
@@ -72,12 +78,24 @@
 ").
 
 :- pragma inline(value/2).
-:- pragma c_code(value(Ref::in, X::out), will_not_call_mercury, "
+
+value(nb_reference(Ref), X) :-
+	semipure value_2(Ref, X).
+
+:- semipure pred value_2(c_pointer::in, T::out) is det.
+:- pragma inline(value_2/2).
+:- pragma c_code(value_2(Ref::in, X::out), will_not_call_mercury, "
 	X = *(MR_Word *) Ref;
 ").
 
 :- pragma inline(update/2).
-:- pragma c_code(update(Ref::in, X::in), will_not_call_mercury, "
+
+update(nb_reference(Ref), X) :-
+	impure update_2(Ref, X).
+
+:- impure pred update_2(c_pointer::in, T::in) is det.
+:- pragma inline(update_2/2).
+:- pragma c_code(update_2(Ref::in, X::in), will_not_call_mercury, "
 #ifndef MR_CONSERVATIVE_GC
 	MR_save_transient_registers();
 #endif
@@ -99,9 +117,24 @@
 
 :- impure pred init(nb_reference(T)::in, T::in) is det.
 
+% from_c_pointer(CPointer) = Ref
+%	Convert a c_pointer to a nb_reference.
+
+:- func nb_reference__from_c_pointer(c_pointer) = nb_reference(T).
+
+% to_c_pointer(Ref) = CPointer
+%	Convert a nb_reference to a c_pointer.
+
+:- func nb_reference__to_c_pointer(nb_reference(T)) = c_pointer.
+
 :- implementation.
 
 :- pragma inline(init/2).
 init(Ref, X) :-
 	impure update(Ref, X).
 
+:- pragma inline(nb_reference__from_c_pointer/1).
+nb_reference__from_c_pointer(CPointer) = nb_reference(CPointer).
+
+:- pragma inline(nb_reference__to_c_pointer/1).
+nb_reference__to_c_pointer(nb_reference(CPointer)) = CPointer.
Index: reference.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/reference.m,v
retrieving revision 1.4
diff -u -r1.4 reference.m
--- reference.m	21 Jan 2002 05:20:34 -0000	1.4
+++ reference.m	10 Jan 2003 03:03:38 -0000
@@ -54,7 +54,12 @@
 :- pragma c_header_code("#include ""c_reference.h""").
 
 :- pragma inline(new_reference/2).
-:- pragma c_code(new_reference(X::in, Ref::out), will_not_call_mercury, "
+new_reference(X, reference(Ref)) :-
+	impure new_reference_2(X, Ref).
+
+:- impure pred new_reference_2(T::in, c_pointer::out) is det.
+:- pragma inline(new_reference_2/2).
+:- pragma c_code(new_reference_2(X::in, Ref::out), will_not_call_mercury, "
 	MR_incr_hp(Ref, (sizeof(ME_Reference) + sizeof(MR_Word) - 1) / 
 			sizeof(MR_Word));
 	((ME_Reference *) Ref)->value = (void *) X;
@@ -62,12 +67,22 @@
 ").
 
 :- pragma inline(value/2).
-:- pragma c_code(value(Ref::in, X::out), will_not_call_mercury, "
+value(reference(Ref), X) :-
+	semipure value_2(Ref, X).
+
+:- semipure pred value_2(c_pointer::in, T::out) is det.
+:- pragma inline(value_2/2).
+:- pragma c_code(value_2(Ref::in, X::out), will_not_call_mercury, "
 	X = (MR_Word) ((ME_Reference *) Ref)->value;
 ").
 
 :- pragma inline(update/2).
-:- pragma c_code(update(Ref::in, X::in), will_not_call_mercury, "
+update(reference(Ref), X) :-
+	impure update_2(Ref, X).
+
+:- impure pred update_2(c_pointer::in, T::in) is det.
+:- pragma inline(update_2/2).
+:- pragma c_code(update_2(Ref::in, X::in), will_not_call_mercury, "
 	ME_Reference *ref = (ME_Reference *) Ref;
 	if (ref->id != MR_current_choicepoint_id()) {
 		MR_trail_current_value((MR_Word *) (&ref->value));
@@ -88,11 +103,32 @@
 
 :- impure pred init(reference(T)::in, T::in) is det.
 
+% from_c_pointer(CPointer) = Ref
+%	Convert a c_pointer to a reference.
+
+:- func reference__from_c_pointer(c_pointer) = reference(T).
+
+% to_c_pointer(Ref) = CPointer
+%	Convert a reference to a c_pointer.
+
+:- func reference__to_c_pointer(reference(T)) = c_pointer.
+
 :- implementation.
 
 :- pragma inline(init/2).
-:- pragma c_code(init(Ref::in, X::in), will_not_call_mercury, "
+init(reference(Ref), X) :-
+	impure init_2(Ref, X).
+
+:- impure pred init_2(c_pointer::in, T::in) is det.
+:- pragma inline(init_2/2).
+:- pragma c_code(init_2(Ref::in, X::in), will_not_call_mercury, "
 	((ME_Reference *) Ref)->value = (void *) X;
 	((ME_Reference *) Ref)->id = MR_current_choicepoint_id();
 ").
 
+
+:- pragma inline(reference__from_c_pointer/1).
+reference__from_c_pointer(CPointer) = reference(CPointer).
+
+:- pragma inline(reference__to_c_pointer/1).
+reference__to_c_pointer(reference(CPointer)) = CPointer.
Index: tests/glob_test.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/tests/glob_test.m,v
retrieving revision 1.1
diff -u -r1.1 glob_test.m
--- tests/glob_test.m	28 Jan 2000 03:37:14 -0000	1.1
+++ tests/glob_test.m	10 Jan 2003 03:03:38 -0000
@@ -54,11 +54,17 @@
 ME_NbReference HAL_glob_TargetLang;
 ").
 
-:- pragma c_code(glob_Optimise = (X::out), will_not_call_mercury, "
+glob_Optimise = reference__from_c_pointer(glob_Optimise_2).
+
+:- func glob_Optimise_2 = c_pointer.
+:- pragma c_code(glob_Optimise_2 = (X::out), will_not_call_mercury, "
 	X = (Word) &HAL_glob_Optimise;
 ").
 
-:- pragma c_code(glob_TargetLang = (X::out), will_not_call_mercury, "
+glob_TargetLang = nb_reference__from_c_pointer(glob_TargetLang_2).
+
+:- func glob_TargetLang_2 = c_pointer.
+:- pragma c_code(glob_TargetLang_2 = (X::out), will_not_call_mercury, "
 	X = (Word) &HAL_glob_TargetLang;
 ").
 
Index: tests/ref_test.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/tests/ref_test.m,v
retrieving revision 1.2
diff -u -r1.2 ref_test.m
--- tests/ref_test.m	28 Jan 2000 03:32:33 -0000	1.2
+++ tests/ref_test.m	10 Jan 2003 03:03:38 -0000
@@ -58,7 +58,13 @@
 
 :- func globalvar = nb_reference(int).
 :- pragma inline(globalvar/0).
-:- pragma c_code(globalvar = (Ref::out), will_not_call_mercury, "
+
+globalvar = nb_reference__from_c_pointer(globalvar_2).
+
+:- func globalvar_2 = c_pointer.
+:- pragma inline(globalvar_2/0).
+
+:- pragma c_code(globalvar_2 = (Ref::out), will_not_call_mercury, "
 	Ref = (Word) &globalvar;
 ").
 
@@ -74,7 +80,9 @@
 	semipure value(globalvar, V0),
 	impure update(globalvar, V0 + I),
 	impure scope_test_message("before", V0, V0 + I),
-	impure enter_scope(globalvar, Handle),
+		% enter_scope needs to be passed the c_pointer since it is the
+		% value this points to that needs to be saved.
+	impure enter_scope(globalvar_2, Handle),
 	small_int(J),
 	semipure value(globalvar, V1),
 	impure scope_test_message("inside", V1, V1 + (J * 10)),
@@ -93,11 +101,15 @@
 	semipure value(globalvar, V0),
 	impure update(globalvar, 0),
 	impure scope_test_message("outside", V0, 0),
-	impure enter_scope(globalvar, Handle1),
+		% enter_scope needs to be passed the c_pointer since it is the
+		% value this points to that needs to be saved.
+	impure enter_scope(globalvar_2, Handle1),
 	semipure value(globalvar, V1),
 	impure update(globalvar, 1),
 	impure scope_test_message("inside 1", V1, 1),
-	impure enter_scope(globalvar, Handle2),
+		% enter_scope needs to be passed the c_pointer since it is the
+		% value this points to that needs to be saved.
+	impure enter_scope(globalvar_2, Handle2),
 	semipure value(globalvar, V2),
 	impure update(globalvar, 2),
 	impure scope_test_message("inside 2", V2, 2),
-- 
David Overton                  Uni of Melbourne     +61 3 8344 1354
dmo at cs.mu.oz.au                Monash Uni (Clayton) +61 3 9905 5779
http://www.cs.mu.oz.au/~dmo    Mobile Phone         +61 4 0337 4393
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------