mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-11 11:53:51 +00:00
Code Issues Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
David Overton
2003-01-10 05:49:22 +00:00
parent 35f480ea47
commit fd8c5bcf78
4 changed files with 104 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
extras/references/nb_reference.m
View File

@@ -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.

46
extras/references/reference.m
View File

@@ -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.

12
extras/references/tests/glob_test.m
View File

@@ -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;
").

22
extras/references/tests/ref_test.m
View File

@@ -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),