a-ngcoty.adb: New pragma Fast_Math

2007-12-06  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* a-ngcoty.adb: New pragma Fast_Math

	* opt.adb: New pragma Fast_Math

	* par-prag.adb: 
	Add Implemented_By_Entry to the list of pragmas which do not require any
	special processing.
	(Favor_Top_Level): New pragma.
	New pragma Fast_Math

	* exp_attr.adb: Move Wide_[Wide_]Image routines to Exp_Imgv
	(Expand_N_Attribute_Reference, Displace_Allocator_Pointer,
	Expand_Allocator_Expression): Take into account VM_Target
	(Expand_Attribute, case 'Identity):  Handle properly the case where
	the prefix is a task interface.
	New pragma Fast_Math

	* par.adb (Next_Token_Is): New function
	(P_Pragma): Add Skipping parameter
	(U_Left_Paren): New procedure
	(U_Right_Paren): New procedure
	New pragma Fast_Math

	* par-ch10.adb (P_Subunit): Unconditional msg for missing ) after
	subunit
	New pragma Fast_Math

	* sem_prag.adb: Add significance value to table Sig_Flag for pragma
	Implemented_By_Entry.
	(Analyze_Pragma): Add case for Ada 2005 pragma Implemented_By_Entry.
	(Set_Inline_Flags): Do not try to link pragma Inline onto chain of rep
	items, since it can apply to more than one overloadable entity. Set
	new flag Has_Pragma_Inline_Always for Inline_Always case.
	(Analyze_Pragma, case Complex_Representation): Improve error message.
	(Analyze_Pragma, case Assert): When assertions are disabled build the
	rewritten code with Sloc of expression rather than pragma, so new
	warning about failing is not deleted.
	(Analyze_Pragma): Allow pragma Preelaborable_Initialization to apply to
	protected types and update error message to reflect that. Test whether
	the protected type is allowed for the pragma (an error is issued if the
	type has any entries, or components that do not have preelaborable
	initialization).
	New pragma Fast_Math
	(Analyze_Pragma, case No_Return): Handle generic instance

	* snames.h, snames.ads, snames.adb: 
	Add new predefined name for interface primitive _Disp_Requeue.
	New pragma Fast_Math

	* a-tags.ads, a-tags.adb: New calling sequence for
	String_To_Wide_[Wide_]String
	(Secondary_Tag): New subprogram.

	* exp_imgv.ads, exp_imgv.adb: Move Wide_[Wide_]Image routines here
	from Exp_Attr
	New calling sequence for String_To_Wide_[Wide_]String
	(Expand_Image_Attribute): Major rewrite. New calling sequence avoids
	the use of the secondary stack for image routines.

	* a-except-2005.adb, s-wchstw.ads, s-wchstw.adb, s-wwdenu.adb: New
	calling sequence for String_To_Wide_[Wide_]String

	* par-ch3.adb (P_Declarative_Items): Recognize use of Overriding in
	Ada 95 mode
	(P_Unknown_Discriminant_Part_Opt): Handle missing parens gracefully
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List

	* par-ch6.adb (P_Subprogram): Recognize use of Overriding in Ada 95 mode
	(P_Formal_Part): Use Skipping parameter in P_Pragma call
	to improve error recovery

	* par-util.adb (Next_Token_Is): New function
	(Signal_Bad_Attribute): Use new Namet.Is_Bad_Spelling_Of function

	* par-ch2.adb (Skip_Pragma_Semicolon): Do not resynchronize to
	semicolon if missing
	(P_Pragma): Implement new Skipping parameter
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List
	Fix location of flag for unrecognized pragma message

	* par-tchk.adb (U_Left_Paren): New procedure
	(U_Right_Paren): New procedure

From-SVN: r130818

1 files changed, 44 insertions, 63 deletions

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 4bb8d19..4baf55e 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -129,7 +129,7 @@ package body Exp_Attr is
    --  operand with overflow checking required.
 
    function Get_Index_Subtype (N : Node_Id) return Entity_Id;
-   --  Used for Last, Last, and Length, when the prefix is an array type,
+   --  Used for Last, Last, and Length, when the prefix is an array type.
    --  Obtains the corresponding index subtype.
 
    procedure Find_Fat_Info
@@ -838,8 +838,12 @@ package body Exp_Attr is
          --  generate a call to a run-time subprogram that returns the base
          --  address of the object.
 
+         --  This processing is not needed in the VM case, where dispatching
+         --  issues are taken care of by the virtual machine.
+
          elsif Is_Class_Wide_Type (Etype (Pref))
            and then Is_Interface (Etype (Pref))
+           and then VM_Target = No_VM
            and then not (Nkind (Pref) in N_Has_Entity
                           and then Is_Subprogram (Entity (Pref)))
          then
@@ -1923,8 +1927,27 @@ package body Exp_Attr is
          else
             Id_Kind := RTE (RO_AT_Task_Id);
 
-            Rewrite (N,
-              Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref)));
+            --  If the prefix is a task interface, the Task_Id is obtained
+            --  dynamically through a dispatching call, as for other task
+            --  attributes applied to interfaces.
+
+            if Ada_Version >= Ada_05
+              and then Ekind (Etype (Pref)) = E_Class_Wide_Type
+              and then Is_Interface (Etype (Pref))
+              and then Is_Task_Interface (Etype (Pref))
+            then
+               Rewrite (N,
+                 Unchecked_Convert_To (Id_Kind,
+                   Make_Selected_Component (Loc,
+                     Prefix =>
+                       New_Copy_Tree (Pref),
+                     Selector_Name =>
+                       Make_Identifier (Loc, Name_uDisp_Get_Task_Id))));
+
+            else
+               Rewrite (N,
+                 Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref)));
+            end if;
          end if;
 
          Analyze_And_Resolve (N, Id_Kind);
@@ -4052,13 +4075,17 @@ package body Exp_Attr is
             --  Note that Prefix'Address is recursively expanded into a call
             --  to Base_Address (Obj.Tag)
 
-            Rewrite (N,
-              Make_Explicit_Dereference (Loc,
-                Unchecked_Convert_To (RTE (RE_Tag_Ptr),
-                  Make_Attribute_Reference (Loc,
-                    Prefix => Relocate_Node (Pref),
-                    Attribute_Name => Name_Address))));
-            Analyze_And_Resolve (N, RTE (RE_Tag));
+            --  Not needed for VM targets, since all handled by the VM
+
+            if VM_Target = No_VM then
+               Rewrite (N,
+                 Make_Explicit_Dereference (Loc,
+                   Unchecked_Convert_To (RTE (RE_Tag_Ptr),
+                     Make_Attribute_Reference (Loc,
+                       Prefix => Relocate_Node (Pref),
+                       Attribute_Name => Name_Address))));
+               Analyze_And_Resolve (N, RTE (RE_Tag));
+            end if;
 
          else
             Rewrite (N,
@@ -4581,66 +4608,19 @@ package body Exp_Attr is
       -- Wide_Image --
       ----------------
 
-      --  We expand typ'Wide_Image (X) into
-
-      --    String_To_Wide_String
-      --      (typ'Image (X), Wide_Character_Encoding_Method)
+      --  Wide_Image attribute is handled in separate unit Exp_Imgv
 
-      --  This works in all cases because String_To_Wide_String converts any
-      --  wide character escape sequences resulting from the Image call to the
-      --  proper Wide_Character equivalent
-
-      --  not quite right for typ = Wide_Character ???
-
-      when Attribute_Wide_Image => Wide_Image :
-      begin
-         Rewrite (N,
-           Make_Function_Call (Loc,
-             Name => New_Reference_To (RTE (RE_String_To_Wide_String), Loc),
-             Parameter_Associations => New_List (
-               Make_Attribute_Reference (Loc,
-                 Prefix         => Pref,
-                 Attribute_Name => Name_Image,
-                 Expressions    => Exprs),
-
-               Make_Integer_Literal (Loc,
-                 Intval => Int (Wide_Character_Encoding_Method)))));
-
-         Analyze_And_Resolve (N, Standard_Wide_String);
-      end Wide_Image;
+      when Attribute_Wide_Image =>
+         Exp_Imgv.Expand_Wide_Image_Attribute (N);
 
       ---------------------
       -- Wide_Wide_Image --
       ---------------------
 
-      --  We expand typ'Wide_Wide_Image (X) into
-
-      --    String_To_Wide_Wide_String
-      --      (typ'Image (X), Wide_Character_Encoding_Method)
-
-      --  This works in all cases because String_To_Wide_Wide_String converts
-      --  any wide character escape sequences resulting from the Image call to
-      --  the proper Wide_Character equivalent
-
-      --  not quite right for typ = Wide_Wide_Character ???
-
-      when Attribute_Wide_Wide_Image => Wide_Wide_Image :
-      begin
-         Rewrite (N,
-           Make_Function_Call (Loc,
-             Name => New_Reference_To
-               (RTE (RE_String_To_Wide_Wide_String), Loc),
-             Parameter_Associations => New_List (
-               Make_Attribute_Reference (Loc,
-                 Prefix         => Pref,
-                 Attribute_Name => Name_Image,
-                 Expressions    => Exprs),
-
-               Make_Integer_Literal (Loc,
-                 Intval => Int (Wide_Character_Encoding_Method)))));
+      --  Wide_Wide_Image attribute is handled in separate unit Exp_Imgv
 
-         Analyze_And_Resolve (N, Standard_Wide_Wide_String);
-      end Wide_Wide_Image;
+      when Attribute_Wide_Wide_Image =>
+         Exp_Imgv.Expand_Wide_Wide_Image_Attribute (N);
 
       ----------------
       -- Wide_Value --
@@ -4935,6 +4915,7 @@ package body Exp_Attr is
            Attribute_Emax                         |
            Attribute_Enabled                      |
            Attribute_Epsilon                      |
+           Attribute_Fast_Math                    |
            Attribute_Has_Access_Values            |
            Attribute_Has_Discriminants            |
            Attribute_Large                        |