Fix places where the code previously assumed that `nb_reference(T)' and

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.

extras/references/nb_reference.m

@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998-2000,2002 University of Melbourne.
+% Copyright (C) 1998-2000,2002-2003 University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -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.

extras/references/reference.m

@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998-2000,2002 University of Melbourne.
+% Copyright (C) 1998-2000,2002-2003 University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -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.

extras/references/tests/glob_test.m

@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1999-2000 Monash University, University of Melbourne &
+% Copyright (C) 1999-2000 Monash University,, 2003 The University of Melbourne &
 % KU Leuven.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -54,11 +54,17 @@ ME_Reference HAL_glob_Optimise;
 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;
 ").
 

extras/references/tests/ref_test.m

@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998,2000 University of Melbourne.
+% Copyright (C) 1998,2000, 2003 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -58,7 +58,13 @@ main(IO, IO) :-
 
 :- 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 @@ scope_test :-
 	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 @@ scope_test2 :-
 	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),