2003-11-10 Ed Falis <falis@gnat.com>

	* 5ytiitho.adb: (procStartHookAdd): Definition and call deleted

	* 5zinit.adb: (Install_Handler): Moved back to spec
	(Install_Signal_Handlers): Deleted

	* 5zthrini.adb: Added context clause for System.Storage_Elements
	(Register): Only handles creation of taskVar; initialization moved to
	Thread_Body_Enter.
	(Reset_TSD): Deleted; replaced by Thread_Body_Enter
	Added declaration of environment task secondary stack and
	initialization.

	* s-thread.adb: Implement bodies for thread body processing

	* s-thread.ads:
	Added comment identifying supported targets for pragma Thread_Body.

2003-11-10  Pascal Obry  <obry@gnat.com>

	* adaint.c (_gnat_stat) [WIN32]: Check if name is not bigger than
	GNAT_MAX_PATH_LEN.

	* s-fileio.adb:
	(Open): Properly check for string length before copying into the buffer.
	Raises Name_Error if buffer is too small. Note that this was a potential
	buffer overflow.

2003-11-10  Arnaud Charlet  <charlet@act-europe.fr>

	* bindgen.adb, comperr.adb: Code clean ups.
	* gnatvsn.ads, gnatvsn.adb (Get_Gnat_Version_Type): New function.

2003-11-10  Sergey Rybin  <rybin@act-europe.fr>

	* gnat1drv.adb: Add call to Sem_Elim.Initialize.

2003-11-10  Vincent Celier  <celier@gnat.com>

	* gprcmd.adb:
	(Gprcmd): Add new command "prefix" to get the prefix of the GNAT
	installation.

	* make.adb (Scan_Make_Arg): Transmit -nostdlib to the compiler

	* prj.adb: (Project_Empty): Add new boolean component Virtual

	* prj.ads: (Virtual_Prefix): New constant string
	(Project_Data): New boolean component Virtual

	* prj-nmsc.adb (Language_Independent_Check): Adjust error message when
	a library project is extended by a virtual extending project.

	* prj-part.adb:
	Modifications throughout to implement extending-all project, including:
	(Virtual_Hash, Processed_Hash): New hash tables
	(Create_Virtual_Extending_Project): New procedure
	(Look_For_Virtual_Projects_For): New procedure

	* prj-proc.adb:
	(Process): After checking the projects, if main project is an
	extending-all project, set the object directory of all virtual extending
	project to the object directory of the main project.
	Adjust error message when a virtual extending project has the same
	object directory as an project being extended.
	(Recursive_Process): If name starts with the virtual prefix, set Virtual
	to True in the project data.

	* prj-tree.adb:
	(Default_Project_Node): Add new boolean component Extending_All
	(Is_Extending_All): New function
	(Set_Is_Extending_All): New procedure

	* prj-tree.ads: (Is_Extending_All): New function
	(Set_Is_Extending_All): New procedure
	(Project_Node_Record): New boolean component Extending_All

	* switch-c.adb: (Scan_Front_End_Switches): Process -nostdlib

	* vms_data.ads:
	Add qualifier /NOSTD_LIBRARIES (-nostdlib) for the compiler

	* bld.adb (Recursive_Process): If MAKE_ROOT is not defined, call
	"gprcmd prefix" to define it.

2003-11-10  Thomas Quinot  <quinot@act-europe.fr>

	* einfo.ads: Fix a typo and remove an extraneous word in comments.

	* lib-load.adb:
	(Create_Dummy_Package_Unit): Set the scope of the entity for the
	created dummy package to Standard_Standard, not to itself, to
	defend other parts of the front-end against encoutering a cycle in
	the scope chain.

	* sem_ch10.adb:
	(Analyze_With_Clause): When setting the entities for the successive
	N_Expanded_Names that constitute the name of a child unit, do not
	attempt to go further than Standard_Standard in the chain of scopes.
	This case arises from the placeholder units created by
	Create_Dummy_Package_Unit in the case of a with_clause for a
	nonexistent child unit.

2003-11-10  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb:
	(Expand_Thread_Body): Place subprogram on scope stack, so that new
	declarations are given the proper scope.

	* sem_ch13.adb:
	(Check_Expr_Constants): Reject an expression that contains a constant
	created during expansion, and that appears after the object to which
	the address clause applies.

	* sem_ch5.adb (Check_Controlled_Array_Attribute): Subsidiary of
	Analyze_Iteration_Scheme, to rewrite a loop parameter specification
	that uses 'Range of a function call with controlled components, so
	that the function result can be finalized before starting the loop.

	* sem_ch8.adb:
	(Find_Selected_Component): Improve error message when prefix is
	an implicit dereference of an incomplete type.

2003-11-10  Robert Dewar  <dewar@gnat.com>

	* opt.ads: New Print_Standard flag for -gnatS switch

	* sem_ch13.adb: Remove some additional checks for unaligned arrays

	* cstand.adb (Create_Standard): Print out package standard if -gnatS
	switch set

	* debug.adb: Update doc for -gnatds to discuss relationship with new
	-gnatS flag

	* sinfo.adb: Add new field Entity_Or_Associated_Node

	* sinfo.ads: Add new field Entity_Or_Associated_Node
	Update documentation for Associated_Node and Entity fields to clarify
	relationship and usage.

	* sprint.adb:
	(Write_Id): Properly process Associated_Node field in generic template

	* switch-c.adb:
	Recognize new -gnatS switch for printing package Standard
	This replaces gnatpsta

	* usage.adb:
	Add line for  new -gnatS switch for printing package Standard
	This replaces gnatpsta


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@73423 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 253 insertions, 0 deletions

diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index 93b84a86f27..9cad4bea44d 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -33,6 +33,7 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Output;   use Output;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
@@ -120,6 +121,9 @@ package body CStand is
       return          Entity_Id;
    --  Builds a new entity for Standard
 
+   procedure Print_Standard;
+   --  Print representation of package Standard if switch set
+
    procedure Set_Integer_Bounds
      (Id  : Entity_Id;
       Typ : Entity_Id;
@@ -1243,6 +1247,12 @@ package body CStand is
       --  The Error node has an Etype of Any_Type to help error recovery
 
       Set_Etype (Error, Any_Type);
+
+      --  Print representation of standard if switch set
+
+      if Opt.Print_Standard then
+         Print_Standard;
+      end if;
    end Create_Standard;
 
    ------------------------------------
@@ -1417,6 +1427,249 @@ package body CStand is
       return E;
    end New_Standard_Entity;
 
+   --------------------
+   -- Print_Standard --
+   --------------------
+
+   procedure Print_Standard is
+
+      procedure P (Item : String) renames Output.Write_Line;
+      --  Short-hand, since we do a lot of line writes here!
+
+      procedure P_Int_Range (Size : Pos);
+      --  Prints the range of an integer based on its Size
+
+      procedure P_Float_Range (Id : Entity_Id);
+      --  Prints the bounds range for the given float type entity
+
+      -------------------
+      -- P_Float_Range --
+      -------------------
+
+      procedure P_Float_Range (Id : Entity_Id) is
+         Digs : constant Nat := UI_To_Int (Digits_Value (Id));
+
+      begin
+         Write_Str ("     range ");
+
+         if Vax_Float (Id) then
+            if Digs = VAXFF_Digits then
+               Write_Str (VAXFF_First'Universal_Literal_String);
+               Write_Str (" .. ");
+               Write_Str (VAXFF_Last'Universal_Literal_String);
+
+            elsif Digs = VAXDF_Digits then
+               Write_Str (VAXDF_First'Universal_Literal_String);
+               Write_Str (" .. ");
+               Write_Str (VAXDF_Last'Universal_Literal_String);
+
+            else
+               pragma Assert (Digs = VAXGF_Digits);
+
+               Write_Str (VAXGF_First'Universal_Literal_String);
+               Write_Str (" .. ");
+               Write_Str (VAXGF_Last'Universal_Literal_String);
+            end if;
+
+         elsif Is_AAMP_Float (Id) then
+            if Digs = AAMPS_Digits then
+               Write_Str (AAMPS_First'Universal_Literal_String);
+               Write_Str (" .. ");
+               Write_Str (AAMPS_Last'Universal_Literal_String);
+
+            else
+               pragma Assert (Digs = AAMPL_Digits);
+               Write_Str (AAMPL_First'Universal_Literal_String);
+               Write_Str (" .. ");
+               Write_Str (AAMPL_Last'Universal_Literal_String);
+            end if;
+
+         elsif Digs = IEEES_Digits then
+            Write_Str (IEEES_First'Universal_Literal_String);
+            Write_Str (" .. ");
+            Write_Str (IEEES_Last'Universal_Literal_String);
+
+
+         elsif Digs = IEEEL_Digits then
+            Write_Str (IEEEL_First'Universal_Literal_String);
+            Write_Str (" .. ");
+            Write_Str (IEEEL_Last'Universal_Literal_String);
+
+         else
+            pragma Assert (Digs = IEEEX_Digits);
+
+            Write_Str (IEEEX_First'Universal_Literal_String);
+            Write_Str (" .. ");
+            Write_Str (IEEEX_Last'Universal_Literal_String);
+         end if;
+
+         Write_Str (";");
+         Write_Eol;
+      end P_Float_Range;
+
+      -----------------
+      -- P_Int_Range --
+      -----------------
+
+      procedure P_Int_Range (Size : Pos) is
+      begin
+         Write_Str (" is range -(2 **");
+         Write_Int (Size - 1);
+         Write_Str (")");
+         Write_Str (" .. +(2 **");
+         Write_Int (Size - 1);
+         Write_Str (" - 1);");
+         Write_Eol;
+      end P_Int_Range;
+
+   --  Start of processing for Print_Standard
+
+   begin
+      P ("--  Representation of package Standard");
+      Write_Eol;
+      P ("--  This is not accurate Ada, since new base types cannot be ");
+      P ("--  created, but the listing shows the target dependent");
+      P ("--  characteristics of the Standard types for this compiler");
+      Write_Eol;
+
+      P ("package Standard is");
+      P ("pragma Pure(Standard);");
+      Write_Eol;
+
+      P ("   type Boolean is (False, True);");
+      P ("   for Boolean'Size use 1;");
+      P ("   for Boolean use (False => 0, True => 1);");
+      Write_Eol;
+
+      --  Integer types
+
+      Write_Str ("   type Integer");
+      P_Int_Range (Standard_Integer_Size);
+      Write_Str ("   for Integer'Size use ");
+      Write_Int (Standard_Integer_Size);
+      P (";");
+      Write_Eol;
+
+      P ("   subtype Natural  is Integer range 0 .. Integer'Last;");
+      P ("   subtype Positive is Integer range 1 .. Integer'Last;");
+      Write_Eol;
+
+      Write_Str ("   type Short_Short_Integer");
+      P_Int_Range (Standard_Short_Short_Integer_Size);
+      Write_Str ("   for Short_Short_Integer'Size use ");
+      Write_Int (Standard_Short_Short_Integer_Size);
+      P (";");
+      Write_Eol;
+
+      Write_Str ("   type Short_Integer");
+      P_Int_Range (Standard_Short_Integer_Size);
+      Write_Str ("   for Short_Integer'Size use ");
+      Write_Int (Standard_Short_Integer_Size);
+      P (";");
+      Write_Eol;
+
+      Write_Str ("   type Long_Integer");
+      P_Int_Range (Standard_Long_Integer_Size);
+      Write_Str ("   for Long_Integer'Size use ");
+      Write_Int (Standard_Long_Integer_Size);
+      P (";");
+      Write_Eol;
+
+      Write_Str ("   type Long_Long_Integer");
+      P_Int_Range (Standard_Long_Long_Integer_Size);
+      Write_Str ("   for Long_Long_Integer'Size use ");
+      Write_Int (Standard_Long_Long_Integer_Size);
+      P (";");
+      Write_Eol;
+
+      --  Floating point types
+
+      Write_Str ("   type Short_Float is digits ");
+      Write_Int (Standard_Short_Float_Digits);
+      Write_Eol;
+      P_Float_Range (Standard_Short_Float);
+      Write_Str ("   for Short_Float'Size use ");
+      Write_Int (Standard_Short_Float_Size);
+      P (";");
+      Write_Eol;
+
+      Write_Str ("   type Float is digits ");
+      Write_Int (Standard_Float_Digits);
+      Write_Eol;
+      P_Float_Range (Standard_Float);
+      Write_Str ("   for Float'Size use ");
+      Write_Int (Standard_Float_Size);
+      P (";");
+      Write_Eol;
+
+      Write_Str ("   type Long_Float is digits ");
+      Write_Int (Standard_Long_Float_Digits);
+      Write_Eol;
+      P_Float_Range (Standard_Long_Float);
+      Write_Str ("   for Long_Float'Size use ");
+      Write_Int (Standard_Long_Float_Size);
+      P (";");
+      Write_Eol;
+
+      Write_Str ("   type Long_Long_Float is digits ");
+      Write_Int (Standard_Long_Long_Float_Digits);
+      Write_Eol;
+      P_Float_Range (Standard_Long_Long_Float);
+      Write_Str ("   for Long_Long_Float'Size use ");
+      Write_Int (Standard_Long_Long_Float_Size);
+      P (";");
+      Write_Eol;
+
+      P ("   type Character is (...)");
+      Write_Str ("   for Character'Size use ");
+      Write_Int (Standard_Character_Size);
+      P (";");
+      P ("   --  See RM A.1(35) for details of this type");
+      Write_Eol;
+
+      P ("   type Wide_Character is (...)");
+      Write_Str ("   for Wide_Character'Size use ");
+      Write_Int (Standard_Wide_Character_Size);
+      P (";");
+      P ("   --  See RM A.1(36) for details of this type");
+      Write_Eol;
+
+      P ("   type String is array (Positive range <>) of Character;");
+      P ("   pragma Pack (String);");
+      Write_Eol;
+
+      P ("   type Wide_String is array (Positive range <>)" &
+         " of Wide_Character;");
+      P ("   pragma Pack (Wide_String);");
+      Write_Eol;
+
+      --  Here it's OK to use the Duration type of the host compiler since
+      --  the implementation of Duration in GNAT is target independent.
+
+      if Duration_32_Bits_On_Target then
+         P ("   type Duration is delta 0.020");
+         P ("     range -((2 ** 31 - 1) * 0.020) ..");
+         P ("           +((2 ** 31 - 1) * 0.020);");
+         P ("   for Duration'Small use 0.020;");
+      else
+         P ("   type Duration is delta 0.000000001");
+         P ("     range -((2 ** 63 - 1) * 0.000000001) ..");
+         P ("           +((2 ** 63 - 1) * 0.000000001);");
+         P ("   for Duration'Small use 0.000000001;");
+      end if;
+
+      Write_Eol;
+
+      P ("   Constraint_Error : exception;");
+      P ("   Program_Error    : exception;");
+      P ("   Storage_Error    : exception;");
+      P ("   Tasking_Error    : exception;");
+      P ("   Numeric_Error    : exception renames Constraint_Error;");
+      Write_Eol;
+
+      P ("end Standard;");
+   end Print_Standard;
+
    ----------------------
    -- Set_Float_Bounds --
    ----------------------