[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 Aug 2011 10:36:15 +0000 (12:36 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 Aug 2011 10:36:15 +0000 (12:36 +0200)
2011-08-02  Ed Schonberg  <schonberg@adacore.com>

* exp_ch5.adb (Expand_N_Assignment_Statement): under restriction
No_Dispatching_Calls, do not look for the Assign primitive, because
predefined primitives are not created in this case.

2011-08-02  Bob Duff  <duff@adacore.com>

* stylesw.ads: Minor comment fixes.

2011-08-02  Robert Dewar  <dewar@adacore.com>

* freeze.adb (Add_To_Result): New procedure.

2011-08-02  Jose Ruiz  <ruiz@adacore.com>

* exp_attr.adb (Find_Stream_Subprogram): When using a configurable run
time, if the specific run-time routines for handling streams of strings
are not available, use the default mechanism.

2011-08-02  Arnaud Charlet  <charlet@adacore.com>

* s-regpat.ads: Fix typo.

2011-08-02  Vincent Celier  <celier@adacore.com>

* prj-conf.adb (Get_Or_Create_Configuration_File): If On_Load_Config is
not null, call it to create the in memory config project file without
parsing an existing default config project file.

2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>

* atree.adb (Allocate_Initialize_Node): Remove useless temporaries.

2011-08-02  Ed Schonberg  <schonberg@adacore.com>

* sem_elim.adb: an abstract subprogram does not need an eliminate
pragma for its descendant to be eliminable.

2011-08-02  Ed Falis  <falis@adacore.com>

* init.c: revert to handling before previous checkin for VxWorks
* s-intman-vxworks.adb: delete unnecessary declarations related to
using Ada interrupt facilities for handling signals.
Delete Initialize_Interrupts. Use __gnat_install_handler instead.
* s-intman-vxworks.ads: Import __gnat_install_handler as
Initialize_Interrupts.
* s-taprop-vxworks.adb: Delete Signal_Mask.
(Abort_Handler): change construction of mask to unblock exception
signals.

From-SVN: r177130

13 files changed:
gcc/ada/ChangeLog
gcc/ada/atree.adb
gcc/ada/exp_attr.adb
gcc/ada/exp_ch5.adb
gcc/ada/freeze.adb
gcc/ada/init.c
gcc/ada/prj-conf.adb
gcc/ada/s-intman-vxworks.adb
gcc/ada/s-intman-vxworks.ads
gcc/ada/s-regpat.ads
gcc/ada/s-taprop-vxworks.adb
gcc/ada/sem_elim.adb
gcc/ada/stylesw.ads

index 693d865430258a70000a8e8e4f34e332084fbd6e..61cb60a3a509608347ec90d5e852b7cfbbae56d2 100644 (file)
@@ -1,3 +1,54 @@
+2011-08-02  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch5.adb (Expand_N_Assignment_Statement): under restriction
+       No_Dispatching_Calls, do not look for the Assign primitive, because
+       predefined primitives are not created in this case.
+
+2011-08-02  Bob Duff  <duff@adacore.com>
+
+       * stylesw.ads: Minor comment fixes.
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * freeze.adb (Add_To_Result): New procedure.
+
+2011-08-02  Jose Ruiz  <ruiz@adacore.com>
+
+       * exp_attr.adb (Find_Stream_Subprogram): When using a configurable run
+       time, if the specific run-time routines for handling streams of strings
+       are not available, use the default mechanism.
+
+2011-08-02  Arnaud Charlet  <charlet@adacore.com>
+
+       * s-regpat.ads: Fix typo.
+
+2011-08-02  Vincent Celier  <celier@adacore.com>
+
+       * prj-conf.adb (Get_Or_Create_Configuration_File): If On_Load_Config is
+       not null, call it to create the in memory config project file without
+       parsing an existing default config project file.
+
+2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * atree.adb (Allocate_Initialize_Node): Remove useless temporaries.
+
+2011-08-02  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_elim.adb: an abstract subprogram does not need an eliminate
+       pragma for its descendant to be eliminable.
+
+2011-08-02  Ed Falis  <falis@adacore.com>
+
+       * init.c: revert to handling before previous checkin for VxWorks
+       * s-intman-vxworks.adb: delete unnecessary declarations related to
+       using Ada interrupt facilities for handling signals.
+       Delete Initialize_Interrupts. Use __gnat_install_handler instead.
+       * s-intman-vxworks.ads: Import __gnat_install_handler as
+       Initialize_Interrupts.
+       * s-taprop-vxworks.adb: Delete Signal_Mask.
+       (Abort_Handler): change construction of mask to unblock exception
+       signals.
+
 2011-08-02  Jerome Guitton  <guitton@adacore.com>
 
        * a-except-2005.adb (Raise_From_Signal_Handler): Call
index 306845b5f755eaf51d9aa09398c63b24f26e7cd5..bb678a5b9cbfb785889357fa4e95fe2fb18a320f 100644 (file)
@@ -481,34 +481,25 @@ package body Atree is
      (Src            : Node_Id;
       With_Extension : Boolean) return Node_Id
    is
-      New_Id : Node_Id     := Src;
-      Nod    : Node_Record := Default_Node;
-      Ext1   : Node_Record := Default_Node_Extension;
-      Ext2   : Node_Record := Default_Node_Extension;
-      Ext3   : Node_Record := Default_Node_Extension;
-      Ext4   : Node_Record := Default_Node_Extension;
+      New_Id : Node_Id;
 
    begin
-      if Present (Src) then
-         Nod := Nodes.Table (Src);
-
-         if Has_Extension (Src) then
-            Ext1 := Nodes.Table (Src + 1);
-            Ext2 := Nodes.Table (Src + 2);
-            Ext3 := Nodes.Table (Src + 3);
-            Ext4 := Nodes.Table (Src + 4);
-         end if;
-      end if;
-
-      if not (Present (Src)
-               and then not Has_Extension (Src)
-               and then With_Extension
-               and then Src = Nodes.Last)
+      if Present (Src)
+        and then not Has_Extension (Src)
+        and then With_Extension
+        and then Src = Nodes.Last
       then
+         New_Id := Src;
+      else
          --  We are allocating a new node, or extending a node
          --  other than Nodes.Last.
 
-         Nodes.Append (Nod);
+         if Present (Src) then
+            Nodes.Append (Nodes.Table (Src));
+         else
+            Nodes.Append (Default_Node);
+         end if;
+
          New_Id := Nodes.Last;
          Orig_Nodes.Append (New_Id);
          Node_Count := Node_Count + 1;
@@ -524,10 +515,15 @@ package body Atree is
       --  Set extension nodes if required
 
       if With_Extension then
-         Nodes.Append (Ext1);
-         Nodes.Append (Ext2);
-         Nodes.Append (Ext3);
-         Nodes.Append (Ext4);
+         if Present (Src) and then Has_Extension (Src) then
+            for J in 1 .. 4 loop
+               Nodes.Append (Nodes.Table (Src + Node_Id (J)));
+            end loop;
+         else
+            for J in 1 .. 4 loop
+               Nodes.Append (Default_Node_Extension);
+            end loop;
+         end if;
       end if;
 
       Orig_Nodes.Set_Last (Nodes.Last);
index 56ca1ae00caebff854a172eb87b772f900771beb..008c8138dcb3fbc4e6d4f6dfd127ab9494d0e85c 100644 (file)
@@ -5517,6 +5517,21 @@ package body Exp_Attr is
       Base_Typ : constant Entity_Id := Base_Type (Typ);
       Ent      : constant Entity_Id := TSS (Typ, Nam);
 
+      function Is_Available (Entity : RE_Id) return Boolean;
+      pragma Inline (Is_Available);
+      --  Function to check whether the specified run-time call is available
+      --  in the run time used. In the case of a configurable run time, it
+      --  is normal that some subprograms are not there.
+
+      function Is_Available (Entity : RE_Id) return Boolean is
+      begin
+         --  Assume that the unit will always be available when using a
+         --  "normal" (not configurable) run time.
+
+         return not Configurable_Run_Time_Mode
+           or else RTE_Available (Entity);
+      end Is_Available;
+
    begin
       if Present (Ent) then
          return Ent;
@@ -5535,6 +5550,12 @@ package body Exp_Attr is
       --  This is disabled for AAMP, to avoid creating dependences on files not
       --  supported in the AAMP library (such as s-fileio.adb).
 
+      --  In the case of using a configurable run time, it is very likely
+      --  that stream routines for string types are not present (they require
+      --  file system support). In this case, the specific stream routines for
+      --  strings are not used, relying on the regular stream mechanism
+      --  instead.
+
       if VM_Target /= JVM_Target
         and then not AAMP_On_Target
         and then
@@ -5544,31 +5565,61 @@ package body Exp_Attr is
 
          if Base_Typ = Standard_String then
             if Restriction_Active (No_Stream_Optimizations) then
-               if Nam = TSS_Stream_Input then
+               if Nam = TSS_Stream_Input
+                 and then Is_Available (RE_String_Input)
+               then
                   return RTE (RE_String_Input);
 
-               elsif Nam = TSS_Stream_Output then
+               elsif Nam = TSS_Stream_Output
+                 and then Is_Available (RE_String_Output)
+               then
                   return RTE (RE_String_Output);
 
-               elsif Nam = TSS_Stream_Read then
+               elsif Nam = TSS_Stream_Read
+                 and then Is_Available (RE_String_Read)
+               then
                   return RTE (RE_String_Read);
 
-               else pragma Assert (Nam = TSS_Stream_Write);
+               elsif Nam = TSS_Stream_Write
+                 and then Is_Available (RE_String_Write)
+               then
                   return RTE (RE_String_Write);
+
+               elsif Nam /= TSS_Stream_Input and then
+                     Nam /= TSS_Stream_Output and then
+                     Nam /= TSS_Stream_Read and then
+                     Nam /= TSS_Stream_Write
+               then
+                  raise Program_Error;
                end if;
 
             else
-               if Nam = TSS_Stream_Input then
+               if Nam = TSS_Stream_Input
+                 and then Is_Available (RE_String_Input_Blk_IO)
+               then
                   return RTE (RE_String_Input_Blk_IO);
 
-               elsif Nam = TSS_Stream_Output then
+               elsif Nam = TSS_Stream_Output
+                 and then Is_Available (RE_String_Output_Blk_IO)
+               then
                   return RTE (RE_String_Output_Blk_IO);
 
-               elsif Nam = TSS_Stream_Read then
+               elsif Nam = TSS_Stream_Read
+                 and then Is_Available (RE_String_Read_Blk_IO)
+               then
                   return RTE (RE_String_Read_Blk_IO);
 
-               else pragma Assert (Nam = TSS_Stream_Write);
+               elsif Nam = TSS_Stream_Write
+                 and then Is_Available (RE_String_Write_Blk_IO)
+               then
                   return RTE (RE_String_Write_Blk_IO);
+
+               elsif Nam /= TSS_Stream_Input and then
+                     Nam /= TSS_Stream_Output and then
+                     Nam /= TSS_Stream_Read and then
+                     Nam /= TSS_Stream_Write
+               then
+                  raise Program_Error;
                end if;
             end if;
 
@@ -5576,31 +5627,61 @@ package body Exp_Attr is
 
          elsif Base_Typ = Standard_Wide_String then
             if Restriction_Active (No_Stream_Optimizations) then
-               if Nam = TSS_Stream_Input then
+               if Nam = TSS_Stream_Input
+                 and then Is_Available (RE_Wide_String_Input)
+               then
                   return RTE (RE_Wide_String_Input);
 
-               elsif Nam = TSS_Stream_Output then
+               elsif Nam = TSS_Stream_Output
+                 and then Is_Available (RE_Wide_String_Output)
+               then
                   return RTE (RE_Wide_String_Output);
 
-               elsif Nam = TSS_Stream_Read then
+               elsif Nam = TSS_Stream_Read
+                 and then Is_Available (RE_Wide_String_Read)
+               then
                   return RTE (RE_Wide_String_Read);
 
-               else pragma Assert (Nam = TSS_Stream_Write);
+               elsif Nam = TSS_Stream_Write
+                 and then Is_Available (RE_Wide_String_Write)
+               then
                   return RTE (RE_Wide_String_Write);
+
+               elsif Nam /= TSS_Stream_Input and then
+                     Nam /= TSS_Stream_Output and then
+                     Nam /= TSS_Stream_Read and then
+                     Nam /= TSS_Stream_Write
+               then
+                  raise Program_Error;
                end if;
 
             else
-               if Nam = TSS_Stream_Input then
+               if Nam = TSS_Stream_Input
+                 and then Is_Available (RE_Wide_String_Input_Blk_IO)
+               then
                   return RTE (RE_Wide_String_Input_Blk_IO);
 
-               elsif Nam = TSS_Stream_Output then
+               elsif Nam = TSS_Stream_Output
+                 and then Is_Available (RE_Wide_String_Output_Blk_IO)
+               then
                   return RTE (RE_Wide_String_Output_Blk_IO);
 
-               elsif Nam = TSS_Stream_Read then
+               elsif Nam = TSS_Stream_Read
+                 and then Is_Available (RE_Wide_String_Read_Blk_IO)
+               then
                   return RTE (RE_Wide_String_Read_Blk_IO);
 
-               else pragma Assert (Nam = TSS_Stream_Write);
+               elsif Nam = TSS_Stream_Write
+                 and then Is_Available (RE_Wide_String_Write_Blk_IO)
+               then
                   return RTE (RE_Wide_String_Write_Blk_IO);
+
+               elsif Nam /= TSS_Stream_Input and then
+                     Nam /= TSS_Stream_Output and then
+                     Nam /= TSS_Stream_Read and then
+                     Nam /= TSS_Stream_Write
+               then
+                  raise Program_Error;
                end if;
             end if;
 
@@ -5608,31 +5689,61 @@ package body Exp_Attr is
 
          elsif Base_Typ = Standard_Wide_Wide_String then
             if Restriction_Active (No_Stream_Optimizations) then
-               if Nam = TSS_Stream_Input then
+               if Nam = TSS_Stream_Input
+                 and then Is_Available (RE_Wide_Wide_String_Input)
+               then
                   return RTE (RE_Wide_Wide_String_Input);
 
-               elsif Nam = TSS_Stream_Output then
+               elsif Nam = TSS_Stream_Output
+                 and then Is_Available (RE_Wide_Wide_String_Output)
+               then
                   return RTE (RE_Wide_Wide_String_Output);
 
-               elsif Nam = TSS_Stream_Read then
+               elsif Nam = TSS_Stream_Read
+                 and then Is_Available (RE_Wide_Wide_String_Read)
+               then
                   return RTE (RE_Wide_Wide_String_Read);
 
-               else pragma Assert (Nam = TSS_Stream_Write);
+               elsif Nam = TSS_Stream_Write
+                 and then Is_Available (RE_Wide_Wide_String_Write)
+               then
                   return RTE (RE_Wide_Wide_String_Write);
+
+               elsif Nam /= TSS_Stream_Input and then
+                     Nam /= TSS_Stream_Output and then
+                     Nam /= TSS_Stream_Read and then
+                     Nam /= TSS_Stream_Write
+               then
+                  raise Program_Error;
                end if;
 
             else
-               if Nam = TSS_Stream_Input then
+               if Nam = TSS_Stream_Input
+                 and then Is_Available (RE_Wide_Wide_String_Input_Blk_IO)
+               then
                   return RTE (RE_Wide_Wide_String_Input_Blk_IO);
 
-               elsif Nam = TSS_Stream_Output then
+               elsif Nam = TSS_Stream_Output
+                 and then Is_Available (RE_Wide_Wide_String_Output_Blk_IO)
+               then
                   return RTE (RE_Wide_Wide_String_Output_Blk_IO);
 
-               elsif Nam = TSS_Stream_Read then
+               elsif Nam = TSS_Stream_Read
+                 and then Is_Available (RE_Wide_Wide_String_Read_Blk_IO)
+               then
                   return RTE (RE_Wide_Wide_String_Read_Blk_IO);
 
-               else pragma Assert (Nam = TSS_Stream_Write);
+               elsif Nam = TSS_Stream_Write
+                 and then Is_Available (RE_Wide_Wide_String_Write_Blk_IO)
+               then
                   return RTE (RE_Wide_Wide_String_Write_Blk_IO);
+
+               elsif Nam /= TSS_Stream_Input and then
+                     Nam /= TSS_Stream_Output and then
+                     Nam /= TSS_Stream_Read and then
+                     Nam /= TSS_Stream_Write
+               then
+                  raise Program_Error;
                end if;
             end if;
          end if;
index 8acbd877cc7f7cc982bed4e1afea9da8d511a0ba..bd85af264c95bc2981a09720b332ae1da4743029 100644 (file)
@@ -1943,13 +1943,17 @@ package body Exp_Ch5 is
                --  correspond to initializations, where we do want to copy the
                --  tag (No_Ctrl_Actions flag set True) by the expander and we
                --  do not need to mess with tags ever (Expand_Ctrl_Actions flag
-               --  is set True in this case).
+               --  is set True in this case). Finally, it is suppressed if the
+               --  restriction No_Dispatching_Calls is in force because in that
+               --  case predefined primitives are not generated.
 
                or else (Is_Tagged_Type (Typ)
                          and then not Is_Value_Type (Etype (Lhs))
                          and then Chars (Current_Scope) /= Name_uAssign
                          and then Expand_Ctrl_Actions
-                         and then not Discriminant_Checks_Suppressed (Empty))
+                         and then not Discriminant_Checks_Suppressed (Empty)
+                         and then
+                           not Restriction_Active (No_Dispatching_Calls))
             then
                --  Fetch the primitive op _assign and proper type to call it.
                --  Because of possible conflicts between private and full view,
index 0db54598599e15cac47649be1e62b38332b4e5e6..f1a2b829bd0fabd4c0619410202309948f116901 100644 (file)
@@ -1502,14 +1502,19 @@ package body Freeze is
       Test_E : Entity_Id := E;
       Comp   : Entity_Id;
       F_Node : Node_Id;
-      Result : List_Id;
       Indx   : Node_Id;
       Formal : Entity_Id;
       Atype  : Entity_Id;
 
+      Result : List_Id := No_List;
+      --  List of freezing actions, left at No_List if none
+
       Has_Default_Initialization : Boolean := False;
       --  This flag gets set to true for a variable with default initialization
 
+      procedure Add_To_Result (N : Node_Id);
+      --  N is a freezing action to be appended to the Result
+
       procedure Check_Current_Instance (Comp_Decl : Node_Id);
       --  Check that an Access or Unchecked_Access attribute with a prefix
       --  which is the current instance type can only be applied when the type
@@ -1528,6 +1533,19 @@ package body Freeze is
       --  Freeze each component, handle some representation clauses, and freeze
       --  primitive operations if this is a tagged type.
 
+      -------------------
+      -- Add_To_Result --
+      -------------------
+
+      procedure Add_To_Result (N : Node_Id) is
+      begin
+         if No (Result) then
+            Result := New_List (N);
+         else
+            Append (N, Result);
+         end if;
+      end Add_To_Result;
+
       ----------------------------
       -- After_Last_Declaration --
       ----------------------------
@@ -1769,12 +1787,7 @@ package body Freeze is
                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;
+                  Add_To_Result (IR);
                end if;
 
             elsif Ekind (Typ) = E_Anonymous_Access_Subprogram_Type
@@ -2421,7 +2434,6 @@ package body Freeze is
 
       --  Here to freeze the entity
 
-      Result := No_List;
       Set_Is_Frozen (E);
 
       --  Case of entity being frozen is other than a type
@@ -3602,11 +3614,7 @@ package body Freeze is
 
                begin
                   Set_Itype (Ref, E);
-                  if No (Result) then
-                     Result := New_List (Ref);
-                  else
-                     Append (Ref, Result);
-                  end if;
+                  Add_To_Result (Ref);
                end;
             end if;
 
@@ -4052,12 +4060,7 @@ package body Freeze is
          end if;
 
          Set_Entity (F_Node, E);
-
-         if Result = No_List then
-            Result := New_List (F_Node);
-         else
-            Append (F_Node, Result);
-         end if;
+         Add_To_Result (F_Node);
 
          --  A final pass over record types with discriminants. If the type
          --  has an incomplete declaration, there may be constrained access
@@ -4135,6 +4138,8 @@ package body Freeze is
          --  subprogram in main unit, generate descriptor if we are in
          --  Propagate_Exceptions mode.
 
+         --  This is very odd code, it makes a null result, why ???
+
          elsif Propagate_Exceptions
            and then Is_Imported (E)
            and then not Is_Intrinsic_Subprogram (E)
index 53d72d9dbe9c97674e666ed6b722b54d3da9b945..822837c0d19cbb2a3c5824a3ed85bdfa09916688 100644 (file)
  *                                                                          *
  * 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- *
- * ware  Foundation;  either version 3,  or (at your option) any later ver- *
+ * ware  Foundation;  either version 2,  or (at your option) any later ver- *
  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
- * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+ * for  more details.  You should have  received  a copy of the GNU General *
+ * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+ * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
+ * Boston, MA 02110-1301, USA.                                              *
  *                                                                          *
- * As a special exception under Section 7 of GPL version 3, you are granted *
- * additional permissions described in the GCC Runtime Library Exception,   *
- * version 3.1, as published by the Free Software Foundation.               *
- *                                                                          *
- * You should have received a copy of the GNU General Public License and    *
- * a copy of the GCC Runtime Library Exception along with this program;     *
- * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
- * <http://www.gnu.org/licenses/>.                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
  *                                                                          *
  * GNAT was originally developed  by the GNAT team at  New York University. *
  * Extensive contributions were provided by Ada Core Technologies Inc.      *
@@ -378,7 +379,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
     }
 
   recurse = 0;
-  Raise_From_Signal_Handler (exception, (const char *) msg);
+  Raise_From_Signal_Handler (exception, (char *) msg);
 }
 
 void
@@ -1975,23 +1976,20 @@ __gnat_map_signal (int sig)
 /* Tasking and Non-tasking signal handler.  Map SIGnal to Ada exception
    propagation after the required low level adjustments.  */
 
-sigset_t __gnat_signal_mask;
-
-  /* VxWorks will always mask out the signal during the signal handler and
-     will reenable it on a longjmp.  GNAT does not generate a longjmp to
-     return from a signal handler so exception signals will still be masked
-     unless we unmask it. __gnat_signal mask tells sigaction to block the
-     exception signals and sigprocmask to unblock them. */
-
 void
 __gnat_error_handler (int sig,
                      void *si ATTRIBUTE_UNUSED,
                      struct sigcontext *sc ATTRIBUTE_UNUSED)
 {
+  sigset_t mask;
 
-  /* This routine handles the exception signals for all tasks */
-
-  sigprocmask (SIG_UNBLOCK, &__gnat_signal_mask, NULL);
+  /* VxWorks will always mask out the signal during the signal handler and
+     will reenable it on a longjmp.  GNAT does not generate a longjmp to
+     return from a signal handler so the signal will still be masked unless
+     we unmask it.  */
+  sigprocmask (SIG_SETMASK, NULL, &mask);
+  sigdelset (&mask, sig);
+  sigprocmask (SIG_SETMASK, &mask, NULL);
 
   __gnat_map_signal (sig);
 }
@@ -2003,24 +2001,14 @@ __gnat_install_handler (void)
 
   /* Setup signal handler to map synchronous signals to appropriate
      exceptions.  Make sure that the handler isn't interrupted by another
-     signal that might cause a scheduling event! This routine is called
-     only once, for the environment task. Other tasks are set up in the
-     System.Interrupt_Manager package. */
-
-  sigemptyset (&__gnat_signal_mask);
-  sigaddset (SIGBUS, &__gnat_signal_mask);
-  sigaddset (SIGFPE, &__gnat_signal_mask);
-  sigaddset (SIGILL, &__gnat_signal_mask);
-  sigaddset (SIGSEGV, &__gnat_signal_mask);
+     signal that might cause a scheduling event!  */
 
   act.sa_handler = __gnat_error_handler;
   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
-  act.sa_mask = __gnat_signal_mask;
-
-  /* For VxWorks, unconditionally install the exception signal handlers, since
-     pragma Interrupt_State applies to vectored hardware interrupts, not
-     signals.  */
+  sigemptyset (&act.sa_mask);
 
+  /* For VxWorks, install all signal handlers, since pragma Interrupt_State
+     applies to vectored hardware interrupts, not signals.  */
   sigaction (SIGFPE,  &act, NULL);
   sigaction (SIGILL,  &act, NULL);
   sigaction (SIGSEGV, &act, NULL);
@@ -2040,7 +2028,6 @@ __gnat_init_float (void)
      below have no effect.  */
 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
 #if defined (__SPE__)
-  /* VxWorks 6 */
   {
      const unsigned long spefscr_mask = 0xfffffff3;
      unsigned long spefscr;
@@ -2049,7 +2036,6 @@ __gnat_init_float (void)
      asm ("mtspr 512, %0\n\tisync" : : "r" (spefscr));
   }
 #else
-  /* all except VxWorks 653 and MILS */
   asm ("mtfsb0 25");
   asm ("mtfsb0 26");
 #endif
@@ -2057,7 +2043,7 @@ __gnat_init_float (void)
 
 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
   /* This is used to properly initialize the FPU on an x86 for each
-     process thread. For all except VxWorks 653 */
+     process thread.  */
   asm ("finit");
 #endif
 
index b3827d2f39ed0e378a4e3da45debc1304361db02..57b9fcafccaa5374e60d4029df4a2818e7ddb20b 100644 (file)
@@ -1107,7 +1107,12 @@ package body Prj.Conf is
          Write_Line (Config_File_Path.all);
       end if;
 
-      if Config_File_Path /= null then
+      if On_Load_Config /= null then
+         On_Load_Config
+           (Config_File       => Config_Project_Node,
+            Project_Node_Tree => Project_Node_Tree);
+
+      elsif Config_File_Path /= null then
          Prj.Part.Parse
            (In_Tree                => Project_Node_Tree,
             Project                => Config_Project_Node,
@@ -1119,16 +1124,9 @@ package body Prj.Conf is
             Flags                  => Flags,
             Target_Name            => Target_Name);
       else
-         --  Maybe the user will want to create his own configuration file
          Config_Project_Node := Empty_Node;
       end if;
 
-      if On_Load_Config /= null then
-         On_Load_Config
-           (Config_File       => Config_Project_Node,
-            Project_Node_Tree => Project_Node_Tree);
-      end if;
-
       if Config_Project_Node /= Empty_Node then
          Prj.Proc.Process_Project_Tree_Phase_1
            (In_Tree                => Project_Tree,
index 853d746d137dc027e74ac79e88e284a12a7c1551..35ab83cee478ea46df77df061043dd44c9e5f604 100644 (file)
 -- additional permissions described in the GCC Runtime Library Exception,   --
 -- version 3.1, as published by the Free Software Foundation.               --
 --                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
+-- In particular,  you can freely  distribute your programs  built with the --
+-- GNAT Pro compiler, including any required library run-time units,  using --
+-- any licensing terms  of your choosing.  See the AdaCore Software License --
+-- for full details.                                                        --
 --                                                                          --
 -- GNARL was developed by the GNARL team at Florida State University.       --
 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
@@ -39,27 +39,6 @@ package body System.Interrupt_Management is
    use System.OS_Interface;
    use type Interfaces.C.int;
 
-   type Signal_List is array (Signal_ID range <>) of Signal_ID;
-   Exception_Signals : constant Signal_List (1 .. 4) :=
-                         (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
-
-   Exception_Action : aliased struct_sigaction;
-   --  Keep this a variable global so that it is initialized only once
-
-   Signal_Mask : aliased sigset_t;
-   pragma Import (C, Signal_Mask, "__gnat_signal_mask");
-   --  Mask indicating that all exception signals are to be masked
-   --  when a signal is propagated.
-
-   procedure Notify_Exception
-     (signo      : Signal;
-      siginfo    : System.Address;
-      sigcontext : System.Address);
-   pragma Import (C, Notify_Exception, "__gnat_error_handler");
-   --  Map a signal to Ada exception and raise it.  Different versions
-   --  of VxWorks need different mappings. This is addressed in init.c in
-   --  __gnat_map_signal.
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -77,26 +56,6 @@ package body System.Interrupt_Management is
    --    's'   Interrupt_State pragma set state to System (use "default"
    --           system handler)
 
-   ---------------------------
-   -- Initialize_Interrupts --
-   ---------------------------
-
-   --  Since there is no signal inheritance between VxWorks tasks, we need
-   --  to initialize signal handling in each task.
-
-   procedure Initialize_Interrupts is
-      Result  : int;
-      old_act : aliased struct_sigaction;
-   begin
-      for J in Exception_Signals'Range loop
-         Result :=
-           sigaction
-             (Signal (Exception_Signals (J)), Exception_Action'Access,
-              old_act'Unchecked_Access);
-         pragma Assert (Result = 0);
-      end loop;
-   end Initialize_Interrupts;
-
    ----------------
    -- Initialize --
    ----------------
@@ -118,12 +77,6 @@ package body System.Interrupt_Management is
 
       Abort_Task_Interrupt := SIGABRT;
 
-      --  Signal_Mask was initialized in __gnat_install_handler
-
-      Exception_Action.sa_handler := Notify_Exception'Address;
-      Exception_Action.sa_flags := SA_ONSTACK + SA_SIGINFO;
-      Exception_Action.sa_mask := Signal_Mask;
-
       --  Initialize hardware interrupt handling
 
       pragma Assert (Reserve = (Interrupt_ID'Range => False));
index c86410a8695d590565912f9a7dce622ba6523075..d73324d9bc712f594ca451646adf1d8ab2b29876 100644 (file)
 -- additional permissions described in the GCC Runtime Library Exception,   --
 -- version 3.1, as published by the Free Software Foundation.               --
 --                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
+-- In particular,  you can freely  distribute your programs  built with the --
+-- GNAT Pro compiler, including any required library run-time units,  using --
+-- any licensing terms  of your choosing.  See the AdaCore Software License --
+-- for full details.                                                        --
 --                                                                          --
 -- GNARL was developed by the GNARL team at Florida State University.       --
 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
@@ -87,6 +87,7 @@ package System.Interrupt_Management is
    --  or used to implement time delays.
 
    procedure Initialize_Interrupts;
+   pragma Import (C, Initialize_Interrupts, "__gnat_install_handler");
    --  Under VxWorks, there is no signal inheritance between tasks.
    --  This procedure is used to initialize signal-to-exception mapping in
    --  each task.
index 07911aa82d21c04c5af3771a903ee470d16140f1..74e617fcdfb8ac346c011daf3bd5270fdbceebac 100755 (executable)
@@ -349,7 +349,7 @@ package System.Regpat is
    --                                                 12      3
    --     Matches (0) is for "a((b*)c+)(d+)" (the entire expression)
    --     Matches (1) is for "(b*)c+"
-   --     Matches (2) is for "c+"
+   --     Matches (2) is for "b*"
    --     Matches (3) is for "d+"
    --
    --  The number of parenthesis groups that can be retrieved is limited only
index 207b465c5792d5380feab418b5aaa34c6c67131c..c2b04a55c573f3ea3deb75f8628df76c50ee211c 100644 (file)
 -- additional permissions described in the GCC Runtime Library Exception,   --
 -- version 3.1, as published by the Free Software Foundation.               --
 --                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
+-- In particular,  you can freely  distribute your programs  built with the --
+-- GNAT Pro compiler, including any required library run-time units,  using --
+-- any licensing terms  of your choosing.  See the AdaCore Software License --
+-- for full details.                                                        --
 --                                                                          --
 -- GNARL was developed by the GNARL team at Florida State University.       --
 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
@@ -94,11 +94,6 @@ package body System.Task_Primitives.Operations is
 
    Mutex_Protocol : Priority_Type;
 
-   Signal_Mask : aliased sigset_t;
-   pragma Import (C, Signal_Mask, "__gnat_signal_mask");
-   --  Mask indicating that all exception signals are to be masked
-   --  when a signal is propagated.
-
    Single_RTS_Lock : aliased RTS_Lock;
    --  This is a lock to allow only one thread of control in the RTS at a
    --  time; it is used to execute in mutual exclusion from all other tasks.
@@ -180,11 +175,14 @@ package body System.Task_Primitives.Operations is
    procedure Abort_Handler (signo : Signal) is
       pragma Unreferenced (signo);
 
-      Self_ID : constant Task_Id := Self;
-      Old_Set : aliased sigset_t;
-      Result : int;
+      Self_ID        : constant Task_Id := Self;
+      Old_Set        : aliased sigset_t;
+      Unblocked_Mask : aliased sigset_t;
+      Result         : int;
       pragma Warnings (Off, Result);
 
+      use System.Interrupt_Management;
+
    begin
       --  It is not safe to raise an exception when using ZCX and the GCC
       --  exception handling mechanism.
@@ -201,10 +199,26 @@ package body System.Task_Primitives.Operations is
 
          --  Make sure signals used for RTS internal purposes are unmasked
 
+         Result := sigemptyset (Unblocked_Mask'Access);
+         pragma Assert (Result = 0);
+         Result :=
+           sigaddset
+           (Unblocked_Mask'Access,
+            Signal (Abort_Task_Interrupt));
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGBUS);
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGFPE);
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGILL);
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGSEGV);
+         pragma Assert (Result = 0);
+
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Signal_Mask'Access,
+              Unblocked_Mask'Access,
               Old_Set'Access);
          pragma Assert (Result = 0);
 
index dedc52d8a89317978d767665eb6b3fc9e64dd966..aa6bbed1c8805f9e010102b927d33b4c2142018b 100644 (file)
@@ -282,6 +282,7 @@ package body Sem_Elim is
 
                   if Present (Overridden)
                     and then not Is_Eliminated (Overridden)
+                    and then not Is_Abstract_Subprogram (Overridden)
                   then
                      Error_Msg_Name_1 := Chars (E);
                      Error_Msg_N ("cannot eliminate subprogram %", E);
index 401373474ad737151be1a099051ab05bbf1de493..2227049149291c926181f268226ede4dcb9708ab 100644 (file)
@@ -40,10 +40,10 @@ package Stylesw is
    --  options. The default values shown here correspond to no style checking.
 
    --  If any of these values is set to a non-default value, then
-   --  Opt.Style_Check is set True to active calls to this package.
+   --  Opt.Style_Check is set True to activate calls to this package.
 
    --  The actual mechanism for setting these switches to other than default
-   --  values is via the Set_Style_Check_Option procedure or through a call to
+   --  values is via the Set_Style_Check_Options procedure or through a call to
    --  Set_Default_Style_Check_Options. They should not be set directly in any
    --  other manner.
 
@@ -315,8 +315,8 @@ package Stylesw is
 
    procedure Set_Style_Check_Options (Options : String);
    --  Like the above procedure, but used when the Options string is known to
-   --  be valid. This is for example appropriate for calls where the string ==
-   --  was obtained by Save_Style_Check_Options.
+   --  be valid. This is for example appropriate for calls where the string was
+   --  obtained by Save_Style_Check_Options.
 
    procedure Reset_Style_Check_Options;
    --  Sets all style check options to off