diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 11 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 3 | ||||
| -rw-r--r-- | gcc/ada/s-interr-hwint.adb | 192 | ||||
| -rw-r--r-- | gcc/ada/s-interr-sigaction.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/s-interr-vms.adb | 145 | ||||
| -rw-r--r-- | gcc/ada/s-interr.adb | 168 | ||||
| -rw-r--r-- | gcc/ada/s-shasto.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-tasren.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/s-tpoben.adb | 12 |
10 files changed, 305 insertions, 290 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 707f57a..06f92f3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2014-07-16 Bob Duff <duff@adacore.com> + + * gnat_ugn.texi: Document need for project file + for --incremental switch for gnat2xml. + +2014-07-16 Robert Dewar <dewar@adacore.com> + + * gnat_rm.texi: Fix example of non-packable components in packed + records section. + +2014-07-16 Robert Dewar <dewar@adacore.com> + + * s-tpoben.adb, s-tasren.adb, s-interr.adb, s-interr-hwint.adb, + s-shasto.adb, s-interr-vms.adb, s-interr-sigaction.adb: Avoid use of + upper case in exception messages. + 2014-07-16 Robert Dewar <dewar@adacore.com> * snames.ads-tmpl, sem_attr.adb, exp_attr.adb: Same_Storage attribute diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 8aa0244..6afacd2 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -15464,7 +15464,8 @@ taken by components. We distinguish between @emph{packable} components and Components of the following types are considered packable: @itemize @bullet @item -All primitive types are packable. +Components of a primitive type are packable unless they are aliased +or of an atomic type. @item Small packed arrays, whose size does not exceed 64 bits, and where the @@ -15491,10 +15492,12 @@ For example, consider the record type Rb2 is array (1 .. 65) of Boolean; pragma Pack (rb2); + type AF is new Float with Atomic; + type x2 is record l1 : Boolean; l2 : Duration; - l3 : Float; + l3 : AF; l4 : Boolean; l5 : Rb1; l6 : Rb2; @@ -15522,8 +15525,8 @@ Studying this example, we see that the packable fields @code{l1} and @code{l2} are of length equal to their sizes, and placed at specific bit boundaries (and not byte boundaries) to -eliminate padding. But @code{l3} is of a non-packable float type, so -it is on the next appropriate alignment boundary. +eliminate padding. But @code{l3} is of a non-packable float type (because +it is aliased), so it is on the next appropriate alignment boundary. The next two fields are fully packable, so @code{l4} and @code{l5} are minimally packed with no gaps. However, type @code{Rb2} is a packed diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d2f0818..6a62aa7 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -15145,7 +15145,8 @@ Options: --incremental -- incremental processing on a per-file basis. Source files are only processed if they have been modified, or if files they depend on have been modified. This is similar to the way gnatmake/gprbuild - only compiles files that need to be recompiled. + only compiles files that need to be recompiled. You need to use a project + file for this to work. --output-dir=@var{dir} -- generate one .xml file for each Ada source file, in directory @file{dir}. (Default is to generate the XML to standard diff --git a/gcc/ada/s-interr-hwint.adb b/gcc/ada/s-interr-hwint.adb index 5cb38ea..5f5961c 100644 --- a/gcc/ada/s-interr-hwint.adb +++ b/gcc/ada/s-interr-hwint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -54,14 +54,14 @@ -- any time. -- Within this package, the lock L is used to protect the various status --- tables. If there is a Server_Task associated with a signal or interrupt, we --- use the per-task lock of the Server_Task instead so that we protect the +-- tables. If there is a Server_Task associated with a signal or interrupt, +-- we use the per-task lock of the Server_Task instead so that we protect the -- status between Interrupt_Manager and Server_Task. Protection among service -- requests are ensured via user calls to the Interrupt_Manager entries. -- This is reasonably generic version of this package, supporting vectored --- hardware interrupts using non-RTOS specific adapter routines which --- should easily implemented on any RTOS capable of supporting GNAT. +-- hardware interrupts using non-RTOS specific adapter routines which should +-- easily implemented on any RTOS capable of supporting GNAT. with Ada.Unchecked_Conversion; with Ada.Task_Identification; @@ -92,8 +92,8 @@ package body System.Interrupts is -- Local Tasks -- ----------------- - -- WARNING: System.Tasking.Stages performs calls to this task with - -- low-level constructs. Do not change this spec without synchronizing it. + -- WARNING: System.Tasking.Stages performs calls to this task with low- + -- level constructs. Do not change this spec without synchronizing it. task Interrupt_Manager is entry Detach_Interrupt_Entries (T : Task_Id); @@ -148,8 +148,8 @@ package body System.Interrupts is (others => (null, Static => False)); pragma Volatile_Components (User_Handler); -- Holds the protected procedure handler (if any) and its Static - -- information for each interrupt or signal. A handler is static - -- iff it is specified through the pragma Attach_Handler. + -- information for each interrupt or signal. A handler is static iff it + -- is specified through the pragma Attach_Handler. User_Entry : array (Interrupt_ID) of Entry_Assoc := (others => (T => Null_Task, E => Null_Task_Entry)); @@ -181,8 +181,8 @@ package body System.Interrupts is Semaphore_ID_Map : array (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt) of Binary_Semaphore_Id := (others => 0); - -- Array of binary semaphores associated with vectored interrupts - -- Note that the last bound should be Max_HW_Interrupt, but this will raise + -- Array of binary semaphores associated with vectored interrupts. Note + -- that the last bound should be Max_HW_Interrupt, but this will raise -- Storage_Error if Num_HW_Interrupts is null, so use an extra 4 bytes -- instead. @@ -190,9 +190,9 @@ package body System.Interrupts is -- Variable for allocating an Interrupt_Server_Task Handler_Installed : array (HW_Interrupt) of Boolean := (others => False); - -- True if Notify_Interrupt was connected to the interrupt. Handlers - -- can be connected but disconnection is not possible on VxWorks. - -- Therefore we ensure Notify_Installed is connected at most once. + -- True if Notify_Interrupt was connected to the interrupt. Handlers can + -- be connected but disconnection is not possible on VxWorks. Therefore + -- we ensure Notify_Installed is connected at most once. ----------------------- -- Local Subprograms -- @@ -230,12 +230,12 @@ package body System.Interrupts is -------------------- -- Calling this procedure with New_Handler = null and Static = True - -- means we want to detach the current handler regardless of the - -- previous handler's binding status (i.e. do not care if it is a - -- dynamic or static handler). + -- means we want to detach the current handler regardless of the previous + -- handler's binding status (i.e. do not care if it is a dynamic or static + -- handler). - -- This option is needed so that during the finalization of a PO, we - -- can detach handlers attached through pragma Attach_Handler. + -- This option is needed so that during the finalization of a PO, we can + -- detach handlers attached through pragma Attach_Handler. procedure Attach_Handler (New_Handler : Parameterless_Handler; @@ -260,8 +260,7 @@ package body System.Interrupts is Int_Ref : System.Address) is Interrupt : constant Interrupt_ID := - Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); - + Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); begin Check_Reserved_Interrupt (Interrupt); Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt); @@ -284,7 +283,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; else return; end if; @@ -300,9 +299,9 @@ package body System.Interrupts is begin Check_Reserved_Interrupt (Interrupt); - -- ??? Since Parameterless_Handler is not Atomic, the - -- current implementation is wrong. We need a new service in - -- Interrupt_Manager to ensure atomicity. + -- ??? Since Parameterless_Handler is not Atomic, the current + -- implementation is wrong. We need a new service in Interrupt_Manager + -- to ensure atomicity. return User_Handler (Interrupt).H; end Current_Handler; @@ -320,7 +319,8 @@ package body System.Interrupts is procedure Detach_Handler (Interrupt : Interrupt_ID; - Static : Boolean := False) is + Static : Boolean := False) + is begin Check_Reserved_Interrupt (Interrupt); Interrupt_Manager.Detach_Handler (Interrupt, Static); @@ -340,12 +340,12 @@ package body System.Interrupts is ---------------------- -- Calling this procedure with New_Handler = null and Static = True - -- means we want to detach the current handler regardless of the - -- previous handler's binding status (i.e. do not care if it is a - -- dynamic or static handler). + -- means we want to detach the current handler regardless of the previous + -- handler's binding status (i.e. we do not care if it is a dynamic or + -- static handler). - -- This option is needed so that during the finalization of a PO, we - -- can detach handlers attached through pragma Attach_Handler. + -- This option is needed so that during the finalization of a PO, we can + -- detach handlers attached through pragma Attach_Handler. procedure Exchange_Handler (Old_Handler : out Parameterless_Handler; @@ -394,7 +394,6 @@ package body System.Interrupts is procedure Finalize_Interrupt_Servers is HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0; - begin if HW_Interrupts then for Int in HW_Interrupt loop @@ -405,8 +404,8 @@ package body System.Interrupts is then Interrupt_Manager.Attach_Handler (New_Handler => null, - Interrupt => Interrupt_ID (Int), - Static => True, + Interrupt => Interrupt_ID (Int), + Static => True, Restoration => True); end if; end loop; @@ -579,7 +578,6 @@ package body System.Interrupts is Fat := To_Fat_Ptr (Handler); Ptr := Registered_Handler_Head; - while Ptr /= null loop if Ptr.H = Fat.Handler_Addr then return True; @@ -605,31 +603,28 @@ package body System.Interrupts is -- Notify_Interrupt -- ---------------------- - -- Umbrella handler for vectored hardware interrupts (as opposed to - -- signals and exceptions). As opposed to the signal implementation, - -- this handler is installed in the vector table when the first Ada - -- handler is attached to the interrupt. However because VxWorks don't - -- support disconnecting handlers, this subprogram always test whether - -- or not an Ada handler is effectively attached. + -- Umbrella handler for vectored hardware interrupts (as opposed to signals + -- and exceptions). As opposed to the signal implementation, this handler + -- is installed in the vector table when the first Ada handler is attached + -- to the interrupt. However because VxWorks don't support disconnecting + -- handlers, this subprogram always test whether or not an Ada handler is + -- effectively attached. - -- Otherwise, the handler that existed prior to program startup is - -- in the vector table. This ensures that handlers installed by - -- the BSP are active unless explicitly replaced in the program text. + -- Otherwise, the handler that existed prior to program startup is in the + -- vector table. This ensures that handlers installed by the BSP are active + -- unless explicitly replaced in the program text. - -- Each Interrupt_Server_Task has an associated binary semaphore - -- on which it pends once it's been started. This routine determines - -- The appropriate semaphore and issues a semGive call, waking - -- the server task. When a handler is unbound, - -- System.Interrupts.Unbind_Handler issues a Binary_Semaphore_Flush, - -- and the server task deletes its semaphore and terminates. + -- Each Interrupt_Server_Task has an associated binary semaphore on which + -- it pends once it's been started. This routine determines The appropriate + -- semaphore and issues a semGive call, waking the server task. When + -- a handler is unbound, System.Interrupts.Unbind_Handler issues a + -- Binary_Semaphore_Flush, and the server task deletes its semaphore + -- and terminates. procedure Notify_Interrupt (Param : System.Address) is Interrupt : constant Interrupt_ID := Interrupt_ID (Param); - - Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt); - - Status : int; - + Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt); + Status : int; begin if Id /= 0 then Status := Binary_Semaphore_Release (Id); @@ -645,7 +640,7 @@ package body System.Interrupts is begin Check_Reserved_Interrupt (Interrupt); return Storage_Elements.To_Address - (Storage_Elements.Integer_Address (Interrupt)); + (Storage_Elements.Integer_Address (Interrupt)); end Reference; -------------------------------- @@ -656,15 +651,15 @@ package body System.Interrupts is New_Node_Ptr : R_Link; begin - -- This routine registers a handler as usable for dynamic - -- interrupt handler association. Routines attaching and detaching - -- handlers dynamically should determine whether the handler is - -- registered. Program_Error should be raised if it is not registered. + -- This routine registers a handler as usable for dynamic interrupt + -- handler association. Routines attaching and detaching handlers + -- dynamically should determine whether the handler is registered. + -- Program_Error should be raised if it is not registered. - -- Pragma Interrupt_Handler can only appear in a library - -- level PO definition and instantiation. Therefore, we do not need - -- to implement an unregister operation. Nor do we need to - -- protect the queue structure with a lock. + -- Pragma Interrupt_Handler can only appear in a library level PO + -- definition and instantiation. Therefore, we do not need to implement + -- an unregister operation. Nor do we need to protect the queue + -- structure with a lock. pragma Assert (Handler_Addr /= System.Null_Address); @@ -674,7 +669,6 @@ package body System.Interrupts is if Registered_Handler_Head = null then Registered_Handler_Head := New_Node_Ptr; Registered_Handler_Tail := New_Node_Ptr; - else Registered_Handler_Tail.Next := New_Node_Ptr; Registered_Handler_Tail := New_Node_Ptr; @@ -717,7 +711,7 @@ package body System.Interrupts is procedure Unimplemented (Feature : String) is begin - raise Program_Error with Feature & " not implemented on VxWorks"; + raise Program_Error with feature & " not implemented on VxWorks"; end Unimplemented; ----------------------- @@ -732,8 +726,8 @@ package body System.Interrupts is procedure Bind_Handler (Interrupt : Interrupt_ID); -- This procedure does not do anything if a signal is blocked. - -- Otherwise, we have to interrupt Server_Task for status change through - -- a wakeup signal. + -- Otherwise, we have to interrupt Server_Task for status change + -- through a wakeup signal. procedure Unbind_Handler (Interrupt : Interrupt_ID); -- This procedure does not do anything if a signal is blocked. @@ -767,8 +761,8 @@ package body System.Interrupts is procedure Unbind_Handler (Interrupt : Interrupt_ID) is Status : int; - begin + begin -- Flush server task off semaphore, allowing it to terminate Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt)); @@ -786,11 +780,12 @@ package body System.Interrupts is Old_Handler : Parameterless_Handler; begin if User_Entry (Interrupt).T /= Null_Task then - -- If an interrupt entry is installed raise - -- Program_Error. (propagate it to the caller). + + -- If an interrupt entry is installed raise Program_Error + -- (propagate it to the caller). raise Program_Error with - "An interrupt entry is already installed"; + "an interrupt entry is already installed"; end if; -- Note : Static = True will pass the following check. This is the @@ -799,11 +794,11 @@ package body System.Interrupts is if not Static and then User_Handler (Interrupt).Static then - -- Trying to detach a static Interrupt Handler. raise + -- Trying to detach a static Interrupt Handler, raise -- Program_Error. raise Program_Error with - "Trying to detach a static Interrupt Handler"; + "trying to detach a static Interrupt Handler"; end if; Old_Handler := User_Handler (Interrupt).H; @@ -833,32 +828,32 @@ package body System.Interrupts is if User_Entry (Interrupt).T /= Null_Task then -- If an interrupt entry is already installed, raise - -- Program_Error. (propagate it to the caller). + -- Program_Error (propagate it to the caller). - raise Program_Error with "An interrupt is already installed"; + raise Program_Error with "an interrupt is already installed"; end if; - -- Note : A null handler with Static = True will - -- pass the following check. This is the case when we want to - -- detach a handler regardless of the Static status - -- of Current_Handler. - -- We don't check anything if Restoration is True, since we - -- may be detaching a static handler to restore a dynamic one. + -- Note : A null handler with Static = True will pass the following + -- check. This is the case when we want to detach a handler + -- regardless of the Static status of Current_Handler. + + -- We don't check anything if Restoration is True, since we may be + -- detaching a static handler to restore a dynamic one. if not Restoration and then not Static and then (User_Handler (Interrupt).Static - -- Trying to overwrite a static Interrupt Handler with a - -- dynamic Handler + -- Trying to overwrite a static Interrupt Handler with a dynamic + -- Handler - -- The new handler is not specified as an - -- Interrupt Handler by a pragma. + -- The new handler is not specified as an Interrupt Handler by a + -- pragma. or else not Is_Registered (New_Handler)) then raise Program_Error with - "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"; + "trying to overwrite a static interrupt handler with a " + & "dynamic handler"; end if; -- Save the old handler @@ -879,8 +874,8 @@ package body System.Interrupts is User_Handler (Interrupt).Static := Static; end if; - -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_Id info in Server_ID array. + -- Invoke a corresponding Server_Task if not yet created. Place + -- Task_Id info in Server_ID array. if New_Handler /= null and then @@ -909,11 +904,11 @@ package body System.Interrupts is end if; end Unprotected_Exchange_Handler; - -- Start of processing for Interrupt_Manager + -- Start of processing for Interrupt_Manager begin - -- By making this task independent of any master, when the process - -- goes away, the Interrupt_Manager will terminate gracefully. + -- By making this task independent of any master, when the process goes + -- away, the Interrupt_Manager will terminate gracefully. System.Tasking.Utilities.Make_Independent; @@ -948,15 +943,16 @@ package body System.Interrupts is or accept Detach_Handler - (Interrupt : Interrupt_ID; - Static : Boolean) + (Interrupt : Interrupt_ID; + Static : Boolean) do Unprotected_Detach_Handler (Interrupt, Static); end Detach_Handler; + or accept Bind_Interrupt_To_Entry - (T : Task_Id; - E : Task_Entry_Index; + (T : Task_Id; + E : Task_Entry_Index; Interrupt : Interrupt_ID) do -- If there is a binding already (either a procedure or an @@ -966,7 +962,7 @@ package body System.Interrupts is or else User_Entry (Interrupt).T /= Null_Task then raise Program_Error with - "A binding for this interrupt is already present"; + "a binding for this interrupt is already present"; end if; User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E); diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index 233fdc3..1daca4d1 100644 --- a/gcc/ada/s-interr-sigaction.adb +++ b/gcc/ada/s-interr-sigaction.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -86,8 +86,8 @@ package body System.Interrupts is Interrupt : Interrupt_ID; Static : Boolean; Restoration : Boolean); - -- This internal procedure is needed to finalize protected objects - -- that contain interrupt handlers. + -- This internal procedure is needed to finalize protected objects that + -- contain interrupt handlers. procedure Signal_Handler (Sig : Interrupt_ID); pragma Convention (C, Signal_Handler); @@ -157,7 +157,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Descriptors (Interrupt).T /= Null_Task; @@ -171,7 +171,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; else return Descriptors (Interrupt).Kind /= Unknown; end if; @@ -329,7 +329,8 @@ package body System.Interrupts is procedure Attach_Handler (New_Handler : Parameterless_Handler; Interrupt : Interrupt_ID; - Static : Boolean := False) is + Static : Boolean := False) + is begin Attach_Handler (New_Handler, Interrupt, Static, False); end Attach_Handler; @@ -359,8 +360,8 @@ package body System.Interrupts is or else not Is_Registered (New_Handler)) then raise Program_Error with - "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"; + "trying to overwrite a static interrupt handler with a " & + "dynamic handler"; end if; if Handlers (Interrupt) = null then @@ -405,10 +406,10 @@ package body System.Interrupts is if Descriptors (Interrupt).Kind = Task_Entry then - -- In case we have an Interrupt Entry already installed. - -- raise a program error. (propagate it to the caller). + -- In case we have an Interrupt Entry already installed, raise a + -- program error (propagate it to the caller). - raise Program_Error with "An interrupt is already installed"; + raise Program_Error with "an interrupt is already installed"; else Old_Handler := Current_Handler (Interrupt); @@ -430,12 +431,12 @@ package body System.Interrupts is end if; if Descriptors (Interrupt).Kind = Task_Entry then - raise Program_Error with "Trying to detach an Interrupt Entry"; + raise Program_Error with "trying to detach an interrupt entry"; end if; if not Static and then Descriptors (Interrupt).Static then raise Program_Error with - "Trying to detach a static Interrupt Handler"; + "trying to detach a static interrupt handler"; end if; Descriptors (Interrupt) := @@ -504,7 +505,6 @@ package body System.Interrupts is Fat := To_Fat_Ptr (Handler); while Ptr /= null loop - if Ptr.H = Fat.Handler_Addr then return True; end if; @@ -536,7 +536,7 @@ package body System.Interrupts is if Descriptors (Interrupt).Kind /= Unknown then raise Program_Error with - "A binding for this interrupt is already present"; + "a binding for this interrupt is already present"; end if; if Handlers (Interrupt) = null then diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index 16dc881..7ef3b1c 100644 --- a/gcc/ada/s-interr-vms.adb +++ b/gcc/ada/s-interr-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -104,8 +104,8 @@ package body System.Interrupts is Static : Boolean); entry Detach_Handler - (Interrupt : Interrupt_ID; - Static : Boolean); + (Interrupt : Interrupt_ID; + Static : Boolean); entry Bind_Interrupt_To_Entry (T : Task_Id; @@ -172,10 +172,10 @@ package body System.Interrupts is Last_Unblocker : constant array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); --- ??? pragma Volatile_Components (Last_Unblocker); - -- Holds the ID of the last Task which Unblocked this Interrupt. - -- It contains Null_Task if no tasks have ever requested the - -- Unblocking operation or the Interrupt is currently Blocked. + -- ??? pragma Volatile_Components (Last_Unblocker); + -- Holds the ID of the last Task which Unblocked this Interrupt. It + -- contains Null_Task if no tasks have ever requested the Unblocking + -- operation or the Interrupt is currently Blocked. Server_ID : array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); @@ -185,8 +185,8 @@ package body System.Interrupts is -- decide whether to create a new Server_Task. -- Type and Head, Tail of the list containing Registered Interrupt - -- Handlers. These definitions are used to register the handlers specified - -- by the pragma Interrupt_Handler. + -- Handlers. These definitions are used to register the handlers + -- specified by the pragma Interrupt_Handler. type Registered_Handler; type R_Link is access all Registered_Handler; @@ -218,15 +218,15 @@ package body System.Interrupts is New_Node_Ptr : R_Link; begin - -- This routine registers the Handler as usable for Dynamic - -- Interrupt Handler. Routines attaching and detaching Handler - -- dynamically should first consult if the Handler is registered. - -- A Program Error should be raised if it is not registered. + -- This routine registers the Handler as usable for Dynamic Interrupt + -- Handler. Routines attaching and detaching Handler dynamically should + -- first consult if the Handler is registered. A Program Error should be + -- raised if it is not registered. - -- The pragma Interrupt_Handler can only appear in the library - -- level PO definition and instantiation. Therefore, we do not need - -- to implement Unregistering operation. Neither we need to - -- protect the queue structure using a Lock. + -- The pragma Interrupt_Handler can only appear in the library level PO + -- definition and instantiation. Therefore, we do not need to implement + -- Unregistering operation. Neither we need to protect the queue + -- structure using a Lock. pragma Assert (Handler_Addr /= System.Null_Address); @@ -267,7 +267,6 @@ package body System.Interrupts is Fat := To_Fat_Ptr (Handler); Ptr := Registered_Handler_Head; - while Ptr /= null loop if Ptr.H = Fat.Handler_Addr then return True; @@ -296,7 +295,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Entry (Interrupt).T /= Null_Task; @@ -310,7 +309,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Handler (Interrupt).H /= null; @@ -324,7 +323,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Blocked (Interrupt); @@ -338,7 +337,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Ignored (Interrupt); @@ -354,7 +353,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; -- ??? Since Parameterless_Handler is not Atomic, the current @@ -369,9 +368,9 @@ package body System.Interrupts is -------------------- -- Calling this procedure with New_Handler = null and Static = True - -- means we want to detach the current handler regardless of the - -- previous handler's binding status (i.e. do not care if it is a - -- dynamic or static handler). + -- means we want to detach the current handler regardless of the previous + -- handler's binding status (i.e. we do not care if it is a dynamic or + -- static handler). -- This option is needed so that during the finalization of a PO, we -- can detach handlers attached through pragma Attach_Handler. @@ -379,15 +378,15 @@ package body System.Interrupts is procedure Attach_Handler (New_Handler : Parameterless_Handler; Interrupt : Interrupt_ID; - Static : Boolean := False) is + Static : Boolean := False) + is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static); - end Attach_Handler; ---------------------- @@ -411,12 +410,11 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Exchange_Handler (Old_Handler, New_Handler, Interrupt, Static); - end Exchange_Handler; -------------------- @@ -437,7 +435,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Detach_Handler (Interrupt, Static); @@ -451,11 +449,11 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Storage_Elements.To_Address - (Storage_Elements.Integer_Address (Interrupt)); + (Storage_Elements.Integer_Address (Interrupt)); end Reference; ----------------------------- @@ -472,16 +470,15 @@ package body System.Interrupts is Int_Ref : System.Address) is Interrupt : constant Interrupt_ID := - Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); + Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt); - end Bind_Interrupt_To_Entry; ------------------------------ @@ -501,7 +498,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Block_Interrupt (Interrupt); @@ -515,7 +512,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unblock_Interrupt (Interrupt); @@ -530,7 +527,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Last_Unblocker (Interrupt); @@ -544,7 +541,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Ignore_Interrupt (Interrupt); @@ -602,7 +599,7 @@ package body System.Interrupts is -- In case we have an Interrupt Entry already installed. -- raise a program error. (propagate it to the caller). - raise Program_Error with "An interrupt is already installed"; + raise Program_Error with "an interrupt is already installed"; end if; -- Note: A null handler with Static=True will pass the following @@ -618,14 +615,14 @@ package body System.Interrupts is and then (User_Handler (Interrupt).Static - -- The new handler is not specified as an - -- Interrupt Handler by a pragma. + -- The new handler is not specified as an + -- Interrupt Handler by a pragma. - or else not Is_Registered (New_Handler)) + or else not Is_Registered (New_Handler)) then raise Program_Error with - "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"; + "trying to overwrite a static interrupt handler with a " & + "dynamic handler"; end if; -- The interrupt should no longer be ignored if it was ever ignored @@ -673,11 +670,11 @@ package body System.Interrupts is begin if User_Entry (Interrupt).T /= Null_Task then - -- In case we have an Interrupt Entry installed. - -- raise a program error. (propagate it to the caller). + -- In case we have an Interrupt Entry installed, raise a program + -- error, (propagate it to the caller). raise Program_Error with - "An interrupt entry is already installed"; + "an interrupt entry is already installed"; end if; -- Note : Static = True will pass the following check. That is the @@ -685,11 +682,11 @@ package body System.Interrupts is -- status of the current_Handler. if not Static and then User_Handler (Interrupt).Static then - -- Tries to detach a static Interrupt Handler. - -- raise a program error. + + -- Tries to detach a static Interrupt Handler, raise program error raise Program_Error with - "Trying to detach a static Interrupt Handler"; + "trying to detach a static interrupt handler"; end if; -- The interrupt should no longer be ignored if @@ -708,17 +705,17 @@ package body System.Interrupts is -- Start of processing for Interrupt_Manager begin - -- By making this task independent of master, when the process - -- goes away, the Interrupt_Manager will terminate gracefully. + -- By making this task independent of master, when the process goes + -- away, the Interrupt_Manager will terminate gracefully. System.Tasking.Utilities.Make_Independent; - -- Environment task gets its own interrupt mask, saves it, - -- and then masks all interrupts except the Keep_Unmasked set. + -- Environment task gets its own interrupt mask, saves it, and then + -- masks all interrupts except the Keep_Unmasked set. - -- During rendezvous, the Interrupt_Manager receives the old - -- interrupt mask of the environment task, and sets its own - -- interrupt mask to that value. + -- During rendezvous, the Interrupt_Manager receives the old interrupt + -- mask of the environment task, and sets its own interrupt mask to that + -- value. -- The environment task will call the entry of Interrupt_Manager some -- during elaboration of the body of this package. @@ -728,18 +725,18 @@ package body System.Interrupts is null; end Initialize; - -- Note: All tasks in RTS will have all the Reserve Interrupts - -- being masked (except the Interrupt_Manager) and Keep_Unmasked - -- unmasked when created. + -- Note: All tasks in RTS will have all the Reserve Interrupts being + -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked + -- when created. - -- Abort_Task_Interrupt is one of the Interrupt unmasked - -- in all tasks. We mask the Interrupt in this particular task - -- so that "sigwait" is possible to catch an explicitly sent - -- Abort_Task_Interrupt from the Server_Tasks. + -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks. + -- We mask the Interrupt in this particular task so that "sigwait" is + -- possible to catch an explicitly sent Abort_Task_Interrupt from the + -- Server_Tasks. - -- This sigwaiting is needed so that we make sure a Server_Task is - -- out of its own sigwait state. This extra synchronization is - -- necessary to prevent following scenarios. + -- This sigwaiting is needed so that we make sure a Server_Task is out + -- of its own sigwait state. This extra synchronization is necessary to + -- prevent following scenarios. -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the -- Server_Task then changes its own interrupt mask (OS level). @@ -759,6 +756,7 @@ package body System.Interrupts is declare Old_Handler : Parameterless_Handler; + begin select @@ -801,7 +799,7 @@ package body System.Interrupts is or else User_Entry (Interrupt).T /= Null_Task then raise Program_Error with - "A binding for this interrupt is already present"; + "a binding for this interrupt is already present"; end if; -- The interrupt should no longer be ignored if @@ -877,8 +875,8 @@ package body System.Interrupts is end select; exception - -- If there is a program error we just want to propagate it - -- to the caller and do not want to stop this task. + -- If there is a program error we just want to propagate it to the + -- caller and do not want to stop this task. when Program_Error => null; @@ -1026,7 +1024,6 @@ package body System.Interrupts is (Object : access Dynamic_Interrupt_Protection) return Boolean is pragma Warnings (Off, Object); - begin return True; end Has_Interrupt_Or_Attach_Handler; diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 7b7b7bd..cbf8f03 100644 --- a/gcc/ada/s-interr.adb +++ b/gcc/ada/s-interr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -31,26 +31,26 @@ -- Invariants: --- All user-handleable interrupts are masked at all times in all --- tasks/threads except possibly for the Interrupt_Manager task. +-- All user-handleable interrupts are masked at all times in all tasks/threads +-- except possibly for the Interrupt_Manager task. --- When a user task wants to have the effect of masking/unmasking an --- interrupt, it must call Block_Interrupt/Unblock_Interrupt, which --- will have the effect of unmasking/masking the interrupt in the --- Interrupt_Manager task. +-- When a user task wants to achieve masking/unmasking an interrupt, it must +-- call Block_Interrupt/Unblock_Interrupt, which will have the effect of +-- unmasking/masking the interrupt in the Interrupt_Manager task. -- Note : Direct calls to sigaction, sigprocmask, pthread_sigsetmask or any -- other low-level interface that changes the interrupt action or -- interrupt mask needs a careful thought. + -- One may achieve the effect of system calls first masking RTS blocked -- (by calling Block_Interrupt) for the interrupt under consideration. -- This will make all the tasks in RTS blocked for the Interrupt. --- Once we associate a Server_Task with an interrupt, the task never --- goes away, and we never remove the association. +-- Once we associate a Server_Task with an interrupt, the task never goes +-- away, and we never remove the association. --- There is no more than one interrupt per Server_Task and no more than --- one Server_Task per interrupt. +-- There is no more than one interrupt per Server_Task and no more than one +-- Server_Task per interrupt. with Ada.Task_Identification; @@ -236,7 +236,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static); @@ -255,13 +255,13 @@ package body System.Interrupts is E : Task_Entry_Index; Int_Ref : System.Address) is - Interrupt : constant Interrupt_ID := - Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); + Interrupt : constant Interrupt_ID := + Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt); @@ -275,7 +275,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Block_Interrupt (Interrupt); @@ -291,7 +291,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; -- ??? Since Parameterless_Handler is not Atomic, the current @@ -319,7 +319,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Detach_Handler (Interrupt, Static); @@ -355,7 +355,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Exchange_Handler @@ -385,8 +385,8 @@ package body System.Interrupts is -- signal to the Server_Task if not Interrupt_Manager'Terminated - and then State (System.Interrupt_Management.Abort_Task_Interrupt) - /= Default + and then + State (System.Interrupt_Management.Abort_Task_Interrupt) /= Default then for N in reverse Object.Previous_Handlers'Range loop Interrupt_Manager.Attach_Handler @@ -431,7 +431,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Ignore_Interrupt (Interrupt); @@ -488,7 +488,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Blocked (Interrupt); @@ -502,7 +502,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Entry (Interrupt).T /= Null_Task; @@ -516,7 +516,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Handler (Interrupt).H /= null; @@ -530,7 +530,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Ignored (Interrupt); @@ -561,7 +561,6 @@ package body System.Interrupts is Fat := To_Fat_Ptr (Handler); Ptr := Registered_Handler_Head; - while Ptr /= null loop if Ptr.H = Fat.Handler_Addr then return True; @@ -590,11 +589,11 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Storage_Elements.To_Address - (Storage_Elements.Integer_Address (Interrupt)); + (Storage_Elements.Integer_Address (Interrupt)); end Reference; --------------------------------- @@ -638,7 +637,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unblock_Interrupt (Interrupt); @@ -654,7 +653,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Last_Unblocker (Interrupt); @@ -668,7 +667,7 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then raise Program_Error with - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unignore_Interrupt (Interrupt); @@ -743,13 +742,14 @@ package body System.Interrupts is procedure Unbind_Handler (Interrupt : Interrupt_ID) is Server : System.Tasking.Task_Id; + begin if not Blocked (Interrupt) then + -- Currently, there is a Handler or an Entry attached and - -- corresponding Server_Task is waiting on "sigwait." - -- We have to wake up the Server_Task and make it - -- wait on condition variable by sending an - -- Abort_Task_Interrupt + -- corresponding Server_Task is waiting on "sigwait." We have to + -- wake up the Server_Task and make it wait on condition variable + -- by sending an Abort_Task_Interrupt Server := Server_ID (Interrupt); @@ -803,11 +803,11 @@ package body System.Interrupts is begin if User_Entry (Interrupt).T /= Null_Task then - -- In case we have an Interrupt Entry installed. - -- raise a program error. (propagate it to the caller). + -- In case we have an Interrupt Entry installed, raise a program + -- error, (propagate it to the caller). raise Program_Error with - "An interrupt entry is already installed"; + "an interrupt entry is already installed"; end if; -- Note : Static = True will pass the following check. That is the @@ -820,7 +820,7 @@ package body System.Interrupts is -- raise a program error. raise Program_Error with - "Trying to detach a static Interrupt Handler"; + "trying to detach a static interrupt handler"; end if; -- The interrupt should no longer be ignored if @@ -854,35 +854,35 @@ package body System.Interrupts is begin if User_Entry (Interrupt).T /= Null_Task then - -- In case we have an Interrupt Entry already installed. - -- raise a program error. (propagate it to the caller). + -- In case we have an Interrupt Entry already installed, raise a + -- program error, (propagate it to the caller). raise Program_Error with - "An interrupt is already installed"; + "an interrupt is already installed"; end if; - -- Note : A null handler with Static = True will pass the - -- following check. That is the case when we want to Detach a - -- handler regardless of the Static status of the current_Handler. + -- Note : A null handler with Static = True will pass the following + -- check. That is the case when we want to Detach a handler + -- regardless of the Static status of the current_Handler. - -- We don't check anything if Restoration is True, since we - -- may be detaching a static handler to restore a dynamic one. + -- We don't check anything if Restoration is True, since we may be + -- detaching a static handler to restore a dynamic one. if not Restoration and then not Static - -- Tries to overwrite a static Interrupt Handler with a - -- dynamic Handler + -- Tries to overwrite a static Interrupt Handler with a dynamic + -- Handler and then (User_Handler (Interrupt).Static - -- The new handler is not specified as an - -- Interrupt Handler by a pragma. + -- The new handler is not specified as an + -- Interrupt Handler by a pragma. - or else not Is_Registered (New_Handler)) + or else not Is_Registered (New_Handler)) then raise Program_Error with - "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"; + "trying to overwrite a static Interrupt Handler with a " & + "dynamic handler"; end if; -- The interrupt should no longer be ignored if @@ -945,12 +945,12 @@ package body System.Interrupts is System.Tasking.Utilities.Make_Independent; - -- Environment task gets its own interrupt mask, saves it, - -- and then masks all interrupts except the Keep_Unmasked set. + -- Environment task gets its own interrupt mask, saves it, and then + -- masks all interrupts except the Keep_Unmasked set. - -- During rendezvous, the Interrupt_Manager receives the old - -- interrupt mask of the environment task, and sets its own - -- interrupt mask to that value. + -- During rendezvous, the Interrupt_Manager receives the old interrupt + -- mask of the environment task, and sets its own interrupt mask to that + -- value. -- The environment task will call the entry of Interrupt_Manager some -- during elaboration of the body of this package. @@ -958,25 +958,24 @@ package body System.Interrupts is accept Initialize (Mask : IMNG.Interrupt_Mask) do declare The_Mask : aliased IMNG.Interrupt_Mask; - begin IMOP.Copy_Interrupt_Mask (The_Mask, Mask); IMOP.Set_Interrupt_Mask (The_Mask'Access); end; end Initialize; - -- Note: All tasks in RTS will have all the Reserve Interrupts - -- being masked (except the Interrupt_Manager) and Keep_Unmasked - -- unmasked when created. + -- Note: All tasks in RTS will have all the Reserve Interrupts being + -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked + -- when created. - -- Abort_Task_Interrupt is one of the Interrupt unmasked - -- in all tasks. We mask the Interrupt in this particular task - -- so that "sigwait" is possible to catch an explicitly sent - -- Abort_Task_Interrupt from the Server_Tasks. + -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks. + -- We mask the Interrupt in this particular task so that "sigwait" is + -- possible to catch an explicitly sent Abort_Task_Interrupt from the + -- Server_Tasks. - -- This sigwaiting is needed so that we make sure a Server_Task is - -- out of its own sigwait state. This extra synchronization is - -- necessary to prevent following scenarios. + -- This sigwaiting is needed so that we make sure a Server_Task is out + -- of its own sigwait state. This extra synchronization is necessary to + -- prevent following scenarios. -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the -- Server_Task then changes its own interrupt mask (OS level). @@ -1037,14 +1036,14 @@ package body System.Interrupts is E : Task_Entry_Index; Interrupt : Interrupt_ID) do - -- if there is a binding already (either a procedure or an + -- If there is a binding already (either a procedure or an -- entry), raise Program_Error (propagate it to the caller). if User_Handler (Interrupt).H /= null or else User_Entry (Interrupt).T /= Null_Task then raise Program_Error with - "A binding for this interrupt is already present"; + "a binding for this interrupt is already present"; end if; -- The interrupt should no longer be ignored if @@ -1118,10 +1117,10 @@ package body System.Interrupts is if User_Handler (Interrupt).H /= null or else User_Entry (Interrupt).T /= Null_Task then - -- This is the case where the Server_Task is waiting - -- on "sigwait." Wake it up by sending an - -- Abort_Task_Interrupt so that the Server_Task - -- waits on Cond. + -- This is the case where the Server_Task is + -- waiting on "sigwait." Wake it up by sending an + -- Abort_Task_Interrupt so that the Server_Task waits + -- on Cond. POP.Abort_Task (Server_ID (Interrupt)); @@ -1158,8 +1157,8 @@ package body System.Interrupts is else -- The Server_Task must be waiting on the Cond variable -- since it was being blocked and an Interrupt Hander or - -- an Entry was there. Wake it up and let it change - -- it place of waiting according to its new state. + -- an Entry was there. Wake it up and let it change it + -- place of waiting according to its new state. POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Blocked_Interrupt_Sleep); @@ -1242,8 +1241,8 @@ package body System.Interrupts is Tmp_Entry_Index : Task_Entry_Index; begin - -- By making this task independent of master, when the process - -- goes away, the Server_Task will terminate gracefully. + -- By making this task independent of master, when the process goes + -- away, the Server_Task will terminate gracefully. System.Tasking.Utilities.Make_Independent; @@ -1262,8 +1261,8 @@ package body System.Interrupts is -- There are two Interrupt interrupts that this task catch through -- "sigwait." One is the Interrupt this task is designated to catch - -- in order to execute user handler or entry. The other one is the - -- Abort_Task_Interrupt. This interrupt is being sent from the + -- in order to execute user handler or entry. The other one is + -- the Abort_Task_Interrupt. This interrupt is being sent from the -- Interrupt_Manager to inform status changes (e.g: become Blocked, -- Handler or Entry is to be detached). @@ -1303,8 +1302,7 @@ package body System.Interrupts is elsif Blocked (Interrupt) then - -- Interrupt is blocked. Stay here, so we won't catch - -- the Interrupt. + -- Interrupt is blocked. Stay here, so we won't catch it Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep; POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep); diff --git a/gcc/ada/s-shasto.adb b/gcc/ada/s-shasto.adb index 783fdc4..6e0749c 100644 --- a/gcc/ada/s-shasto.adb +++ b/gcc/ada/s-shasto.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, 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- -- @@ -541,7 +541,7 @@ package body System.Shared_Storage is when others => raise Program_Error with - "Cannot create shared variable file for """ & S & '"'; + "cannot create shared variable file for """ & S & '"'; end; end; diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 244f9e3..34cf94c 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -367,7 +367,8 @@ package body System.Tasking.Rendezvous is if System.Tasking.Detect_Blocking and then STPO.Self.Common.Protected_Action_Nesting > 0 then - raise Program_Error with "potentially blocking operation"; + raise Program_Error with + "potentially blocking operation"; end if; Call_Synchronous @@ -1012,7 +1013,8 @@ package body System.Tasking.Rendezvous is end if; Initialization.Undefer_Abort (Self_Id); - raise Program_Error with "Entry call not a delay mode"; + raise Program_Error with + "entry call not a delay mode"; end if; end case; @@ -1316,7 +1318,8 @@ package body System.Tasking.Rendezvous is if System.Tasking.Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - raise Program_Error with "potentially blocking operation"; + raise Program_Error with + "potentially blocking operation"; end if; if Parameters.Runtime_Traces then @@ -1688,7 +1691,8 @@ package body System.Tasking.Rendezvous is if System.Tasking.Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - raise Program_Error with "potentially blocking operation"; + raise Program_Error with + "potentially blocking operation"; end if; Initialization.Defer_Abort (Self_Id); diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index 3249122..9131f8c 100644 --- a/gcc/ada/s-tpoben.adb +++ b/gcc/ada/s-tpoben.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -103,7 +103,7 @@ package body System.Tasking.Protected_Objects.Entries is STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation); if Ceiling_Violation then - raise Program_Error with "Ceiling Violation"; + raise Program_Error with "ceiling violation"; end if; if Single_Lock then @@ -231,7 +231,7 @@ package body System.Tasking.Protected_Objects.Entries is Lock_Entries_With_Status (Object, Ceiling_Violation); if Ceiling_Violation then - raise Program_Error with "Ceiling Violation"; + raise Program_Error with "ceiling violation"; end if; end Lock_Entries; @@ -245,7 +245,7 @@ package body System.Tasking.Protected_Objects.Entries is is begin if Object.Finalized then - raise Program_Error with "Protected Object is finalized"; + raise Program_Error with "protected object is finalized"; end if; -- If pragma Detect_Blocking is active then, as described in the ARM @@ -305,7 +305,7 @@ package body System.Tasking.Protected_Objects.Entries is begin if Object.Finalized then - raise Program_Error with "Protected Object is finalized"; + raise Program_Error with "protected object is finalized"; end if; -- If pragma Detect_Blocking is active then, as described in the ARM @@ -330,7 +330,7 @@ package body System.Tasking.Protected_Objects.Entries is Read_Lock (Object.L'Access, Ceiling_Violation); if Ceiling_Violation then - raise Program_Error with "Ceiling Violation"; + raise Program_Error with "ceiling violation"; end if; -- We are entering in a protected action, so that we increase the |