[m-rev.] [reuse] diff: use mlds instrs to remove tag for delete_object

[Peter Ross]

Hi,

Tyson could you please tell me the correct fix to mlds_to_il.m?

===================================================================


Estimated hours taken: 2
Branches: reuse

Remove the tag on the cell to be compile time gc'd using mlds
instructions.

compiler/ml_unify_gen.m:
    Determine and strip the tag off the pointer to the cell to be cgc'd.

compiler/mlds.m:
    Record the cell to be cgc'd as an rval so that we can strip the tag
    off.

compiler/mlds_to_c.m:
compiler/mlds_to_il.m:
compiler/ml_elim_nested.m:
    Handle the changes to the delete_object instruction.



Index: ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.11.2.7
diff -u -r1.11.2.7 ml_elim_nested.m
--- ml_elim_nested.m	2001/03/18 16:56:49	1.11.2.7
+++ ml_elim_nested.m	2001/03/19 11:55:14
@@ -911,8 +911,8 @@
 fixup_atomic_stmt(assign(Lval0, Rval0), assign(Lval, Rval)) -->
 	fixup_lval(Lval0, Lval),
 	fixup_rval(Rval0, Rval).
-fixup_atomic_stmt(delete_object(Lval0, Size), delete_object(Lval, Size)) -->
-	fixup_lval(Lval0, Lval).
+fixup_atomic_stmt(delete_object(Rval0, Size), delete_object(Rval, Size)) -->
+	fixup_rval(Rval0, Rval).
 fixup_atomic_stmt(new_object(Target0, MaybeTag, Type, MaybeSize, MaybeCtorName,
 			Args0, ArgTypes),
 		new_object(Target, MaybeTag, Type, MaybeSize, MaybeCtorName,
Index: ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.16.2.15
diff -u -r1.16.2.15 ml_unify_gen.m
--- ml_unify_gen.m	2001/03/18 17:44:58	1.16.2.15
+++ ml_unify_gen.m	2001/03/19 11:55:15
@@ -163,6 +163,9 @@
 		%
 		{ CanCGC = yes },
 		ml_gen_var(Var, VarLval),
+		ml_variable_type(Var, Type),
+		ml_cons_id_to_tag(ConsId, Type, Tag),
+		{ MaybePrimaryTag = ml_primary_tag(Tag) },
 		{ 
 			HasSecondaryTag = yes,
 			SecondaryTagSize = 1
@@ -170,7 +173,15 @@
 			HasSecondaryTag = no,
 			SecondaryTagSize = 0
 		},
-		{ MLDS_Stmt = atomic(delete_object(VarLval,
+		{	
+			MaybePrimaryTag = yes(PrimaryTag),
+			Rval = binop(body, lval(VarLval),
+					ml_gen_mktag(PrimaryTag))
+		;
+			MaybePrimaryTag = no,
+			Rval = lval(VarLval)
+		},
+		{ MLDS_Stmt = atomic(delete_object(Rval,
 				list__length(Args) + SecondaryTagSize)) },
 		{ MLDS_CGC_Statements = [mlds__statement(MLDS_Stmt,
 				mlds__make_context(Context)) ] }
@@ -1427,6 +1438,21 @@
 		Tag = shared_local_tag(_Bits1, _Num1),
 		error("ml_tag_offset_and_argnum")
 	).
+
+:- func ml_primary_tag(cons_tag) = maybe(tag_bits).
+
+ml_primary_tag(unshared_tag(UnsharedTag)) = yes(UnsharedTag).
+ml_primary_tag(shared_remote_tag(PrimaryTag, _SecondaryTag)) = yes(PrimaryTag).
+ml_primary_tag(string_constant(_)) = no.
+ml_primary_tag(int_constant(_)) = no.
+ml_primary_tag(float_constant(_)) = no.
+ml_primary_tag(pred_closure_tag(_, _, _)) = no.
+ml_primary_tag(code_addr_constant(_, _)) = no.
+ml_primary_tag(type_ctor_info_constant(_, _, _)) = no.
+ml_primary_tag(base_typeclass_info_constant(_, _, _)) = no.
+ml_primary_tag(tabling_pointer_constant(_, _)) = no.
+ml_primary_tag(no_tag) = no.
+ml_primary_tag(shared_local_tag(_, _)) = no.
 
 
 	% Given a type and a cons_id, and also the types of the actual
Index: mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.34.2.6
diff -u -r1.34.2.6 mlds.m
--- mlds.m	2001/03/18 16:56:50	1.34.2.6
+++ mlds.m	2001/03/19 11:55:15
@@ -963,7 +963,7 @@
 	% heap management
 	%
 
-	;	delete_object(mlds__lval, int)
+	;	delete_object(mlds__rval, int)
 			% Compile time garbage collect (ie explicitly
 			% deallocate) the memory used by the lval of 
 			% the size recorded in the integer.
Index: mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.55.2.10
diff -u -r1.55.2.10 mlds_to_c.m
--- mlds_to_c.m	2001/03/19 06:28:15	1.55.2.10
+++ mlds_to_c.m	2001/03/19 11:55:17
@@ -2390,11 +2390,11 @@
 	%
 	% heap management
 	%
-mlds_output_atomic_stmt(Indent, _FuncInfo, delete_object(Lval, Size), _) -->
+mlds_output_atomic_stmt(Indent, _FuncInfo, delete_object(Rval, Size), _) -->
 	mlds_indent(Indent),
-	io__write_string("MR_compile_time_gc(MR_strip_tag("),
-	mlds_output_lval(Lval),
-	io__write_string("), "),
+	io__write_string("MR_compile_time_gc("),
+	mlds_output_rval(Rval),
+	io__write_string(", "),
 	io__write_int(Size),
 	io__write_string(");\n").
 
Index: mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.6.2.7
diff -u -r1.6.2.7 mlds_to_il.m
--- mlds_to_il.m	2001/03/18 17:45:00	1.6.2.7
+++ mlds_to_il.m	2001/03/19 11:55:18
@@ -991,7 +991,7 @@
 atomic_statement_to_il(comment(Comment), Instrs) -->
 	{ Instrs = node([comment(Comment)]) }.
 
-atomic_statement_to_il(delete_object(Target, _Size), Instrs) -->
+atomic_statement_to_il(delete_object(_Target, _Size), _Instrs) -->
 		% XXX we assume the code generator knows what it is
 		% doing and is only going to delete real objects (e.g.
 		% reference types).  It would perhaps be prudent to
@@ -1001,8 +1001,9 @@
 		% We implement delete_object by storing null in the
 		% lval, which hopefully gives the garbage collector a good
 		% solid hint that this storage is no longer required.
-	get_load_store_lval_instrs(Target, LoadInstrs, StoreInstrs),
-	{ Instrs = tree__list([LoadInstrs, instr_node(ldnull), StoreInstrs]) }.
+	{ error("atomic_statement_to_il: delete object NYI") }.
+	%get_load_store_lval_instrs(Target, LoadInstrs, StoreInstrs),
+	%{ Instrs = tree__list([LoadInstrs, instr_node(ldnull), StoreInstrs]) }.
 
 atomic_statement_to_il(new_object(Target, _MaybeTag, Type, Size, _CtorName,
 		Args, ArgTypes), Instrs) -->

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