[m-dev.] for review: register type_ctor_infos
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Oct 10 16:40:26 AEDT 2000
This is part 1 of a change that provides a register of all the types defined
in the program. After this change, every .c file generated by the compiler
will have three separate initialization functions:
- One that does the initializations that must be performed before
any code is executed, such as recording the addresses of labels
in grades that don't allow direct jumps and filling in the code_addr
slots of type_ctor_infos.
- One that registers the type_ctor_infos of the types defined in this
module in a global table.
- One that initializes the data structures needed by the debugger;
i.e. registers the module layout in a global table.
For now, the first function calls the third, since this is required for
backwards compatibility of traced code; this call will go away later.
For now, the second function is not called from anywhere. Part 2 of this
change will add two functions to the _init.c file generated by c2init that
call the second function and third function respectively in each module
in the program.
This change affects only the LLDS backend; Fergus or Tyson should look into
providing this functionality for the MLDS backend as well.
This change only registers type_ctor_infos; it does not register
base_typeclass_infos. DJ and I have discussed this and agree that adding code
to register base_typeclass_infos would wasteful, because the work would almost
certainly have to be redone when constructor classes are implemented;
therefore registering base_typeclass_infos should be postponed until then.
compiler/llds_out.m:
compiler/rtti_out.m:
Generate the code for the two new initialization functions.
runtime/mercury_wrapper.[ch]:
Add the functions do_init_modules_{type_tables,debugger},
which are intended to eventually invoke the corresponding
initialization functions in the compiler-generated .c files
through the c2init-generated _init.c file, which themselves
are accessed through pointers in accordance with the link-order
convention. For now, these pointers will be NULL; part 2
will change that.
runtime/mercury_type_tables.[ch]:
New module that provides a capability of looking up MR_TypeCtorInfos
specified by a modulename/typename pair.
runtime/Mmakefile:
runtime/mercury_imp.h:
Include the new header file.
runtime/mercury_tabling.[ch]:
Allow a trie node to contain a list pointer; the type table is
implemented as a expandable hash table whose slots are lists of
type_ctor_infos.
runtime/mercury_dlist.[ch]:
Make this module conform to our naming conventions. Make the type of
list elements const, in order to avoid warnings when using lists in
mercury_type_tables.c.
runtime/mercury_hash_table.[ch]:
Minor changes to conform to the new names in mercury_dlist.[ch].
runtime/*.[ch]:
Fix indentation problems caused by past automatic substitutions.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.157
diff -u -r1.157 llds_out.m
--- compiler/llds_out.m 2000/10/03 00:34:15 1.157
+++ compiler/llds_out.m 2000/10/07 18:19:35
@@ -398,7 +398,7 @@
output_init_comment(ModuleName),
output_c_file_mercury_headers,
io__write_string("\n"),
- output_c_data_init_list_decls(Datas),
+ output_debugger_init_list_decls(Datas),
io__write_string("\n"),
output_c_module_init_list(ModuleName, Modules, Datas,
StackLayoutLabels),
@@ -541,17 +541,27 @@
io__write_string("#endif\n\n")
),
+ io__write_string("/* suppress gcc -Wmissing-decls warnings */\n"),
io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("(void);"),
- io__write_string("/* suppress gcc -Wmissing-decls warning */\n"),
+ io__write_string("(void);\n"),
io__write_string("void "),
output_init_name(ModuleName),
+ io__write_string("_type_tables(void);\n"),
+ io__write_string("void "),
+ output_init_name(ModuleName),
+ io__write_string("_debugger(void);\n"),
+ io__write_string("\n"),
+
+ io__write_string("void "),
+ output_init_name(ModuleName),
io__write_string("(void)\n"),
io__write_string("{\n"),
io__write_string("\tstatic bool done = FALSE;\n"),
- io__write_string("\tif (!done) {\n"),
- io__write_string("\t\tdone = TRUE;\n"),
+ io__write_string("\tif (done) {\n"),
+ io__write_string("\t\treturn;\n"),
+ io__write_string("\t}\n"),
+ io__write_string("\tdone = TRUE;\n"),
output_init_bunch_calls(AlwaysInitModuleBunches, ModuleName,
"always", 0),
@@ -566,8 +576,40 @@
),
output_c_data_init_list(Datas),
+ % The call to the debugger initialization function
+ % is for bootstrapping; once the debugger has been modified
+ % to call do_init_modules_debugger() and all debuggable
+ % object files created before this change have been
+ % overwritten, it can be deleted.
+ io__write_string("\t"),
+ output_init_name(ModuleName),
+ io__write_string("_debugger();\n"),
+ io__write_string("}\n\n"),
+
+ io__write_string("void "),
+ output_init_name(ModuleName),
+ io__write_string("_type_tables(void)\n"),
+ io__write_string("{\n"),
+ io__write_string("\tstatic bool done = FALSE;\n"),
+ io__write_string("\tif (done) {\n"),
+ io__write_string("\t\treturn;\n"),
+ io__write_string("\t}\n"),
+ io__write_string("\tdone = TRUE;\n"),
+ output_type_tables_init_list(Datas),
+ io__write_string("}\n\n"),
+
+ io__write_string("void "),
+ output_init_name(ModuleName),
+ io__write_string("_debugger(void)\n"),
+ io__write_string("{\n"),
+ io__write_string("\tstatic bool done = FALSE;\n"),
+ io__write_string("\tif (done) {\n"),
+ io__write_string("\t\treturn;\n"),
io__write_string("\t}\n"),
+ io__write_string("\tdone = TRUE;\n"),
+ output_debugger_init_list(Datas),
io__write_string("}\n\n"),
+
io__write_string(
"/* ensure everything is compiled with the same grade */\n"),
io__write_string(
@@ -634,13 +676,44 @@
{ NextSeq is Seq + 1 },
output_init_bunch_calls(Bunches, ModuleName, InitStatus, NextSeq).
+ % Output MR_INIT_TYPE_CTOR_INFO(TypeCtorInfo, TypeId);
+ % for each type_ctor_info defined in this module.
+
+:- pred output_c_data_init_list(list(comp_gen_c_data)::in,
+ io__state::di, io__state::uo) is det.
+
+output_c_data_init_list([]) --> [].
+output_c_data_init_list([Data | Datas]) -->
+ ( { Data = rtti_data(RttiData) } ->
+ rtti_out__init_rtti_data_if_nec(RttiData)
+ ;
+ []
+ ),
+ output_c_data_init_list(Datas).
+
+ % Output code to register each type_ctor_info defined in this module.
+
+:- pred output_type_tables_init_list(list(comp_gen_c_data)::in,
+ io__state::di, io__state::uo) is det.
+
+output_type_tables_init_list([]) --> [].
+output_type_tables_init_list([Data | Datas]) -->
+ (
+ { Data = rtti_data(RttiData) }
+ ->
+ rtti_out__register_rtti_data_if_nec(RttiData)
+ ;
+ []
+ ),
+ output_type_tables_init_list(Datas).
+
% Output declarations for each module layout defined in this module
% (there should only be one, of course).
-:- pred output_c_data_init_list_decls(list(comp_gen_c_data)::in,
+:- pred output_debugger_init_list_decls(list(comp_gen_c_data)::in,
io__state::di, io__state::uo) is det.
-output_c_data_init_list_decls([]) --> [].
-output_c_data_init_list_decls([Data | Datas]) -->
+output_debugger_init_list_decls([]) --> [].
+output_debugger_init_list_decls([Data | Datas]) -->
(
{ Data = comp_gen_c_data(ModuleName, DataName, _, _, _, _) },
{ DataName = module_layout }
@@ -651,24 +724,18 @@
;
[]
),
- output_c_data_init_list_decls(Datas).
+ output_debugger_init_list_decls(Datas).
- % Output MR_INIT_TYPE_CTOR_INFO(TypeCtorInfo, TypeId);
- % for each type_ctor_info defined in this module.
- % Also output calls to MR_register_module_layout()
+ % Output calls to MR_register_module_layout()
% for each module layout defined in this module
% (there should only be one, of course).
-:- pred output_c_data_init_list(list(comp_gen_c_data)::in,
+:- pred output_debugger_init_list(list(comp_gen_c_data)::in,
io__state::di, io__state::uo) is det.
-output_c_data_init_list([]) --> [].
-output_c_data_init_list([Data | Datas]) -->
+output_debugger_init_list([]) --> [].
+output_debugger_init_list([Data | Datas]) -->
(
- { Data = rtti_data(RttiData) }
- ->
- rtti_out__init_rtti_data_if_nec(RttiData)
- ;
{ Data = comp_gen_c_data(ModuleName, DataName, _, _, _, _) },
{ DataName = module_layout }
->
@@ -680,7 +747,7 @@
;
[]
),
- output_c_data_init_list(Datas).
+ output_debugger_init_list(Datas).
% Output a comment to tell mkinit what functions to
% call from <module>_init.c.
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.12
diff -u -r1.12 rtti_out.m
--- compiler/rtti_out.m 2000/07/12 13:54:39 1.12
+++ compiler/rtti_out.m 2000/10/10 03:46:24
@@ -32,32 +32,38 @@
:- pred output_addr_of_rtti_data(rtti_data::in, io__state::di, io__state::uo)
is det.
- % output a C declaration for the rtti_data
+ % Output a C declaration for the rtti_data.
:- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
- % output a C definition for the rtti_data
+ % Output a C definition for the rtti_data.
:- pred output_rtti_data_defn(rtti_data::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
- % output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
+ % Output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
% to initialize the rtti_data if necessary.
:- pred rtti_out__init_rtti_data_if_nec(rtti_data::in,
io__state::di, io__state::uo) is det.
- % output the C name of the rtti_data specified by the given
+ % Output C code (e.g. a call to MR_register_type_ctor_info())
+ % to register the rtti_data in the type tables, if it represents a data
+ % structure that should be so registered.
+:- pred rtti_out__register_rtti_data_if_nec(rtti_data::in,
+ io__state::di, io__state::uo) is det.
+
+ % Output the C name of the rtti_data specified by the given
% rtti_type_id and rtti_name.
:- pred output_rtti_addr(rtti_type_id::in, rtti_name::in,
io__state::di, io__state::uo) is det.
- % output the C storage class, C type, and C name of the rtti_data
+ % Output the C storage class, C type, and C name of the rtti_data
% specified by the given rtti_type_id and rtti_name,
% for use in a declaration or definition.
% The bool should be `yes' iff it is for a definition.
:- pred output_rtti_addr_storage_type_name(rtti_type_id::in, rtti_name::in,
bool::in, io__state::di, io__state::uo) is det.
- % the same as output_rtti_addr_storage_type_name,
+ % The same as output_rtti_addr_storage_type_name,
% but for a base_typeclass_info.
:- pred output_base_typeclass_info_storage_type_name(class_id::in, string::in,
bool::in, io__state::di, io__state::uo) is det.
@@ -639,9 +645,9 @@
{ Data = type_ctor_info(RttiTypeId,
_,_,_,_,_,_,_,_,_,_,_,_) }
->
- io__write_string("\t\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
+ io__write_string("\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
output_rtti_addr(RttiTypeId, type_ctor_info),
- io__write_string(",\n\t\t\t"),
+ io__write_string(",\n\t\t"),
{ RttiTypeId = rtti_type_id(ModuleName, TypeName, Arity) },
{ llds_out__sym_name_mangle(ModuleName, ModuleNameString) },
{ string__append(ModuleNameString, "__", UnderscoresModule) },
@@ -671,6 +677,32 @@
output_init_method_pointers(FirstFieldNum, CodeAddrs,
ClassName, ClassArity),
io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n")
+ ;
+ []
+ ).
+
+rtti_out__register_rtti_data_if_nec(Data) -->
+ (
+ { Data = type_ctor_info(RttiTypeId,
+ _,_,_,_,_,_,_,_,_,_,_,_) }
+ ->
+ io__write_string("\tMR_register_type_ctor_info(\n\t\t&"),
+ output_rtti_addr(RttiTypeId, type_ctor_info),
+ io__write_string(");\n")
+ ;
+ { Data = base_typeclass_info(ClassId, InstanceString,
+ _BaseTypeClassInfo) }
+ ->
+ % XXX Registering base_typeclass_infos by themselves is not
+ % enough. A base_typeclass_info doesn't say which types it
+ % declares to be members of which typeclass, and for now
+ % we don't even have any data structures in the runtime system
+ % to describe such membership information.
+ %
+ % io__write_string("\tMR_register_base_typeclass_info(\n\t\t&"),
+ % output_base_typeclass_info_storage_type_name(ClassId,
+ % InstanceString, no),
+ % io__write_string(");\n")
;
[]
).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.62
diff -u -r1.62 Mmakefile
--- runtime/Mmakefile 2000/08/17 05:31:09 1.62
+++ runtime/Mmakefile 2000/10/07 18:24:08
@@ -84,6 +84,7 @@
mercury_trail.h \
mercury_types.h \
mercury_type_info.h \
+ mercury_type_tables.h \
mercury_wrapper.h \
$(LIB_DLL_H)
@@ -149,6 +150,7 @@
mercury_trace_base.c \
mercury_trail.c \
mercury_type_info.c \
+ mercury_type_tables.c \
mercury_wrapper.c
OBJS = $(CFILES:.c=.$O)
Index: runtime/mercury_dlist.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_dlist.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_dlist.c
--- runtime/mercury_dlist.c 1999/10/18 22:00:18 1.4
+++ runtime/mercury_dlist.c 2000/10/08 22:13:50
@@ -17,15 +17,15 @@
** Make an empty list.
*/
-List *
-makelist0(void)
+MR_Dlist *
+MR_dlist_makelist0(void)
{
- reg List *list;
+ reg MR_Dlist *list;
- list = MR_GC_NEW(List);
- ldata(list) = NULL;
- next(list) = list;
- prev(list) = list;
+ list = MR_GC_NEW(MR_Dlist);
+ MR_dlist_data(list) = NULL;
+ MR_dlist_next(list) = list;
+ MR_dlist_prev(list) = list;
return list;
}
@@ -34,14 +34,14 @@
** Make a list with the argument is its only element.
*/
-List *
-list_makelist(void * data)
+MR_Dlist *
+MR_dlist_makelist(const void *data)
{
- reg List *list;
+ reg MR_Dlist *list;
MR_assert(data != NULL);
- list = makelist0();
- addhead(list, data);
+ list = MR_dlist_makelist0();
+ MR_dlist_addhead(list, data);
return list;
}
@@ -49,25 +49,25 @@
** Add some data to the head of a list.
*/
-List *
-list_addhead(List *list, void *data)
+MR_Dlist *
+MR_dlist_addhead(MR_Dlist *list, const void *data)
{
- reg List *item;
+ reg MR_Dlist *item;
if (list == NULL) {
- list = makelist0();
+ list = MR_dlist_makelist0();
}
- item = MR_GC_NEW(List);
- ldata(item) = data;
- llength(list)++;
+ item = MR_GC_NEW(MR_Dlist);
+ MR_dlist_data(item) = data;
+ MR_dlist_length(list)++;
/* item's pointers */
- next(item) = next(list);
- prev(item) = list;
+ MR_dlist_next(item) = MR_dlist_next(list);
+ MR_dlist_prev(item) = list;
/* neighbours' pointers */
- next(prev(item)) = item;
- prev(next(item)) = item;
+ MR_dlist_next(MR_dlist_prev(item)) = item;
+ MR_dlist_prev(MR_dlist_next(item)) = item;
return list;
}
@@ -76,25 +76,25 @@
** Add some data to the tail of a list.
*/
-List *
-list_addtail(List *list, void *data)
+MR_Dlist *
+MR_dlist_addtail(MR_Dlist *list, const void *data)
{
- reg List *item;
+ reg MR_Dlist *item;
if (list == NULL) {
- list = makelist0();
+ list = MR_dlist_makelist0();
}
- item = MR_GC_NEW(List);
- ldata(item) = data;
- llength(list)++;
+ item = MR_GC_NEW(MR_Dlist);
+ MR_dlist_data(item) = data;
+ MR_dlist_length(list)++;
/* item's pointers */
- next(item) = list;
- prev(item) = prev(list);
+ MR_dlist_next(item) = list;
+ MR_dlist_prev(item) = MR_dlist_prev(list);
/* neighbours' pointers */
- next(prev(item)) = item;
- prev(next(item)) = item;
+ MR_dlist_next(MR_dlist_prev(item)) = item;
+ MR_dlist_prev(MR_dlist_next(item)) = item;
return list;
}
@@ -104,34 +104,37 @@
** list2 is not meaningful after the operation, it is freed.
*/
-List *
-addlist(List *list1, List *list2)
+MR_Dlist *
+MR_dlist_addlist(MR_Dlist *list1, MR_Dlist *list2)
{
if (list1 == NULL) {
- list1 = makelist0();
+ list1 = MR_dlist_makelist0();
}
if (list2 == NULL) {
- list2 = makelist0();
+ list2 = MR_dlist_makelist0();
}
- if (llength(list2) > 0) {
- if (llength(list1) == 0) {
- ldata(list1) = ldata(list2);
+ if (MR_dlist_length(list2) > 0) {
+ if (MR_dlist_length(list1) == 0) {
+ MR_dlist_data(list1) = MR_dlist_data(list2);
/* pointers from header */
- next(list1) = next(list2);
- prev(list1) = prev(list2);
+ MR_dlist_next(list1) = MR_dlist_next(list2);
+ MR_dlist_prev(list1) = MR_dlist_prev(list2);
/* pointers to header */
- prev(next(list1)) = list1;
- next(prev(list1)) = list1;
+ MR_dlist_prev(MR_dlist_next(list1)) = list1;
+ MR_dlist_next(MR_dlist_prev(list1)) = list1;
} else {
- llength(list1) = llength(list1) + llength(list2);
+ MR_dlist_length(list1) = MR_dlist_length(list1)
+ + MR_dlist_length(list2);
/* end of list 1 to start of list 2 */
- next(prev(list1)) = next(list2);
- prev(next(list2)) = prev(list1);
+ MR_dlist_next(MR_dlist_prev(list1)) =
+ MR_dlist_next(list2);
+ MR_dlist_prev(MR_dlist_next(list2)) =
+ MR_dlist_prev(list1);
/* end of list 2 to start of list 1 */
- next(prev(list2)) = list1;
- prev(list1) = prev(list2);
+ MR_dlist_next(MR_dlist_prev(list2)) = list1;
+ MR_dlist_prev(list1) = MR_dlist_prev(list2);
}
}
@@ -145,21 +148,21 @@
** but only the data pointers of the second are used.
*/
-List *
-addndlist(List *list1, List *list2)
+MR_Dlist *
+MR_dlist_addndlist(MR_Dlist *list1, MR_Dlist *list2)
{
- reg List *ptr;
+ reg MR_Dlist *ptr;
if (list1 == NULL) {
- list1 = makelist0();
+ list1 = MR_dlist_makelist0();
}
if (list2 == NULL) {
- list2 = makelist0();
+ list2 = MR_dlist_makelist0();
}
- for_list (ptr, list2) {
- addtail(list1, ldata(ptr));
+ MR_for_dlist (ptr, list2) {
+ MR_dlist_addtail(list1, MR_dlist_data(ptr));
}
return list1;
@@ -170,20 +173,20 @@
*/
void
-list_insert_before(List *list, List *where, void *data)
+MR_dlist_insert_before(MR_Dlist *list, MR_Dlist *where, const void *data)
{
- reg List *item;
+ reg MR_Dlist *item;
- item = MR_GC_NEW(List);
- ldata(item) = data;
- llength(list)++;
+ item = MR_GC_NEW(MR_Dlist);
+ MR_dlist_data(item) = data;
+ MR_dlist_length(list)++;
/* item's pointers */
- next(item) = where;
- prev(item) = prev(where);
+ MR_dlist_next(item) = where;
+ MR_dlist_prev(item) = MR_dlist_prev(where);
/* neighbour's pointers */
- next(prev(item)) = item;
- prev(next(item)) = item;
+ MR_dlist_next(MR_dlist_prev(item)) = item;
+ MR_dlist_prev(MR_dlist_next(item)) = item;
}
/*
@@ -191,20 +194,20 @@
*/
void
-list_insert_after(List *list, List *where, void *data)
+MR_dlist_insert_after(MR_Dlist *list, MR_Dlist *where, const void *data)
{
- reg List *item;
+ reg MR_Dlist *item;
- item = MR_GC_NEW(List);
- ldata(item) = data;
- llength(list)++;
+ item = MR_GC_NEW(MR_Dlist);
+ MR_dlist_data(item) = data;
+ MR_dlist_length(list)++;
/* item's pointers */
- next(item) = next(where);
- prev(item) = where;
+ MR_dlist_next(item) = MR_dlist_next(where);
+ MR_dlist_prev(item) = where;
/* neighbour's pointers */
- next(prev(item)) = item;
- prev(next(item)) = item;
+ MR_dlist_next(MR_dlist_prev(item)) = item;
+ MR_dlist_prev(MR_dlist_next(item)) = item;
return;
}
@@ -214,13 +217,13 @@
*/
int
-length(const List *list)
+MR_dlist_maybe_null_length(const MR_Dlist *list)
{
if (list == NULL) {
return 0;
}
- return llength(list);
+ return MR_dlist_length(list);
}
/*
@@ -229,7 +232,7 @@
*/
void
-dlist_delete(List *list, List *item, void (* func)(void *))
+MR_dlist_delete(MR_Dlist *list, MR_Dlist *item, void (* func)(const void *))
{
if (list == NULL) {
return;
@@ -240,12 +243,12 @@
}
if (func != NULL) {
- func(ldata(item));
+ func(MR_dlist_data(item));
}
- llength(list)--;
- next(prev(item)) = next(item);
- prev(next(item)) = prev(item);
+ MR_dlist_length(list)--;
+ MR_dlist_next(MR_dlist_prev(item)) = MR_dlist_next(item);
+ MR_dlist_prev(MR_dlist_next(item)) = MR_dlist_prev(item);
MR_GC_free(item);
@@ -259,22 +262,22 @@
*/
void
-oldlist(List *list, void (* func)(void *))
+MR_dlist_oldlist(MR_Dlist *list, void (* func)(const void *))
{
- reg List *ptr;
- reg List *item;
+ reg MR_Dlist *ptr;
+ reg MR_Dlist *item;
if (list == NULL) {
return;
}
- ptr = next(list);
+ ptr = MR_dlist_next(list);
while (ptr != list) {
item = ptr;
- ptr = next(ptr);
+ ptr = MR_dlist_next(ptr);
if (func != NULL) {
- func(ldata(item));
+ func(MR_dlist_data(item));
}
MR_GC_free(item);
Index: runtime/mercury_dlist.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_dlist.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_dlist.h
--- runtime/mercury_dlist.h 1997/11/23 07:21:18 1.2
+++ runtime/mercury_dlist.h 2000/10/08 22:13:27
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1995-1997 The University of Melbourne.
+** Copyright (C) 1995-1997,2000 The 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.
*/
@@ -17,55 +17,70 @@
** in the header node.
*/
-typedef struct s_list {
+typedef struct MR_Dlist_Struct MR_Dlist;
+
+struct MR_Dlist_Struct {
union {
- void *l_data;
- int l_length;
- } l_union;
- struct s_list *l_prev;
- struct s_list *l_next;
-} List;
-
-#define next(ptr) (ptr)->l_next
-#define prev(ptr) (ptr)->l_prev
-#define ldata(ptr) (ptr)->l_union.l_data
-#define llength(list) ((list)->l_union.l_length)
-#define first_ptr(list) ((list)->l_next)
-#define last_ptr(list) ((list)->l_prev)
-#define first(list) ((list)->l_next->l_union.l_data)
-#define last(list) ((list)->l_prev->l_union.l_data)
-
-#define makelist(d) list_makelist(d)
-#define addhead(l, d) list_addhead(l, d)
-#define addtail(l, d) list_addtail(l, d)
-#define insert_before(l, w, d) list_insert_before(l, w, d)
-#define insert_after(l, w, d) list_insert_after(l, w, d)
-
-#define for_list(p, l) \
- for (p = (l? next(l): NULL); p != l && p != NULL; p = next(p))
-#define for_2list(p1, p2, l1, l2) \
- for ( \
- p1 = (l1? next(l1): NULL), p2 = (l2? next(l2): NULL); \
- p1 != l1 && p1 != NULL && p2 != l2 && p2 != NULL; \
- p1 = next(p1), p2 = next(p2) \
+ const void *MR_dlist_data;
+ int MR_dlist_length;
+ } MR_dlist_union;
+ MR_Dlist *MR_dlist_prev;
+ MR_Dlist *MR_dlist_next;
+};
+
+#define MR_dlist_next(ptr) (ptr)->MR_dlist_next
+#define MR_dlist_prev(ptr) (ptr)->MR_dlist_prev
+#define MR_dlist_data(ptr) (ptr)->MR_dlist_union.MR_dlist_data
+#define MR_dlist_length(list) ((list)->MR_dlist_union.MR_dlist_length)
+#define MR_dlist_first_ptr(list) ((list)->MR_dlist_next)
+#define MR_dlist_last_ptr(list) ((list)->MR_dlist_prev)
+#define MR_dlist_first(list) ((list)->MR_dlist_next-> \
+ MR_dlist_union.MR_dlist_data)
+#define MR_dlist_last(list) ((list)->MR_dlist_prev-> \
+ MR_dlist_union.MR_dlist_data)
+
+#define MR_dlist_makelist(d) MR_dlist_makelist(d)
+#define MR_dlist_addhead(l, d) MR_dlist_addhead(l, d)
+#define MR_dlist_addtail(l, d) MR_dlist_addtail(l, d)
+#define MR_dlist_insert_before(l, w, d) MR_dlist_insert_before(l, w, d)
+#define MR_dlist_insert_after(l, w, d) MR_dlist_insert_after(l, w, d)
+
+#define MR_for_dlist(p, l) \
+ for ( \
+ p = (l? MR_dlist_next(l): NULL); \
+ p != l && p != NULL; \
+ p = MR_dlist_next(p) \
+ )
+#define MR_for_2dlist(p1, p2, l1, l2) \
+ for ( \
+ p1 = (l1? MR_dlist_next(l1): NULL), \
+ p2 = (l2? MR_dlist_next(l2): NULL); \
+ p1 != l1 && p1 != NULL && p2 != l2 && p2 != NULL; \
+ p1 = MR_dlist_next(p1), p2 = MR_dlist_next(p2) \
+ )
+#define MR_for_undlist(p, np, l) \
+ for ( \
+ p = (l? MR_dlist_next(l): NULL), \
+ np = (p? MR_dlist_next(p): NULL); \
+ p != l && p != NULL; \
+ p = np, np = (p? MR_dlist_next(p): NULL) \
)
-#define for_unlist(p, np, l) \
- for (p = (l? next(l): NULL), np = (p? next(p): NULL); \
- p != l && p != NULL; \
- p = np, np = (p? next(p): NULL))
-#define end_list(p, l)\
+#define MR_end_dlist(p, l) \
(p == l || p == NULL)
-extern List *makelist0(void);
-extern List *list_makelist(void *);
-extern List *list_addhead(List *, void *);
-extern List *list_addtail(List *, void *);
-extern List *addlist(List *, List *);
-extern List *addndlist(List *, List *);
-extern void list_insert_before(List *, List *, void *);
-extern void list_insert_after(List *, List *, void *);
-extern int length(const List *);
-extern void dlist_delete(List *, List *, void (*)(void *));
-extern void oldlist(List *, void (*)(void *));
+extern MR_Dlist *MR_dlist_makelist0(void);
+extern MR_Dlist *MR_dlist_makelist(const void *);
+extern MR_Dlist *MR_dlist_addhead(MR_Dlist *, const void *);
+extern MR_Dlist *MR_dlist_addtail(MR_Dlist *, const void *);
+extern MR_Dlist *MR_dlist_addlist(MR_Dlist *, MR_Dlist *);
+extern MR_Dlist *MR_dlist_addndlist(MR_Dlist *, MR_Dlist *);
+extern void MR_dlist_insert_before(MR_Dlist *, MR_Dlist *,
+ const void *);
+extern void MR_dlist_insert_after(MR_Dlist *, MR_Dlist *,
+ const void *);
+extern int MR_dlist_maybe_null_length(const MR_Dlist *);
+extern void MR_dlist_delete(MR_Dlist *, MR_Dlist *,
+ void (*)(const void *));
+extern void MR_dlist_oldlist(MR_Dlist *, void (*)(const void *));
#endif /* not MERCURY_DLIST_H */
Index: runtime/mercury_hash_table.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_hash_table.c,v
retrieving revision 1.2
diff -u -r1.2 mercury_hash_table.c
--- runtime/mercury_hash_table.c 1999/10/18 15:46:54 1.2
+++ runtime/mercury_hash_table.c 2000/10/08 22:14:37
@@ -29,7 +29,7 @@
{
reg int i;
- table->MR_ht_store = MR_GC_NEW_ARRAY(List *, table->MR_ht_size);
+ table->MR_ht_store = MR_GC_NEW_ARRAY(MR_Dlist *, table->MR_ht_size);
for (i = 0; i < table->MR_ht_size; i++) {
table->MR_ht_store[i] = NULL;
@@ -41,11 +41,11 @@
** in a table.
*/
-void *
+const void *
MR_ht_lookup_table(const MR_Hash_Table *table, const void *key)
{
- reg List *ptr;
- reg int h;
+ reg MR_Dlist *ptr;
+ reg int h;
h = MR_tablehash(table)(key);
@@ -57,9 +57,11 @@
}
#endif
- for_list (ptr, table->MR_ht_store[h]) {
- if (MR_tableequal(table)(key, MR_tablekey(table)(ldata(ptr)))) {
- return ldata(ptr);
+ MR_for_dlist (ptr, table->MR_ht_store[h]) {
+ if (MR_tableequal(table)(key,
+ MR_tablekey(table)(MR_dlist_data(ptr))))
+ {
+ return MR_dlist_data(ptr);
}
}
@@ -74,7 +76,7 @@
bool
MR_ht_insert_table(const MR_Hash_Table *table, void *entry)
{
- reg List *ptr;
+ reg MR_Dlist *ptr;
reg const void *key;
reg int h;
@@ -89,13 +91,15 @@
}
#endif
- for_list (ptr, table->MR_ht_store[h]) {
- if (MR_tableequal(table)(key, MR_tablekey(table)(ldata(ptr)))) {
+ MR_for_dlist (ptr, table->MR_ht_store[h]) {
+ if (MR_tableequal(table)(key,
+ MR_tablekey(table)(MR_dlist_data(ptr))))
+ {
return TRUE;
}
}
- table->MR_ht_store[h] = addhead(table->MR_ht_store[h], entry);
+ table->MR_ht_store[h] = MR_dlist_addhead(table->MR_ht_store[h], entry);
return FALSE;
}
@@ -103,15 +107,15 @@
** Return all table entries in a list.
*/
-List *
+MR_Dlist *
MR_ht_get_all_entries(const MR_Hash_Table *table)
{
- reg List *list;
- reg int i;
+ reg MR_Dlist *list;
+ reg int i;
- list = makelist0();
+ list = MR_dlist_makelist0();
for (i = 0; i < table->MR_ht_size; i++) {
- addndlist(list, table->MR_ht_store[i]);
+ MR_dlist_addndlist(list, table->MR_ht_store[i]);
}
return list;
@@ -124,12 +128,12 @@
void
MR_ht_process_all_entries(const MR_Hash_Table *table, void f(const void *))
{
- reg List *ptr;
- reg int i;
+ reg MR_Dlist *ptr;
+ reg int i;
for (i = 0; i < table->MR_ht_size; i++) {
- for_list (ptr, table->MR_ht_store[i]) {
- f(ldata(ptr));
+ MR_for_dlist (ptr, table->MR_ht_store[i]) {
+ f(MR_dlist_data(ptr));
}
}
}
Index: runtime/mercury_hash_table.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_hash_table.h,v
retrieving revision 1.1
diff -u -r1.1 mercury_hash_table.h
--- runtime/mercury_hash_table.h 1998/09/15 07:19:20 1.1
+++ runtime/mercury_hash_table.h 2000/10/08 22:14:55
@@ -17,11 +17,11 @@
#define MERCURY_HASH_TABLE_H
#include "mercury_std.h" /* for bool */
-#include "mercury_dlist.h" /* for List */
+#include "mercury_dlist.h" /* for MR_Dlist */
typedef struct {
int MR_ht_size;
- List **MR_ht_store;
+ MR_Dlist **MR_ht_store;
const void *(*MR_ht_key)(const void *); /* applied to entries */
int (*MR_ht_hash)(const void *); /* applied to keys */
bool (*MR_ht_equal)(const void *, const void *);
@@ -39,12 +39,13 @@
#define MR_tablehash(table) (*(table->MR_ht_hash))
#define MR_tableequal(table) (*(table->MR_ht_equal))
-extern void MR_ht_init_table(MR_Hash_Table *);
-extern void *MR_ht_lookup_table(const MR_Hash_Table *, const void *);
-extern bool MR_ht_insert_table(const MR_Hash_Table *, void *);
-extern List *MR_ht_get_all_entries(const MR_Hash_Table *);
-extern void MR_ht_process_all_entries(const MR_Hash_Table *,
- void f(const void *));
-extern int MR_ht_str_to_int(const char *);
+extern void MR_ht_init_table(MR_Hash_Table *);
+extern const void *MR_ht_lookup_table(const MR_Hash_Table *,
+ const void *);
+extern bool MR_ht_insert_table(const MR_Hash_Table *, void *);
+extern MR_Dlist *MR_ht_get_all_entries(const MR_Hash_Table *);
+extern void MR_ht_process_all_entries(const MR_Hash_Table *,
+ void f(const void *));
+extern int MR_ht_str_to_int(const char *);
#endif /* not MERCURY_HASH_TABLE_H */
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.17
diff -u -r1.17 mercury_imp.h
--- runtime/mercury_imp.h 2000/08/11 16:50:21 1.17
+++ runtime/mercury_imp.h 2000/10/07 14:48:21
@@ -71,6 +71,7 @@
#include "mercury_context.h"
#include "mercury_thread.h"
#include "mercury_type_info.h"
+#include "mercury_type_tables.h"
#ifdef MR_USE_TRAIL
#include "mercury_trail.h"
#endif
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.28
diff -u -r1.28 mercury_tabling.c
--- runtime/mercury_tabling.c 2000/09/18 11:52:33 1.28
+++ runtime/mercury_tabling.c 2000/10/08 22:08:16
@@ -33,19 +33,19 @@
struct MR_IntHashTableSlot_Struct {
MR_IntHashTableSlot *next;
MR_TableNode data;
- MR_Integer key;
+ MR_Integer key;
};
struct MR_FloatHashTableSlot_Struct {
MR_FloatHashTableSlot *next;
MR_TableNode data;
- MR_Float key;
+ MR_Float key;
};
struct MR_StringHashTableSlot_Struct {
MR_StringHashTableSlot *next;
MR_TableNode data;
- MR_String key;
+ MR_ConstString key;
};
typedef union {
@@ -103,12 +103,12 @@
*/
struct MR_HashTable_Struct {
- MR_Integer size;
- MR_Integer threshold;
- MR_Integer value_count;
+ MR_Integer size;
+ MR_Integer threshold;
+ MR_Integer value_count;
MR_HashTableSlotPtr *hash_table;
MR_HashTableSlotPtr freespace;
- MR_Integer freeleft;
+ MR_Integer freeleft;
MR_AllocRecord *allocrecord;
};
@@ -287,8 +287,8 @@
#define MR_GENERIC_HASH_LOOKUP_OR_ADD \
MR_HashTable *table; \
table_type *slot; \
- MR_Integer abs_hash; \
- MR_Integer home; \
+ MR_Integer abs_hash; \
+ MR_Integer home; \
DECLARE_PROBE_COUNT \
\
debug_key_msg(key, key_format, key_cast); \
@@ -445,10 +445,10 @@
}
MR_TrieNode
-MR_string_hash_lookup_or_add(MR_TrieNode t, MR_String key)
+MR_string_hash_lookup_or_add(MR_TrieNode t, MR_ConstString key)
{
#define key_format "%s"
-#define key_cast char *
+#define key_cast const char *
#define table_type MR_StringHashTableSlot
#define table_field string_slot_ptr
#define hash(key) (MR_hash_string((MR_Word) key))
@@ -501,7 +501,8 @@
#define MR_START_TABLE_INIT_SIZE 1024
MR_TrieNode
-MR_int_start_index_lookup_or_add(MR_TrieNode table, MR_Integer start, MR_Integer key)
+MR_int_start_index_lookup_or_add(MR_TrieNode table,
+ MR_Integer start, MR_Integer key)
{
MR_Integer diff, size;
@@ -526,7 +527,7 @@
if (diff >= size) {
MR_TableNode *new_array;
- MR_Integer new_size, i;
+ MR_Integer new_size, i;
new_size = max(2 * size, diff + 1);
new_array = MR_TABLE_NEW_ARRAY(MR_TableNode, new_size + 1);
@@ -641,8 +642,8 @@
const MR_DuExistInfo *exist_info;
MR_TypeInfo arg_type_info;
int ptag;
- MR_Word sectag;
- MR_Word *arg_vector;
+ MR_Word sectag;
+ MR_Word *arg_vector;
int meta_args;
int i;
@@ -796,7 +797,7 @@
*/
#if 0
MR_closure closure;
- MR_Word num_hidden_args;
+ MR_Word num_hidden_args;
int i;
closure = (MR_Closure *) data;
@@ -870,7 +871,7 @@
MR_TypeInfo new_type_info;
MR_MemoryList allocated_memory_cells = NULL;
MR_ArrayType *array;
- MR_Integer array_size;
+ MR_Integer array_size;
int i;
array = (MR_ArrayType *) data;
@@ -1474,8 +1475,8 @@
MR_Subgoal *subgoal;
MR_Consumer *consumer;
MR_ConsumerList listnode;
- MR_Integer cur_gen;
- MR_Integer cur_cut;
+ MR_Integer cur_gen;
+ MR_Integer cur_cut;
MR_Word *fr;
MR_Word *prev_fr;
MR_Word *stop_addr;
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.22
diff -u -r1.22 mercury_tabling.h
--- runtime/mercury_tabling.h 2000/08/03 06:18:59 1.22
+++ runtime/mercury_tabling.h 2000/10/08 22:00:31
@@ -7,9 +7,9 @@
/*
** mercury_tabling.h - definitions of some basic stuff used for tabling.
** For tabling code, the Mercury compiler (compiler/table_gen.m) generates
-** references to special procedures defined in library/private_builtin.m.
+** references to special procedures defined in library/table_builtin.m.
** The types and macros defined here are used by the procedures defined in
-** library/private_builtin.m.
+** library/table_builtin.m.
*/
#ifndef MERCURY_TABLING_H
@@ -19,6 +19,7 @@
#include "mercury_type_info.h"
#include "mercury_float.h"
#include "mercury_reg_workarounds.h"
+#include "mercury_dlist.h"
#ifndef CONSERVATIVE_GC
#include "mercury_deep_copy.h"
@@ -123,16 +124,21 @@
** there will be no insertions into the same (or any other) table between
** getting back a tip node on the one hand and updating it and releasing the
** pointer to it on the other hand.
+**
+** NOTE: the mercury_type_tables module uses the expandable hash table routines
+** defined in this module to implement its tables. This is the only use of the
+** MR_type_table field.
*/
union MR_TableNode_Union {
- MR_Integer MR_integer;
+ MR_Integer MR_integer;
MR_HashTable *MR_hash_table;
MR_TableNode *MR_fix_table;
MR_TableNode *MR_start_table;
MR_Unsigned MR_simpletable_status;
MR_Subgoal *MR_subgoal;
MR_Word *MR_answerblock;
+ MR_Dlist *MR_type_table;
};
#define MR_SIMPLETABLE_UNINITIALIZED 0
@@ -147,7 +153,7 @@
} MR_SubgoalStatus;
struct MR_AnswerListNode_Struct {
- MR_Integer answer_num;
+ MR_Integer answer_num;
MR_TableNode answer_data; /* always uses the MR_answerblock member */
MR_AnswerList next_answer;
};
@@ -182,31 +188,31 @@
*/
typedef struct {
- MR_Code *succ_ip;
- MR_Word *s_p;
- MR_Word *cur_fr;
- MR_Word *max_fr;
- MR_Word *non_stack_block_start;
- MR_Word non_stack_block_size;
- MR_Word *non_stack_block;
- MR_Word *det_stack_block_start;
- MR_Word det_stack_block_size;
- MR_Word *det_stack_block;
- MR_Integer gen_next;
- char *generator_stack_block;
- MR_Integer cut_next;
- char *cut_stack_block;
+ MR_Code *succ_ip;
+ MR_Word *s_p;
+ MR_Word *cur_fr;
+ MR_Word *max_fr;
+ MR_Word *non_stack_block_start;
+ MR_Word non_stack_block_size;
+ MR_Word *non_stack_block;
+ MR_Word *det_stack_block_start;
+ MR_Word det_stack_block_size;
+ MR_Word *det_stack_block;
+ MR_Integer gen_next;
+ char *generator_stack_block;
+ MR_Integer cut_next;
+ char *cut_stack_block;
} MR_SavedState;
/* The state of a consumer subgoal */
typedef struct {
- MR_SavedState saved_state;
- MR_AnswerList *remaining_answer_list_ptr;
+ MR_SavedState saved_state;
+ MR_AnswerList *remaining_answer_list_ptr;
} MR_Consumer;
struct MR_ConsumerListNode_Struct {
- MR_Consumer *item;
- MR_ConsumerList next;
+ MR_Consumer *item;
+ MR_ConsumerList next;
};
/*
@@ -238,9 +244,9 @@
MR_ResumeInfo *resume_info;
MR_Word answer_table; /* Table of answers returned */
/* by the subgoal */
- MR_Integer num_ans; /* # of answers returned */
+ MR_Integer num_ans; /* # of answers returned */
/* by the subgoal */
- MR_Integer num_committed_ans;
+ MR_Integer num_committed_ans;
/* # of answers our leader */
/* is committed to returning */
/* to every consumer. */
@@ -283,7 +289,7 @@
extern MR_TrieNode MR_float_hash_lookup_or_add(MR_TrieNode table,
MR_Float key);
extern MR_TrieNode MR_string_hash_lookup_or_add(MR_TrieNode table,
- MR_String key);
+ MR_ConstString key);
/*
** This function assumes that the table is a statically sized array,
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.40
diff -u -r1.40 mercury_type_info.c
--- runtime/mercury_type_info.c 2000/09/18 11:52:34 1.40
+++ runtime/mercury_type_info.c 2000/10/07 18:26:28
@@ -5,7 +5,7 @@
*/
/*
-** type_info.c -
+** mercury_type_info.c -
** Definitions for dealing with type_infos needed by the Mercury
** runtime system.
*/
@@ -35,7 +35,7 @@
#define ALLOCATE_WORDS(target, size) \
do { \
MR_MemoryList node; \
- (target) = MR_GC_NEW_ARRAY(MR_Word, \
+ (target) = MR_GC_NEW_ARRAY(MR_Word, \
(size)); \
node = MR_GC_malloc(sizeof(*node)); \
node->data = (target); \
@@ -57,7 +57,7 @@
#define MAYBE_DECLARE_ALLOC_ARG
#define MAYBE_PASS_ALLOC_ARG
#define ALLOCATE_WORDS(target, size) \
- incr_saved_hp(LVALUE_CAST(MR_Word, (target)), \
+ incr_saved_hp(LVALUE_CAST(MR_Word, (target)), \
(size))
#include "mercury_make_type_info_body.h"
#undef usual_func
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.56
diff -u -r1.56 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/09/25 04:37:25 1.56
+++ runtime/mercury_type_info.h 2000/10/08 22:00:22
@@ -138,7 +138,7 @@
#define MR_HIGHER_ORDER_TYPEINFO_STRUCT(NAME, ARITY) \
struct NAME { \
MR_TypeCtorInfo MR_ti_type_ctor_info; \
- MR_Integer MR_ti_higher_order_arity; \
+ MR_Integer MR_ti_higher_order_arity; \
MR_TypeInfo MR_ti_higher_order_arg_typeinfos[ARITY]; \
}
@@ -152,7 +152,7 @@
#define MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
struct NAME { \
MR_TypeCtorInfo MR_pti_type_ctor_info; \
- MR_Integer MR_pti_higher_order_arity; \
+ MR_Integer MR_pti_higher_order_arity; \
MR_PseudoTypeInfo MR_pti_higher_order_arg_pseudo_typeinfos[ARITY]; \
}
@@ -345,7 +345,7 @@
#define UNIV_OFFSET_FOR_DATA 1
#define MR_unravel_univ(univ, typeinfo, value) \
- do { \
+ do { \
typeinfo = (MR_TypeInfo) MR_field(MR_mktag(0), (univ), \
UNIV_OFFSET_FOR_TYPEINFO); \
value = MR_field(MR_mktag(0), (univ), \
@@ -773,7 +773,7 @@
*/
typedef void *MR_ProcAddr;
#else
- typedef MR_Code *MR_ProcAddr;
+ typedef MR_Code *MR_ProcAddr;
#endif
/*---------------------------------------------------------------------------*/
@@ -1113,4 +1113,4 @@
/*---------------------------------------------------------------------------*/
-#endif /* not MERCURY_TYPEINFO_H */
+#endif /* not MERCURY_TYPE_INFO_H */
Index: runtime/mercury_type_tables.c
===================================================================
RCS file: mercury_type_tables.c
diff -N mercury_type_tables.c
--- /dev/null Thu Sep 2 15:00:04 1999
+++ mercury_type_tables.c Mon Oct 9 20:42:01 2000
@@ -0,0 +1,81 @@
+/*
+** Copyright (C) 2000 The 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.
+*/
+
+/*
+** This module manages tables that list the definitions of the types (and
+** eventually type class instances) defined in the program.
+**
+** The sizes of these tables can vary by several orders of magnitude,
+** so using a fixed size hash table would not be a good idea. This is why
+** we build on the implementation of expandable hash tables in the
+** mercury_tabling module.
+*/
+
+#ifndef MR_HIGHLEVEL_CODE
+ #include "mercury_imp.h"
+#endif
+#include "mercury_type_info.h"
+#include "mercury_type_tables.h"
+#include "mercury_tabling.h"
+
+static MR_TableNode MR_type_ctor_table = { 0 };
+
+#define names_match(tc1, name, module_name) \
+ ( streq(tc1->type_ctor_name, name) \
+ && streq(tc1->type_ctor_module_name, module_name))
+
+#define names_match_tc(tc1, tc2) \
+ ( streq(tc1->type_ctor_name, tc2->type_ctor_name) \
+ && streq(tc1->type_ctor_module_name, tc2->type_ctor_module_name))
+
+void
+MR_register_type_ctor_info(MR_TypeCtorInfo type_ctor_info)
+{
+ MR_TrieNode slot;
+ MR_Dlist *element_ptr;
+ MR_TypeCtorInfo cur_type_ctor_info;
+
+ slot = MR_string_hash_lookup_or_add(&MR_type_ctor_table,
+ type_ctor_info->type_ctor_name);
+
+ MR_for_dlist (element_ptr, slot->MR_type_table) {
+ cur_type_ctor_info =
+ (MR_TypeCtorInfo) MR_dlist_data(element_ptr);
+
+ if (names_match_tc(type_ctor_info, cur_type_ctor_info)) {
+ if (cur_type_ctor_info == type_ctor_info) {
+ /* type_ctor_info has been registered before */
+ return;
+ } else {
+ fatal_error("MR_register_type_ctor_info: ambiguous type ctor");
+ }
+ }
+ }
+
+ slot->MR_type_table = MR_dlist_addhead(slot->MR_type_table,
+ type_ctor_info);
+}
+
+MR_TypeCtorInfo
+MR_lookup_type_ctor_info(const char *module_name, const char *name)
+{
+ MR_TrieNode slot;
+ MR_Dlist *element_ptr;
+ MR_TypeCtorInfo cur_type_ctor_info;
+
+ slot = MR_string_hash_lookup_or_add(&MR_type_ctor_table, name);
+
+ MR_for_dlist (element_ptr, slot->MR_type_table) {
+ cur_type_ctor_info =
+ (MR_TypeCtorInfo) MR_dlist_data(element_ptr);
+
+ if (names_match(cur_type_ctor_info, name, module_name)) {
+ return cur_type_ctor_info;
+ }
+ }
+
+ return NULL;
+}
Index: runtime/mercury_type_tables.h
===================================================================
RCS file: mercury_type_tables.h
diff -N mercury_type_tables.h
--- /dev/null Thu Sep 2 15:00:04 1999
+++ mercury_type_tables.h Mon Oct 9 16:12:05 2000
@@ -0,0 +1,23 @@
+/*
+** Copyright (C) 2000 The 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.
+*/
+
+/*
+** mercury_type_tables.h -
+** This module manages tables that list the definitions of the types and
+** type class instances defined in the program.
+*/
+
+#ifndef MERCURY_TYPE_TABLES_H
+#define MERCURY_TYPE_TABLES_H
+
+#include "mercury_type_info.h"
+
+extern void MR_register_type_ctor_info(
+ MR_TypeCtorInfo type_ctor_info);
+extern MR_TypeCtorInfo MR_lookup_type_ctor_info(const char *module_name,
+ const char *name);
+
+#endif /* not MERCURY_TYPE_TABLES */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.71
diff -u -r1.71 mercury_wrapper.c
--- runtime/mercury_wrapper.c 2000/09/14 04:31:25 1.71
+++ runtime/mercury_wrapper.c 2000/10/06 23:30:28
@@ -171,6 +171,8 @@
void (*address_of_mercury_init_io)(void);
void (*address_of_init_modules)(void);
+void (*address_of_init_modules_type_tables)(void);
+void (*address_of_init_modules_debugger)(void);
int (*MR_address_of_do_load_aditi_rl_code)(void);
@@ -422,6 +424,30 @@
if (! done) {
(*address_of_init_modules)();
+ MR_close_prof_decl_file();
+ done = TRUE;
+ }
+}
+
+void
+do_init_modules_type_tables(void)
+{
+ static bool done = FALSE;
+
+ if (! done) {
+ (*address_of_init_modules_type_tables)();
+ MR_close_prof_decl_file();
+ done = TRUE;
+ }
+}
+
+void
+do_init_modules_debugger(void)
+{
+ static bool done = FALSE;
+
+ if (! done) {
+ (*address_of_init_modules_debugger)();
MR_close_prof_decl_file();
done = TRUE;
}
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.34
diff -u -r1.34 mercury_wrapper.h
--- runtime/mercury_wrapper.h 2000/08/26 04:34:01 1.34
+++ runtime/mercury_wrapper.h 2000/10/06 23:30:35
@@ -81,6 +81,8 @@
extern void (*address_of_mercury_init_io)(void);
extern void (*address_of_init_modules)(void);
+extern void (*address_of_init_modules_type_tables)(void);
+extern void (*address_of_init_modules_debugger)(void);
#ifdef CONSERVATIVE_GC
extern void (*address_of_init_gc)(void);
@@ -152,6 +154,8 @@
extern void (*MR_register_module_layout)(const MR_Module_Layout *);
extern void do_init_modules(void);
+extern void do_init_modules_type_tables(void);
+extern void do_init_modules_debugger(void);
extern const char *progname;
extern int mercury_argc;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.90
diff -u -r1.90 Mmakefile
--- tests/hard_coded/Mmakefile 2000/09/25 04:23:16 1.90
+++ tests/hard_coded/Mmakefile 2000/10/09 05:14:27
@@ -108,6 +108,7 @@
test_imported_no_tag \
tim_qual1 \
type_qual \
+ type_tables \
type_to_term_bug \
tuple_test \
user_defined_equality \
Index: tests/hard_coded/type_tables.exp
===================================================================
RCS file: type_tables.exp
diff -N type_tables.exp
--- /dev/null Thu Sep 2 15:00:04 1999
+++ type_tables.exp Mon Oct 9 16:14:42 2000
@@ -0,0 +1,2 @@
+list list
+type_tables list
Index: tests/hard_coded/type_tables.m
===================================================================
RCS file: type_tables.m
diff -N type_tables.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ type_tables.m Mon Oct 9 15:49:58 2000
@@ -0,0 +1,32 @@
+% Test case for runtime/mercury_type_tables.h
+%
+% Author: zs
+
+:- module type_tables.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+:- type list ---> a ; b.
+
+:- pragma(c_code, main(IO0::di, IO::uo), "
+extern const struct MR_TypeCtorInfo_Struct mercury_data_list__type_ctor_info_list_1;
+extern const struct MR_TypeCtorInfo_Struct mercury_data_type_tables__type_ctor_info_list_0;
+ MR_TypeCtorInfo tc1;
+ MR_TypeCtorInfo tc2;
+
+ MR_register_type_ctor_info(&mercury_data_list__type_ctor_info_list_1);
+ MR_register_type_ctor_info(&mercury_data_type_tables__type_ctor_info_list_0);
+
+ tc1 = MR_lookup_type_ctor_info(""list"", ""list"");
+ tc2 = MR_lookup_type_ctor_info(""type_tables"", ""list"");
+
+ printf(""%s %s\n"", tc1->type_ctor_module_name, tc1->type_ctor_name);
+ printf(""%s %s\n"", tc2->type_ctor_module_name, tc2->type_ctor_name);
+ IO = IO0;
+").
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trax
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list