[multiple changes]

2004-02-20  Robert Dewar  <dewar@gnat.com>

	* bld.adb, exp_util.adb, gprcmd.adb: Minor reformatting

2004-02-20  Ed Schonberg  <schonberg@gnat.com>

	* freeze.adb (Freeze_Record_Type): Generalize mechanism that generates
	itype references for the constrained designated type of a component
	whose base type is already frozen.

2004-02-20  Arnaud Charlet  <charlet@act-europe.fr>

	* init.c (__gnat_error_handler [tru64]): Rewrite previous change to
	avoid GCC warnings.

2004-02-20  Sergey Rybin  <rybin@act-europe.fr>

	* sem_ch12.adb (Analyze_Formal_Package): Create a new defining
	identifier for a phantom package that rewrites the formal package
	declaration with a box. The Add semantic decorations for the defining
	identifier from the original node (that represents the formal package).

From-SVN: r78164

gcc/ada/ChangeLog

+2004-02-20  Robert Dewar  <dewar@gnat.com>
+
+	* bld.adb, exp_util.adb, gprcmd.adb: Minor reformatting
+
+2004-02-20  Ed Schonberg  <schonberg@gnat.com>
+
+	* freeze.adb (Freeze_Record_Type): Generalize mechanism that generates
+	itype references for the constrained designated type of a component
+	whose base type is already frozen.
+
+2004-02-20  Arnaud Charlet  <charlet@act-europe.fr>
+
+	* init.c (__gnat_error_handler [tru64]): Rewrite previous change to
+	avoid GCC warnings.
+
+2004-02-20  Sergey Rybin  <rybin@act-europe.fr>
+
+	* sem_ch12.adb (Analyze_Formal_Package): Create a new defining
+	identifier for a phantom package that rewrites the formal package
+	declaration with a box. The Add semantic decorations for the defining
+	identifier from the original node (that represents the formal package).
+
 2004-02-19  Matt Kraai  <kraai@alumni.cmu.edu>
 
 	* Make-lang.in (ada/stamp-sdefault): Use the top level

gcc/ada/bld.adb

@@ -1972,16 +1972,16 @@ package body Bld is
 
                      elsif Pkg = Snames.Name_Linker then
                         if Item_Name = Snames.Name_Linker_Options then
-                           --  Only add linker options if this is not the root
-                           --  project.
+
+                           --  Only add linker options if this is not the
+                           --  root project.
 
                            Put ("ifeq ($(");
                            Put (Project_Name);
                            Put (".root),False)");
                            New_Line;
 
-                           --  Add the linker options to FLDFLAGS, in reverse
-                           --  order.
+                           --  Add linker options to FLDFLAGS in reverse order
 
                            Put ("   FLDFLAGS:=$(shell gprcmd linkopts $(");
                            Put (Project_Name);
@@ -1994,10 +1994,10 @@ package body Bld is
                            Put ("endif");
                            New_Line;
 
-                        else
-                           --  Other attribute are of no interest; suppress
-                           --  their declarations.
+                        --  Other attributes are of no interest. Suppress
+                        --  their declarations.
 
+                        else
                            Put_Declaration := False;
                         end if;
                      end if;

gcc/ada/exp_util.adb

@@ -3353,8 +3353,7 @@ package body Exp_Util is
             when N_Character_Literal    |
                  N_Integer_Literal      |
                  N_Real_Literal         |
-                 N_String_Literal
-              =>
+                 N_String_Literal       =>
                return True;
 
             --  We consider that anything else has side effects. This is a bit

gcc/ada/freeze.adb

@@ -1473,6 +1473,41 @@ package body Freeze is
          --  Set True if we find at least one component with a component
          --  clause (used to warn about useless Bit_Order pragmas).
 
+         procedure Check_Itype (Desig : Entity_Id);
+         --  If the component subtype is an access to a constrained subtype
+         --  of an already frozen type, make the subtype frozen as well. It
+         --  might otherwise be frozen in the wrong scope, and a freeze node
+         --  on subtype has no effect.
+
+         procedure Check_Itype (Desig : Entity_Id) is
+         begin
+            if not Is_Frozen (Desig)
+              and then Is_Frozen (Base_Type (Desig))
+            then
+               Set_Is_Frozen (Desig);
+
+               --  In addition, add an Itype_Reference to ensure that the
+               --  access subtype is elaborated early enough. This cannot
+               --  be done if the subtype may depend on discriminants.
+
+               if Ekind (Comp) = E_Component
+                 and then Is_Itype (Etype (Comp))
+                 and then not Has_Discriminants (Rec)
+               then
+                  IR := Make_Itype_Reference (Sloc (Comp));
+                  Set_Itype (IR, Desig);
+
+                  if No (Result) then
+                     Result := New_List (IR);
+                  else
+                     Append (IR, Result);
+                  end if;
+               end if;
+            end if;
+         end Check_Itype;
+
+      --  Start of processing for Freeze_Record_Type
+
       begin
          --  If this is a subtype of a controlled type, declared without
          --  a constraint, the _controller may not appear in the component
@@ -1548,40 +1583,19 @@ package body Freeze is
                            Loc, Result);
                      end if;
 
+                  elsif Is_Itype (Designated_Type (Etype (Comp))) then
+                     Check_Itype (Designated_Type (Etype (Comp)));
+
                   else
                      Freeze_And_Append
                        (Designated_Type (Etype (Comp)), Loc, Result);
                   end if;
                end;
 
-            --  If this is a constrained subtype of an already frozen type,
-            --  make the subtype frozen as well. It might otherwise be frozen
-            --  in the wrong scope, and a freeze node on subtype has no effect.
-
             elsif Is_Access_Type (Etype (Comp))
-              and then not Is_Frozen (Designated_Type (Etype (Comp)))
               and then Is_Itype (Designated_Type (Etype (Comp)))
-              and then Is_Frozen (Base_Type (Designated_Type (Etype (Comp))))
             then
-               Set_Is_Frozen (Designated_Type (Etype (Comp)));
-
-               --  In addition, add an Itype_Reference to ensure that the
-               --  access subtype is elaborated early enough. This cannot
-               --  be done if the subtype may depend on discriminants.
-
-               if Ekind (Comp) = E_Component
-                 and then Is_Itype (Etype (Comp))
-                 and then not Has_Discriminants (Rec)
-               then
-                  IR := Make_Itype_Reference (Sloc (Comp));
-                  Set_Itype (IR, Designated_Type (Etype (Comp)));
-
-                  if No (Result) then
-                     Result := New_List (IR);
-                  else
-                     Append (IR, Result);
-                  end if;
-               end if;
+               Check_Itype (Designated_Type (Etype (Comp)));
 
             elsif Is_Array_Type (Etype (Comp))
               and then Is_Access_Type (Component_Type (Etype (Comp)))

gcc/ada/gprcmd.adb

@@ -454,19 +454,20 @@ begin
             Dir : constant String := Argument (2);
 
          begin
-            for J in 3 .. Argument_Count loop
-
-               --  Remove quotes that may have been added around each argument
+            --  Loop to remove quotes that may have been added around arguments
 
+            for J in 3 .. Argument_Count loop
                declare
                   Arg   : constant String := Argument (J);
                   First : Natural := Arg'First;
                   Last  : Natural := Arg'Last;
+
                begin
                   if Arg (First) = '"' and then Arg (Last) = '"' then
                      First := First + 1;
                      Last  := Last - 1;
                   end if;
+
                   if Is_Absolute_Path (Arg (First .. Last)) then
                      Extend (Format_Pathname (Arg (First .. Last), UNIX));
                   else

gcc/ada/init.c

@@ -388,6 +388,7 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
   static int recurse = 0;
   struct sigcontext *mstate;
   const char *msg;
+  jmp_buf handler_jmpbuf;
 
   /* If this was an explicit signal from a "kill", just resignal it.  */
   if (SI_FROMUSER (sip))
@@ -397,6 +398,43 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
     }
 
   /* Otherwise, treat it as something we handle.  */
+
+  /* We are now going to raise the exception corresponding to the signal we
+     caught, which may eventually end up resuming the application code if the
+     exception is handled.
+
+     When the exception is handled, merely arranging for the *exception*
+     handler's context (stack pointer, program counter, other registers, ...)
+     to be installed is *not* enough to let the kernel think we've left the
+     *signal* handler.  This has annoying implications if an alternate stack
+     has been setup for this *signal* handler, because the kernel thinks we
+     are still running on that alternate stack even after the jump, which
+     causes trouble at least as soon as another signal is raised.
+
+     We deal with this by forcing a "local" longjmp within the signal handler
+     below, forcing the "on alternate stack" indication to be reset (kernel
+     wise) on the way.  If no alternate stack has been setup, this should be a
+     neutral operation. Otherwise, we will be in a delicate situation for a
+     short while because we are going to run the exception propagation code
+     within the alternate stack area (that is, with the stack pointer inside
+     the alternate stack bounds), but with the corresponding flag off from the
+     kernel's standpoint.  We expect this to be ok as long as the propagation
+     code does not trigger a signal itself, which is expected.
+
+     ??? A better approach would be to at least delay this operation until the
+     last second, that is, until just before we jump to the exception handler,
+     if any.  */
+
+  if (setjmp (handler_jmpbuf) == 0)
+    {
+#define JB_ONSIGSTK 0
+
+      /* Arrange for the "on alternate stack" flag to be reset.  See the
+	 comments around "jmp_buf offsets" in /usr/include/setjmp.h.  */
+      handler_jmpbuf [JB_ONSIGSTK] = 0;
+      longjmp (handler_jmpbuf, 1);
+    }
+
   switch (sig)
     {
     case SIGSEGV:
@@ -448,48 +486,7 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
   if (mstate != 0)
     *mstate = *context;
 
-  /* We are now going to raise the exception corresponding to the signal we
-     caught, which may eventually end up resuming the application code if the
-     exception is handled.
-
-     When the exception is handled, merely arranging for the *exception*
-     handler's context (stack pointer, program counter, other registers, ...)
-     to be installed is *not* enough to let the kernel think we've left the
-     *signal* handler.  This has annoying implications if an alternate stack
-     has been setup for this *signal* handler, because the kernel thinks we
-     are still running on that alternate stack even after the jump, which
-     causes trouble at least as soon as another signal is raised.
-
-     We deal with this by forcing a "local" longjmp within the signal handler
-     below, forcing the "on alternate stack" indication to be reset (kernel
-     wise) on the way.  If no alternate stack has been setup, this should be a
-     neutral operation. Otherwise, we will be in a delicate situation for a
-     short while because we are going to run the exception propagation code
-     within the alternate stack area (that is, with the stack pointer inside
-     the alternate stack bounds), but with the corresponding flag off from the
-     kernel's standpoint.  We expect this to be ok as long as the propagation
-     code does not trigger a signal itself, which is expected.
-
-     ??? A better approach would be to at least delay this operation until the
-     last second, that is, until just before we jump to the exception handler,
-     if any.  */
-  {
-    jmp_buf handler_jmpbuf;
-
-    if (setjmp (handler_jmpbuf) != 0)
-      Raise_From_Signal_Handler (exception, (char *) msg);
-    else
-      {
-	/* Arrange for the "on alternate stack" flag to be reset.  See the
-	   comments around "jmp_buf offsets" in /usr/include/setjmp.h.  */
-	struct sigcontext * handler_context
-	  = (struct sigcontext *) & handler_jmpbuf;
-
-	handler_context->sc_onstack = 0;
-	
-	longjmp (handler_jmpbuf, 1);
-      }
-  }
+  Raise_From_Signal_Handler (exception, (char *) msg);
 }
 
 void

gcc/ada/sem_ch12.adb

@@ -1578,7 +1578,8 @@ package body Sem_Ch12 is
 
    procedure Analyze_Formal_Package (N : Node_Id) is
       Loc              : constant Source_Ptr := Sloc (N);
-      Formal           : constant Entity_Id  := Defining_Identifier (N);
+      Pack_Id          : constant Entity_Id := Defining_Identifier (N);
+      Formal           : Entity_Id;
       Gen_Id           : constant Node_Id    := Name (N);
       Gen_Decl         : Node_Id;
       Gen_Unit         : Entity_Id;
@@ -1653,8 +1654,6 @@ package body Sem_Ch12 is
          --  and analyze it like a regular package, except that we treat the
          --  formals as additional visible components.
 
-         Set_Instance_Env (Gen_Unit, Formal);
-
          Gen_Decl := Unit_Declaration_Node (Gen_Unit);
 
          if In_Extended_Main_Source_Unit (N) then
@@ -1662,11 +1661,13 @@ package body Sem_Ch12 is
             Generate_Reference  (Gen_Unit, N);
          end if;
 
+         Formal := New_Copy (Pack_Id);
          New_N :=
            Copy_Generic_Node
              (Original_Node (Gen_Decl), Empty, Instantiating => True);
-         Set_Defining_Unit_Name (Specification (New_N), Formal);
          Rewrite (N, New_N);
+         Set_Defining_Unit_Name (Specification (New_N), Formal);
+         Set_Instance_Env (Gen_Unit, Formal);
 
          Enter_Name (Formal);
          Set_Ekind  (Formal, E_Generic_Package);
@@ -1728,6 +1729,11 @@ package body Sem_Ch12 is
          Set_Ekind (Formal, E_Package);
          Set_Generic_Parent (Specification (N), Gen_Unit);
          Set_Has_Completion (Formal, True);
+
+         Set_Ekind (Pack_Id, E_Package);
+         Set_Etype (Pack_Id, Standard_Void_Type);
+         Set_Scope (Pack_Id, Scope (Formal));
+         Set_Has_Completion (Pack_Id, True);
       end if;
    end Analyze_Formal_Package;