home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Geek Gadgets 1
/
ADE-1.bin
/
ade-dist
/
gnat-2.06-src.tgz
/
tar.out
/
fsf
/
gnat
/
ada
/
a-caldel.adb
< prev
next >
Wrap
Text File
|
1996-09-28
|
5KB
|
130 lines
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . C A L E N D A R . D E L A Y S --
-- --
-- B o d y --
-- --
-- $Revision: 1.17 $ --
-- --
-- Copyright (c) 1991,1992,1993,1994,1995 FSU, All Rights Reserved --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU Library General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. GNARL is distributed in the hope that it will be use- --
-- ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Gen- --
-- eral Library Public License for more details. You should have received --
-- a copy of the GNU Library General Public License along with GNARL; see --
-- file COPYING.LIB. If not, write to the Free Software Foundation, 675 --
-- Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
with System;
-- Used for, Priority
with System.Task_Timer;
-- Used for, Timer
with System.Task_Primitives;
-- Used for, Cond_Timed_Wait
-- Lock
-- Condition_Variable
-- Initialize_Lock
-- Initialize_Cond
-- Write_Lock
-- Unlock
with System.Task_Clock;
-- Used for, Stimespec
with System.Task_Clock.Machine_Specifics;
-- Used for, Stimespec_Ticks;
with Ada.Calendar.Conv;
-- Used for, Time_To_Stimespec
package body Ada.Calendar.Delays is
function "+" (L, R : System.Task_Clock.Stimespec) return
System.Task_Clock.Stimespec renames System.Task_Clock."+";
------------------
-- Delay_Object --
------------------
protected body Delay_Object is
entry Wait (T : Duration; D : access System.Task_Timer.Delay_Block)
when True is
begin
requeue System.Task_Timer.Timer.Enqueue_Duration with abort;
end Wait;
end Delay_Object;
------------------------
-- Delay_Until_Object --
------------------------
protected body Delay_Until_Object is
entry Wait (T : Time; D : access System.Task_Timer.Delay_Block)
when True is
begin
requeue System.Task_Timer.Timer.Enqueue_Calendar_Time with abort;
end Wait;
end Delay_Until_Object;
---------------
-- Delay_For --
---------------
procedure Delay_For (D : Duration) is
L : System.Task_Primitives.Lock;
C : System.Task_Primitives.Condition_Variable;
Error, Result : Boolean;
begin
Task_Primitives.Initialize_Lock (System.Priority'Last, L);
Task_Primitives.Initialize_Cond (C);
Task_Primitives.Write_Lock (L, Error);
Task_Primitives.Cond_Timed_Wait
(C,
L,
Calendar.Conv.Time_To_Stimespec (Clock + D) +
System.Task_Clock.Machine_Specifics.Stimespec_Ticks,
Result);
Task_Primitives.Unlock (L);
Task_Primitives.Finalize_Cond (C);
Task_Primitives.Finalize_Lock (L);
end Delay_For;
-----------------
-- Delay_Until --
-----------------
procedure Delay_Until (T : Time) is
L : System.Task_Primitives.Lock;
C : System.Task_Primitives.Condition_Variable;
Error, Result : Boolean;
begin
Task_Primitives.Initialize_Lock (System.Priority'Last, L);
Task_Primitives.Initialize_Cond (C);
Task_Primitives.Write_Lock (L, Error);
Task_Primitives.Cond_Timed_Wait
(C,
L,
Calendar.Conv.Time_To_Stimespec (T) +
System.Task_Clock.Machine_Specifics.Stimespec_Ticks,
Result);
Task_Primitives.Unlock (L);
Task_Primitives.Finalize_Cond (C);
Task_Primitives.Finalize_Lock (L);
end Delay_Until;
end Ada.Calendar.Delays;