File : posix-timers.adb
------------------------------------------------------------------------------
-- --
-- FLORIST (FSU Implementation of POSIX.5) COMPONENTS --
-- --
-- P O S I X . T I M E R S --
-- --
-- B o d y --
-- --
-- --
-- Copyright (c) 1996, 1997 Florida State University (FSU), --
-- All Rights Reserved. --
-- --
-- This file is a component of FLORIST, an implementation of an Ada API --
-- for the POSIX OS services, for use with the GNAT Ada compiler and --
-- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended --
-- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD --
-- 1003.5b: 1996. --
-- --
-- FLORIST is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. FLORIST is distributed in the hope that it will be --
-- useful, but WITHOUT 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- [$Revision: 1.1.1.1 $]
with POSIX.C,
POSIX.Implementation,
POSIX.Signals,
Unchecked_Conversion;
package body POSIX.Timers is
use POSIX.C;
use POSIX.Implementation;
function To_int is new Unchecked_Conversion (Bits, int);
function To_Bits is new Unchecked_Conversion (int, Bits);
Zero_Timespec : aliased constant struct_timespec := (0, 0);
Zero_State : aliased constant struct_itimerspec := ((0, 0), (0, 0));
-------------------
-- Set_Initial --
-------------------
procedure Set_Initial
(State : in out Timer_State;
Initial : in POSIX.Timespec) is
begin
State.State.it_value := To_Struct_Timespec (Initial);
end Set_Initial;
-------------------
-- Get_Initial --
-------------------
function Get_Initial (State : Timer_State) return POSIX.Timespec is
begin
return To_Timespec (To_Duration (State.State.it_value));
end Get_Initial;
--------------------
-- Set_Interval --
--------------------
procedure Set_Interval
(State : in out Timer_State;
Interval : in POSIX.Timespec) is
begin
State.State.it_interval := To_Struct_Timespec (Interval);
end Set_Interval;
--------------------
-- Get_Interval --
--------------------
function Get_Interval (State : Timer_State) return POSIX.Timespec is
begin
return To_Timespec (To_Duration (State.State.it_interval));
end Get_Interval;
-----------------
-- Set_Time --
-----------------
function clock_settime
(clock_id : clockid_t;
tp : timespec_ptr) return int;
pragma Import (C, clock_settime, clock_settime_LINKNAME);
procedure Set_Time
(Clock : in Clock_ID;
Value : in POSIX.Timespec) is
TS : aliased struct_timespec;
begin
TS := To_Struct_Timespec (Value);
Check (clock_settime (clockid_t (Clock), TS'Unchecked_Access));
end Set_Time;
----------------
-- Set_Time --
----------------
procedure Set_Time
(Value : in POSIX.Timespec) is
TS : aliased struct_timespec;
begin
TS := To_Struct_Timespec (Value);
Check (clock_settime (POSIX.C.CLOCK_REALTIME, TS'Unchecked_Access));
end Set_Time;
----------------
-- Get_Time --
----------------
function clock_gettime
(clock_id : clockid_t;
tp : access struct_timespec) return int;
pragma Import (C, clock_gettime, clock_gettime_LINKNAME);
function Get_Time
(Clock : Clock_ID := Clock_Realtime) return POSIX.Timespec is
TS : aliased struct_timespec;
begin
Check (clock_gettime (clockid_t (Clock), TS'Unchecked_Access));
return To_Timespec (To_Duration (TS));
end Get_Time;
----------------------
-- Get_Resolution --
----------------------
function Get_Resolution
(Clock : Clock_ID := Clock_Realtime) return POSIX.Timespec is
function clock_getres
(clock_id : clockid_t;
res : access struct_timespec) return int;
pragma Import (C, clock_getres, clock_getres_LINKNAME);
TS : aliased struct_timespec;
begin
Check (clock_getres (clockid_t (Clock), TS'Unchecked_Access));
return To_Timespec (To_Duration (TS));
end Get_Resolution;
--------------------
-- Create_Timer --
--------------------
function Create_Timer
(Clock : Clock_ID;
Event : POSIX.Signals.Signal_Event) return Timer_ID is
function timer_create
(clock_id : clockid_t;
evp : access POSIX.Signals.Signal_Event;
timerid : access timer_t) return int;
pragma Import (C, timer_create, timer_create_LINKNAME);
-- .... Consider making Signal_Event into a tagged type
-- so that we don't need to make a local copy.
E : aliased POSIX.Signals.Signal_Event := Event;
TID : aliased timer_t;
begin
Check (timer_create (clockid_t (Clock),
E'Unchecked_Access, TID'Unchecked_Access));
return Timer_ID (TID);
end Create_Timer;
--------------------
-- Delete_Timer --
--------------------
procedure Delete_Timer (Timer : in out Timer_ID) is
function timer_delete (timer_id : timer_t) return int;
pragma Import (C, timer_delete, timer_delete_LINKNAME);
begin
Check (timer_delete (timer_t (Timer)));
end Delete_Timer;
-----------------
-- Arm_Timer --
-----------------
function timer_settime
(timer_id : timer_t;
flags : C.int;
value : itimerspec_ptr;
ovalue : itimerspec_ptr) return int;
pragma Import (C, timer_settime, timer_settime_LINKNAME);
procedure Arm_Timer
(Timer : in Timer_ID;
Options : in Timer_Options;
New_State : in Timer_State;
Old_State : out Timer_State) is
begin
-- ????? Change POSIX.5b?
-- The following two checks are required by .5b, but
-- they are inconsistent with one another
-- and they do not seem to be founded on the .1b specification.
if Options = Absolute_Timer then
Check (New_State.State.it_value /= Zero_Timespec, Invalid_Argument);
else
Check (New_State.State.it_value.tv_sec > 0, Invalid_Argument);
end if;
Check (timer_settime (timer_t (Timer),
To_int (Option_Set (Options).Option),
New_State.State'Unchecked_Access,
Old_State.State'Unchecked_Access));
end Arm_Timer;
-----------------
-- Arm_Timer --
-----------------
procedure Arm_Timer
(Timer : in Timer_ID;
Options : in Timer_Options;
New_State : in Timer_State) is
begin
Check (New_State.State.it_value /= Zero_Timespec, Invalid_Argument);
Check (timer_settime (timer_t (Timer),
To_int (Option_Set (Options).Option),
New_State.State'Unchecked_Access, null));
end Arm_Timer;
-----------------------
-- Get_Timer_State --
-----------------------
function Get_Timer_State (Timer : Timer_ID) return Timer_State is
function timer_gettime
(timer_id : timer_t;
value : access struct_itimerspec) return int;
pragma Import (C, timer_gettime, timer_gettime_LINKNAME);
TS : Timer_State;
begin
Check (timer_gettime (timer_t (Timer), TS.State'Unchecked_Access));
return TS;
end Get_Timer_State;
--------------------
-- Disarm_Timer --
--------------------
procedure Disarm_Timer (Timer : in Timer_ID) is
begin
Check (timer_settime
(timer_t (Timer), 0, Zero_State'Unchecked_Access, null));
end Disarm_Timer;
--------------------------
-- Get_Timer_Overruns --
--------------------------
function Get_Timer_Overruns (Timer : Timer_ID) return Natural is
function timer_getoverrun (timer_id : timer_t) return int;
pragma Import (C, timer_getoverrun, timer_getoverrun_LINKNAME);
begin
return Natural (Check (timer_getoverrun (timer_t (Timer))));
end Get_Timer_Overruns;
end POSIX.Timers;