X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fs-taasde.adb;h=315d9ba13558f06d4d1df49f229e0285a2afdcbd;hb=c22477bd9b1ceafa4f51598158e0e89e29910b69;hp=2439c464357c946e0e7dd366ab9e0b319b7fedd6;hpb=3670c51dfe5b75666de76454dd55944799dc90b5;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb index 2439c464357..315d9ba1355 100644 --- a/gcc/ada/s-taasde.adb +++ b/gcc/ada/s-taasde.adb @@ -1,33 +1,31 @@ ------------------------------------------------------------------------------ -- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- -- S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S -- -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2009, 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- ware Foundation; either version 3, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- +-- 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. -- -- -- --- GNARL was developed by the GNARL team at Florida State University. It is -- --- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). -- +-- 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 -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- -- -- ------------------------------------------------------------------------------ @@ -35,43 +33,17 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during -- tasking operations. It causes infinite loops and other problems. -with Ada.Exceptions; --- Used for Raise_Exception +with Ada.Unchecked_Conversion; +with Ada.Task_Identification; with System.Task_Primitives.Operations; --- Used for Write_Lock, --- Unlock, --- Self, --- Monotonic_Clock, --- Self, --- Timed_Sleep, --- Wakeup, --- Yield - with System.Tasking.Utilities; --- Used for Make_Independent - with System.Tasking.Initialization; --- Used for Defer_Abort --- Undefer_Abort - with System.Tasking.Debug; --- Used for Trace - with System.OS_Primitives; --- used for Max_Sensible_Delay - -with Ada.Task_Identification; --- used for Task_ID type - +with System.Interrupt_Management.Operations; with System.Parameters; --- used for Single_Lock --- Runtime_Traces - with System.Traces.Tasking; --- used for Send_Trace_Info - -with Unchecked_Conversion; package body System.Tasking.Async_Delays is @@ -85,10 +57,10 @@ package body System.Tasking.Async_Delays is use System.Traces; use System.Traces.Tasking; - function To_System is new Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_ID); + function To_System is new Ada.Unchecked_Conversion + (Ada.Task_Identification.Task_Id, Task_Id); - Timer_Server_ID : ST.Task_ID; + Timer_Server_ID : ST.Task_Id; Timer_Attention : Boolean := False; pragma Atomic (Timer_Attention); @@ -171,9 +143,8 @@ package body System.Tasking.Async_Delays is --------------------------- function Enqueue_Duration - (T : in Duration; - D : Delay_Block_Access) - return Boolean + (T : Duration; + D : Delay_Block_Access) return Boolean is begin if T <= 0.0 then @@ -214,10 +185,10 @@ package body System.Tasking.Async_Delays is (T : Duration; D : Delay_Block_Access) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Q : Delay_Block_Access; - use type ST.Task_ID; + use type ST.Task_Id; -- for visibility of operator "=" begin @@ -226,8 +197,7 @@ package body System.Tasking.Async_Delays is "async delay from within abort-deferred region"); if Self_Id.ATC_Nesting_Level = ATC_Level'Last then - Ada.Exceptions.Raise_Exception (Storage_Error'Identity, - "not enough ATC nesting levels"); + raise Storage_Error with "not enough ATC nesting levels"; end if; Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1; @@ -302,7 +272,7 @@ package body System.Tasking.Async_Delays is task body Timer_Server is function Get_Next_Wakeup_Time return Duration; -- Used to initialize Next_Wakeup_Time, but also to ensure that - -- Make_Independent is called during the elaboration of this task + -- Make_Independent is called during the elaboration of this task. -------------------------- -- Get_Next_Wakeup_Time -- @@ -314,18 +284,26 @@ package body System.Tasking.Async_Delays is return Duration'Last; end Get_Next_Wakeup_Time; + -- Local Declarations + Next_Wakeup_Time : Duration := Get_Next_Wakeup_Time; Timedout : Boolean; Yielded : Boolean; Now : Duration; - Dequeued, - Tpred, - Tsucc : Delay_Block_Access; - Dequeued_Task : Task_ID; + Dequeued : Delay_Block_Access; + Dequeued_Task : Task_Id; + + pragma Unreferenced (Timedout, Yielded); begin Timer_Server_ID := STPO.Self; + -- Since this package may be elaborated before System.Interrupt, + -- we need to call Setup_Interrupt_Mask explicitly to ensure that + -- this task has the proper signal mask. + + Interrupt_Management.Operations.Setup_Interrupt_Mask; + -- Initialize the timer queue to empty, and make the wakeup time of the -- header node be larger than any real wakeup time we will ever use. @@ -370,13 +348,12 @@ package body System.Tasking.Async_Delays is Timer_Attention := False; Now := STPO.Monotonic_Clock; - while Timer_Queue.Succ.Resume_Time <= Now loop - -- Dequeue the waiting task from the front of the queue. + -- Dequeue the waiting task from the front of the queue pragma Debug (System.Tasking.Debug.Trace - ("Timer service: waking up waiting task", 'E')); + (Timer_Server_ID, "Timer service: waking up waiting task", 'E')); Dequeued := Timer_Queue.Succ; Timer_Queue.Succ := Dequeued.Succ; @@ -428,8 +405,8 @@ package body System.Tasking.Async_Delays is ------------------------------ begin - Timer_Queue.Succ := Timer_Queue'Unchecked_Access; - Timer_Queue.Pred := Timer_Queue'Unchecked_Access; + Timer_Queue.Succ := Timer_Queue'Access; + Timer_Queue.Pred := Timer_Queue'Access; Timer_Queue.Resume_Time := Duration'Last; Timer_Server_ID := To_System (Timer_Server'Identity); end System.Tasking.Async_Delays;