2016-05-03 Basile Starynkevitch <basile@starynkevitch.net>

	* melt/warmelt-modes.melt (generate_runtypesupport_forwcopy_fun)
	In the generated melt_forwarded_copy handle the unlikely case of
	young discriminant which should be forwarded after copying the
	original object.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@235810 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 32 insertions, 64 deletions

diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT
index 2267fa784c7..9151bcbd459 100644
--- a/gcc/ChangeLog.MELT
+++ b/gcc/ChangeLog.MELT
@@ -1,5 +1,11 @@
 
 2016-05-03   Basile Starynkevitch  <basile@starynkevitch.net>
+	* melt/warmelt-modes.melt (generate_runtypesupport_forwcopy_fun)
+	In the generated melt_forwarded_copy handle the unlikely case of
+	young discriminant which should be forwarded after copying the
+	original object.
+
+2016-05-03   Basile Starynkevitch  <basile@starynkevitch.net>
 	* melt-runtime.h (MELT_ALIGN, MELT_LIKELY, MELT_UNLIKELY):
 	Moved before.
 
diff --git a/gcc/melt/warmelt-modes.melt b/gcc/melt/warmelt-modes.melt
index 4b775abad11..7321ba26d19 100644
--- a/gcc/melt/warmelt-modes.melt
+++ b/gcc/melt/warmelt-modes.melt
@@ -2422,6 +2422,9 @@ typedef melt_ptr_t meltroutfun_t (struct meltclosure_st* meltclosp_,
 
 
 
+
+
+
 ;; internal function to generate the forwarding copy function
 (defun generate_runtypesupport_forwcopy_fun (ctygtytup
 					     valdesctup
@@ -2435,14 +2438,18 @@ typedef melt_ptr_t meltroutfun_t (struct meltclosure_st* meltclosp_,
 ;;;;;;;;;;;;;;;;
   (add2sbuf_indentnl outbuf 0)
   (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
   (add2sbuf_strconst outbuf "/** generated by generate_runtypesupport_forwcopy_fun **/")
   (add2sbuf_indentnl outbuf 0)
   (add2sbuf_string outbuf #{$'
-/* cheney like forwarding generated function */
+/* cheney like forwarding generated function (emitted in warmelt-modes)*/
 melt_ptr_t 
 melt_forwarded_copy (melt_ptr_t p)
 { /* header generated by generate_runtypesupport_forwcopy_fun */
-  melt_ptr_t n = 0;
+  melt_ptr_t n = NULL;
   int mag = 0;
   gcc_assert (melt_is_young (p));
   gcc_assert (p->u_discr && p->u_discr != MELT_FORWARDED_DISCR);
@@ -2453,7 +2460,7 @@ melt_forwarded_copy (melt_ptr_t p)
   else
     mag = p->u_discr->meltobj_magic;
   melt_forward_counter++;
-  switch (mag) { /* end of generated header */
+  switch (mag) { /* end of generated header of melt_forwarded_copy */
 }#)
   (add2sbuf_indentnl outbuf 1)
   (add2sbuf_strconst 
@@ -2518,8 +2525,6 @@ melt_forwarded_copy (melt_ptr_t p)
    (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
    (add2sbuf_strconst outbuf " should be generated by gengtype not by runtypesupport_forwcopy */")
    (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#if GCCPLUGIN_VERSION >= 5000 /* GCC 5.0 */")
-   (add2sbuf_indentnl outbuf 0)
    (add2sbuf_strconst outbuf "#ifndef ggc_alloc_")
    (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
    (add2sbuf_indentnl outbuf 0)
@@ -2534,25 +2539,6 @@ melt_forwarded_copy (melt_ptr_t p)
    (add2sbuf_strconst outbuf "#endif /* ggc_alloc_")
    (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
    (add2sbuf_strconst outbuf " */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#else /* GCC 4.9 */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#ifndef ggc_alloc_")
-   (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#define ggc_alloc_")
-   (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
-   (add2sbuf_strconst outbuf "() ((struct ")
-   (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
-   (add2sbuf_strconst outbuf "*)(ggc_internal_alloc_stat (sizeof (struct ")
-   (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
-   (add2sbuf_strconst outbuf ") MEM_STAT_INFO)))")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#endif /* ggc_alloc_")
-   (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
-   (add2sbuf_strconst outbuf " */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#endif /* GCC 4.9 or 5.0 */")
    (add2sbuf_indentnl outbuf 2)
    (add2sbuf_strconst outbuf "struct ")
    (add2sbuf_string outbuf (get_field :ctypg_boxedstruct curctyp))
@@ -2582,8 +2568,6 @@ melt_forwarded_copy (melt_ptr_t p)
    (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
    (add2sbuf_strconst outbuf " should be generated by gengtype not by runtypesupport_forwcopy */")
    (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#if GCCPLUGIN_VERSION >= 5000 /* GCC 5.0 */")
-   (add2sbuf_indentnl outbuf 0)
    (add2sbuf_strconst outbuf "#ifndef ggc_alloc_")
    (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
    (add2sbuf_indentnl outbuf 0)
@@ -2598,25 +2582,6 @@ melt_forwarded_copy (melt_ptr_t p)
    (add2sbuf_strconst outbuf "#endif /* ggc_alloc_")
    (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
    (add2sbuf_strconst outbuf " */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#else /* GCC 4.9 */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#ifndef ggc_alloc_")
-   (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#define ggc_alloc_")
-   (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
-   (add2sbuf_strconst outbuf "() ((struct ")
-   (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
-   (add2sbuf_strconst outbuf "*) (ggc_internal_alloc_stat (sizeof (struct ")
-   (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
-   (add2sbuf_strconst outbuf ") MEM_STAT_INFO))) ")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#endif /* ggc_alloc_")
-   (add2sbuf_string outbuf (get_field :ctypg_mapstruct curctyp))
-   (add2sbuf_strconst outbuf " */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#endif /* GCC 4.9 or 5.0 */")
    ;;
    (add2sbuf_indentnl outbuf 0)
    (add2sbuf_indentnl outbuf 0)
@@ -2624,8 +2589,6 @@ melt_forwarded_copy (melt_ptr_t p)
    (add2sbuf_string outbuf (get_field :ctypg_entrystruct curctyp))
    (add2sbuf_strconst outbuf " should be generated by gengtype not by runtypesupport_forwcopy */")
    (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#if GCCPLUGIN_VERSION >= 5000 /* GCC 5.0 */")
-   (add2sbuf_indentnl outbuf 0)
    (add2sbuf_strconst outbuf "#ifndef ggc_alloc_vec_")
    (add2sbuf_string outbuf (get_field :ctypg_entrystruct curctyp))
    (add2sbuf_indentnl outbuf 0)
@@ -2639,22 +2602,6 @@ melt_forwarded_copy (melt_ptr_t p)
    (add2sbuf_indentnl outbuf 0)
    (add2sbuf_strconst outbuf "#endif")
    (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#else /* GCC 4.9 */")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#ifndef ggc_alloc_vec_")
-   (add2sbuf_string outbuf (get_field :ctypg_entrystruct curctyp))
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#define ggc_alloc_vec_")
-   (add2sbuf_string outbuf (get_field :ctypg_entrystruct curctyp))
-   (add2sbuf_strconst outbuf "(n) ((struct ")
-   (add2sbuf_string outbuf (get_field :ctypg_entrystruct curctyp))
-   (add2sbuf_strconst outbuf "*) (ggc_internal_vec_alloc_stat (sizeof (struct ")
-   (add2sbuf_string outbuf (get_field :ctypg_entrystruct curctyp))
-   (add2sbuf_strconst outbuf "), n MEM_STAT_INFO))) ")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#endif")
-   (add2sbuf_indentnl outbuf 0)
-   (add2sbuf_strconst outbuf "#endif /* GCC 4.9 or 5.0 */")
    ;;
    (add2sbuf_indentnl outbuf 2)
    (add2sbuf_strconst outbuf "struct ")
@@ -2708,7 +2655,18 @@ melt_forwarded_copy (melt_ptr_t p)
 			  melt_nb_garbcoll, melt_forward_counter, (void*)p, 
                           (void*)n, melt_obmag_string (mag));
   if (n)
-    {
+  {
+    gcc_assert (n->u_discr != NULL);
+    gcc_assert (n->u_discr != MELT_FORWARDED_DISCR);
+    if (MELT_UNLIKELY(melt_is_young(n->u_discr)))
+      {
+        melt_debuggc_eprintf ("melt_forwarded_copy#%ld/%04ld n@%p youngdiscr@%p",
+			      melt_nb_garbcoll, melt_forward_counter, (void*)n,
+			      (void*)(n->u_discr));
+	n->u_discr = (meltobject_ptr_t)
+	    melt_forwarded_copy ((melt_ptr_t)(p->u_discr));
+      };
+    
 #if MELT_HAVE_DEBUG
       if (melt_alptr_1 && (void*)melt_alptr_1 == (void*)n) 
 	{
@@ -2752,7 +2710,11 @@ melt_forwarded_copy (melt_ptr_t p)
   (add2sbuf_strconst outbuf "/** end of code generated by generate_runtypesupport_forwcopy_fun **/")
   (add2sbuf_indentnl outbuf 0)
   (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
   )
+
+