[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