[m-rev.] diff: use correct type_ctor_rep for saved heap pointers
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue Feb 5 20:02:29 AEDT 2002
Estimated hours taken: 2
Branches: main
Define the `heap_pointer' type in private_builtin.m as a new builtin
type with representation MR_TYPECTOR_REP_HP, rather than as equivalent
to `c_pointer'. This is needed so that the accurate garbage collector
can tell saved heap pointer values apart from other c_pointer values,
which it needs to do in order to handle saved heap pointer values.
library/private_builtin.m:
runtime/mercury.h:
runtime/mercury.c:
Define the type_ctor_info etc. for the heap_pointer type.
compiler/type_util.m:
Add a new function `heap_pointer_type'.
compiler/add_heap_ops.m:
Use `heap_pointer_type' from type_util.m.
Workspace: /home/earth/fjh/ws-earth4/mercury
Index: compiler/add_heap_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_heap_ops.m,v
retrieving revision 1.2
diff -u -d -r1.2 add_heap_ops.m
--- compiler/add_heap_ops.m 27 Nov 2001 15:59:28 -0000 1.2
+++ compiler/add_heap_ops.m 5 Feb 2002 08:04:32 -0000
@@ -340,11 +340,6 @@
%-----------------------------------------------------------------------------%
-:- func heap_pointer_type = (type).
-heap_pointer_type = c_pointer_type.
-
-%-----------------------------------------------------------------------------%
-
:- pred generate_call(string::in, list(prog_var)::in, determinism::in,
maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
module_info::in, term__context::in, hlds_goal::out) is det.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.103
diff -u -d -r1.103 type_util.m
--- compiler/type_util.m 30 Jan 2002 12:46:59 -0000 1.103
+++ compiler/type_util.m 5 Feb 2002 08:03:56 -0000
@@ -165,6 +165,7 @@
:- func float_type = (type).
:- func char_type = (type).
:- func c_pointer_type = (type).
+:- func heap_pointer_type = (type).
:- func sample_type_info_type = (type).
:- func sample_typeclass_info_type = (type).
@@ -791,6 +792,10 @@
c_pointer_type = Type :-
mercury_public_builtin_module(BuiltinModule),
construct_type(qualified(BuiltinModule, "c_pointer") - 0, [], Type).
+
+heap_pointer_type = Type :-
+ mercury_private_builtin_module(BuiltinModule),
+ construct_type(qualified(BuiltinModule, "heap_pointer") - 0, [], Type).
sample_type_info_type = Type :-
mercury_private_builtin_module(BuiltinModule),
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.90
diff -u -d -r1.90 private_builtin.m
--- library/private_builtin.m 30 Jan 2002 12:47:07 -0000 1.90
+++ library/private_builtin.m 5 Feb 2002 09:00:10 -0000
@@ -1072,7 +1072,7 @@
% For documentation, see the corresponding LLDS instructions
% in compiler/llds.m. See also compiler/notes/trailing.html.
-:- type heap_pointer == c_pointer.
+:- type heap_pointer.
:- impure pred mark_hp(heap_pointer::out) is det.
:- impure pred restore_hp(heap_pointer::in) is det.
@@ -1167,6 +1167,165 @@
"is not supported when `--reclaim-heap-on-failure' is enabled."
]),
error(Msg).
+
+%-----------------------------------------------------------------------------%
+
+% Code to define the `heap_pointer' type for the LLDS and .NET back-ends.
+% (For the MLDS->C back-end, this type is defined in runtime/mercury.c.)
+
+:- pragma foreign_code("C", "
+
+#include ""mercury_deep_profiling_hand.h""
+
+/* Ensure that the initialization code for the module below gets run. */
+/*
+INIT sys_init_heap_pointer_module
+*/
+
+/* duplicate declarations to suppress gcc -Wmissing-decl warning */
+void sys_init_heap_pointer_module_init(void);
+void sys_init_heap_pointer_module_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_heap_pointer_module_write_out_proc_statics(FILE *fp);
+#endif
+
+#ifndef MR_HIGHLEVEL_CODE
+
+#ifdef MR_DEEP_PROFILING
+MR_proc_static_compiler_empty(private_builtin, __Unify__, heap_pointer,
+ 0, 0, ""private_builtin.m"", 0, TRUE);
+MR_proc_static_compiler_empty(private_builtin, __Compare__, heap_pointer,
+ 0, 0, ""private_builtin.m"", 0, TRUE);
+#endif
+
+MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, heap_pointer, 0,
+ MR_TYPECTOR_REP_HP,
+ mercury____Unify___private_builtin__heap_pointer_0_0,
+ mercury____Compare___private_builtin__heap_pointer_0_0);
+
+MR_declare_entry(mercury____Unify___private_builtin__heap_pointer_0_0);
+MR_declare_entry(mercury____Index___private_builtin__heap_pointer_0_0);
+MR_declare_entry(mercury____Compare___private_builtin__heap_pointer_0_0);
+
+MR_BEGIN_MODULE(heap_pointer_module)
+ MR_init_entry(mercury____Unify___private_builtin__heap_pointer_0_0);
+ MR_init_entry(mercury____Compare___private_builtin__heap_pointer_0_0);
+#ifdef MR_DEEP_PROFILING
+ MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i1);
+ MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i2);
+ MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i3);
+ MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i4);
+ MR_init_label(mercury____Compare___private_builtin__heap_pointer_0_0_i1);
+ MR_init_label(mercury____Compare___private_builtin__heap_pointer_0_0_i2);
+#endif
+MR_BEGIN_CODE
+
+#define proc_label mercury____Unify___private_builtin__heap_pointer_0_0
+#define proc_static MR_proc_static_compiler_name(private_builtin, \
+ __Unify__, heap_pointer, 0, 0)
+#define body_code MR_fatal_error( \
+ ""called unify for type `private_builtin:heap_pointer'"")
+
+#include ""mercury_hand_unify_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
+
+#define proc_label mercury____Compare___private_builtin__heap_pointer_0_0
+#define proc_static MR_proc_static_compiler_name(private_builtin, \
+ __Compare__, heap_pointer, 0, 0)
+#define body_code MR_fatal_error( \
+ ""called compare/3 for type `private_builtin:heap_pointer'"")
+
+#include ""mercury_hand_compare_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
+
+MR_END_MODULE
+
+MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc heap_pointer_module;
+
+#endif /* ! MR_HIGHLEVEL_CODE */
+
+void
+sys_init_heap_pointer_module_init(void)
+{
+#ifndef MR_HIGHLEVEL_CODE
+ heap_pointer_module();
+
+ MR_INIT_TYPE_CTOR_INFO(
+ mercury_data_private_builtin__type_ctor_info_heap_pointer_0,
+ private_builtin__heap_pointer_0_0);
+#endif
+}
+
+void
+sys_init_heap_pointer_module_init_type_tables(void)
+{
+#ifndef MR_HIGHLEVEL_CODE
+ MR_register_type_ctor_info(
+ &mercury_data_private_builtin__type_ctor_info_heap_pointer_0);
+#endif
+}
+
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_heap_pointer_module_write_out_proc_statics(FILE *fp)
+{
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(private_builtin, __Unify__,
+ heap_pointer, 0, 0));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(private_builtin, __Compare__,
+ heap_pointer, 0, 0));
+}
+#endif
+
+").
+
+
+:- pragma foreign_code("MC++", "
+
+MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, heap_pointer, 0,
+ MR_TYPECTOR_REP_HP)
+
+static int
+__Unify__private_builtin__heap_pointer_0_0(MR_Word x, MR_Word y)
+{
+ mercury::runtime::Errors::fatal_error(
+ ""called unify for type `private_builtin:heap_pointer'"");
+ return 0;
+}
+
+static void
+__Compare__private_builtin__heap_pointer_0_0(
+ MR_Word_Ref result, MR_Word x, MR_Word y)
+{
+ mercury::runtime::Errors::fatal_error(
+ ""called compare/3 for type `private_builtin:heap_pointer'"");
+}
+
+static int
+do_unify__heap_pointer_0_0(MR_Box x, MR_Box y)
+{
+ mercury::runtime::Errors::fatal_error(
+ ""called unify for type `private_builtin:heap_pointer'"");
+ return 0;
+}
+
+static void
+do_compare__heap_pointer_0_0(
+ MR_Word_Ref result, MR_Box x, MR_Box y)
+{
+ mercury::runtime::Errors::fatal_error(
+ ""called compare/3 for type `private_builtin:heap_pointer'"");
+ return 0;
+}
+
+").
%-----------------------------------------------------------------------------%
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.34
diff -u -d -r1.34 mercury.c
--- runtime/mercury.c 30 Jan 2002 12:47:11 -0000 1.34
+++ runtime/mercury.c 5 Feb 2002 08:22:05 -0000
@@ -84,6 +84,7 @@
mercury__builtin__do_unify__character_0_0,
mercury__builtin__do_unify__void_0_0,
mercury__builtin__do_unify__c_pointer_0_0,
+ mercury__private_builtin__do_unify__heap_pointer_0_0,
mercury__builtin__do_unify__func_0_0,
mercury__builtin__do_unify__pred_0_0,
mercury__type_desc__do_unify__type_desc_0_0;
@@ -102,6 +103,7 @@
mercury__builtin__do_compare__character_0_0,
mercury__builtin__do_compare__void_0_0,
mercury__builtin__do_compare__c_pointer_0_0,
+ mercury__private_builtin__do_compare__heap_pointer_0_0,
mercury__builtin__do_compare__func_0_0,
mercury__builtin__do_compare__pred_0_0,
mercury__type_desc__do_compare__type_desc_0_0;
@@ -128,6 +130,7 @@
MR_define_type_ctor_info(builtin, character, 0, MR_TYPECTOR_REP_CHAR);
MR_define_type_ctor_info(builtin, void, 0, MR_TYPECTOR_REP_VOID);
MR_define_type_ctor_info(builtin, c_pointer, 0, MR_TYPECTOR_REP_C_POINTER);
+MR_define_type_ctor_info(private_builtin, heap_pointer, 0, MR_TYPECTOR_REP_HP);
MR_define_type_ctor_info(builtin, pred, 0, MR_TYPECTOR_REP_PRED);
MR_define_type_ctor_info(builtin, func, 0, MR_TYPECTOR_REP_FUNC);
MR_define_type_ctor_info(builtin, tuple, 0, MR_TYPECTOR_REP_TUPLE);
@@ -373,6 +376,13 @@
}
bool MR_CALL
+mercury__private_builtin____Unify____heap_pointer_0_0(MR_Heap_Pointer x,
+ MR_Heap_Pointer y)
+{
+ MR_fatal_error("called unify for type `private_builtin:heap_pointer'");
+}
+
+bool MR_CALL
mercury__builtin____Unify____func_0_0(MR_Func x, MR_Func y)
{
MR_fatal_error("called unify for `func' type");
@@ -519,6 +529,14 @@
}
void MR_CALL
+mercury__private_builtin____Compare____heap_pointer_0_0(
+ MR_Comparison_Result *result, MR_Heap_Pointer x, MR_Heap_Pointer y)
+{
+ MR_fatal_error(
+ "called compare/3 for type `private_builtin:heap_pointer'");
+}
+
+void MR_CALL
mercury__builtin____Compare____func_0_0(MR_Comparison_Result *result,
MR_Func x, MR_Func y)
{
@@ -649,6 +667,13 @@
}
static bool MR_CALL
+mercury__private_builtin__do_unify__heap_pointer_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____heap_pointer_0_0(
+ (MR_Heap_Pointer) x, (MR_Heap_Pointer) y);
+}
+
+static bool MR_CALL
mercury__builtin__do_unify__func_0_0(MR_Box x, MR_Box y)
{
MR_fatal_error("called unify for `func' type");
@@ -760,6 +785,14 @@
{
mercury__builtin____Compare____c_pointer_0_0(
result, (MR_C_Pointer) x, (MR_C_Pointer) y);
+}
+
+static void MR_CALL
+mercury__private_builtin__do_compare__heap_pointer_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ MR_fatal_error(
+ "called compare/3 for type `private_builtin:heap_pointer'");
}
static void MR_CALL
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.47
diff -u -d -r1.47 mercury.h
--- runtime/mercury.h 4 Feb 2002 00:34:29 -0000 1.47
+++ runtime/mercury.h 5 Feb 2002 08:19:04 -0000
@@ -128,6 +128,7 @@
MR_Comparison_Result;
typedef struct mercury__builtin__void_0_s * MR_Void;
typedef struct mercury__builtin__c_pointer_0_s * MR_C_Pointer;
+ typedef struct mercury__private_builtin__heap_pointer_0_s * MR_Heap_Pointer;
typedef MR_ClosurePtr MR_Pred;
typedef MR_ClosurePtr MR_Func;
typedef struct mercury__array__array_1_s * MR_Array;
@@ -146,6 +147,7 @@
typedef MR_Word MR_Comparison_Result;
typedef MR_Word MR_Void;
typedef MR_Word MR_C_Pointer;
+ typedef MR_Word MR_Heap_Pointer;
typedef MR_Word MR_Pred;
typedef MR_Word MR_Func;
typedef MR_Word MR_Array;
@@ -312,6 +314,7 @@
mercury__builtin__builtin__type_ctor_info_character_0,
mercury__builtin__builtin__type_ctor_info_void_0,
mercury__builtin__builtin__type_ctor_info_c_pointer_0,
+ mercury__builtin__builtin__type_ctor_info_heap_pointer_0,
mercury__builtin__builtin__type_ctor_info_pred_0,
mercury__builtin__builtin__type_ctor_info_func_0,
mercury__builtin__builtin__type_ctor_info_tuple_0,
@@ -543,6 +546,8 @@
bool MR_CALL mercury__builtin____Unify____void_0_0(MR_Void x, MR_Void y);
bool MR_CALL mercury__builtin____Unify____c_pointer_0_0(
MR_C_Pointer x, MR_C_Pointer y);
+bool MR_CALL mercury__builtin____Unify____heap_pointer_0_0(
+ MR_Heap_Pointer x, MR_Heap_Pointer y);
bool MR_CALL mercury__builtin____Unify____func_0_0(MR_Func x, MR_Func y);
bool MR_CALL mercury__builtin____Unify____pred_0_0(MR_Pred x, MR_Pred y);
bool MR_CALL mercury__builtin____Unify____tuple_0_0(
@@ -574,6 +579,8 @@
MR_Comparison_Result *result, MR_Void x, MR_Void y);
void MR_CALL mercury__builtin____Compare____c_pointer_0_0(
MR_Comparison_Result *result, MR_C_Pointer x, MR_C_Pointer y);
+void MR_CALL mercury__builtin____Compare____heap_pointer_0_0(
+ MR_Comparison_Result *result, MR_Heap_Pointer x, MR_Heap_Pointer y);
void MR_CALL mercury__builtin____Compare____func_0_0(
MR_Comparison_Result *result, MR_Func x, MR_Func y);
void MR_CALL mercury__builtin____Compare____pred_0_0(
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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