2010-09-19 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 164348, with some improvements
	in gcc/melt-runtime.[ch]

2010-09-19  Basile Starynkevitch  <basile@starynkevitch.net>
	[[merged with trunk rev.164348, so improved MELT runtime!]]
	* gcc/melt-runtime.h: improved comments.
	(melt_debug_garbcoll, melt_debuggc_eprintf):  Moved from melt-runtime.c.
	(melt_obmag_string): New declaration.
	(struct meltobject_st, struct meltclosure_st, struct
	meltroutine_st, struct meltmixbigint_st, struct meltstring_st):
	using GTY variable_size and @@MELTGTY@@ comment.
	(melt_mark_special): added debug print.

	* gcc/melt-runtime.c:  Improved comments.
	Include bversion.h, realmpfr.h, gimple-pretty-print.h.
	(ggc_force_collect) Declared external.
	(melt_forward_counter): Added.
	(melt_obmag_string): New function.
	(melt_alptr_1, melt_alptr_2, melt_break_alptr_1_at)
	(melt_break_alptr_2_at, melt_break_alptr_1,melt_break_alptr_1)
	(melt_allocate_young_gc_zone, melt_free_young_gc_zone): New.
	(delete_special, meltgc_make_special): Improved debug printf and
	use melt_break_alptr_1...
	(ggc_alloc_*) macros defined for backport to GCC 4.5
	(melt_forwarded_copy): Don't clear the new destination zone in old
	GGC heap.
	(meltgc_add_out_raw_len): Use ggc_alloc_atomic.
	(meltgc_raw_new_mappointers, meltgc_raw_put_mappointers)
	(meltgc_raw_remove_mappointers): Corrected length argument to
	ggc_alloc_cleared_vec_entrypointermelt_st.
	(melt_really_initialize): Call melt_allocate_young_gc_zone.
	(melt_initialize):  Set flag_plugin_added.
	(melt_val2passflag): TODO_verify_loops only in GCC 4.5




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

1 files changed, 43 insertions, 2 deletions

diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb
index 8d27395ddde..8b19f9190db 100644
--- a/gcc/ada/exp_tss.adb
+++ b/gcc/ada/exp_tss.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -109,6 +109,35 @@ package body Exp_Tss is
       Prepend_Elmt (TSS, TSS_Elist (FN));
    end Copy_TSS;
 
+   -------------------
+   -- CPP_Init_Proc --
+   -------------------
+
+   function CPP_Init_Proc (Typ  : Entity_Id) return Entity_Id is
+      FN   : constant Node_Id := Freeze_Node (Typ);
+      Elmt : Elmt_Id;
+
+   begin
+      if not Is_CPP_Class (Root_Type (Typ))
+        or else No (FN)
+        or else No (TSS_Elist (FN))
+      then
+         return Empty;
+
+      else
+         Elmt := First_Elmt (TSS_Elist (FN));
+         while Present (Elmt) loop
+            if Is_CPP_Init_Proc (Node (Elmt)) then
+               return Node (Elmt);
+            end if;
+
+            Next_Elmt (Elmt);
+         end loop;
+      end if;
+
+      return Empty;
+   end CPP_Init_Proc;
+
    ------------------------
    -- Find_Inherited_TSS --
    ------------------------
@@ -276,6 +305,18 @@ package body Exp_Tss is
       return Empty;
    end Init_Proc;
 
+   ----------------------
+   -- Is_CPP_Init_Proc --
+   ----------------------
+
+   function Is_CPP_Init_Proc (E : Entity_Id) return Boolean is
+      C1 : Character;
+      C2 : Character;
+   begin
+      Get_Last_Two_Chars (Chars (E), C1, C2);
+      return C1 = TSS_CPP_Init_Proc (1) and then C2 = TSS_CPP_Init_Proc (2);
+   end Is_CPP_Init_Proc;
+
    ------------------
    -- Is_Init_Proc --
    ------------------
@@ -393,7 +434,7 @@ package body Exp_Tss is
       --  Skip this for Init_Proc with No_Default_Initialization, since the
       --  Init proc is a dummy void entity in this case to be ignored.
 
-      if Is_Init_Proc (TSS)
+      if (Is_Init_Proc (TSS) or else Is_CPP_Init_Proc (TSS))
         and then Restriction_Active (No_Default_Initialization)
       then
          null;