include/adainclude/rtems-timer.adb

0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 --  RTEMS / Body
0005 --
0006 --  DESCRIPTION:
0007 --
0008 --  This package provides the interface to the RTEMS API.
0009 --
0010 --
0011 --  DEPENDENCIES:
0012 --
0013 --
0014 --
0015 --  COPYRIGHT (c) 1997-2008.
0016 --  On-Line Applications Research Corporation (OAR).
0017 --
0018 --  Redistribution and use in source and binary forms, with or without
0019 --  modification, are permitted provided that the following conditions
0020 --  are met:
0021 --  1. Redistributions of source code must retain the above copyright
0022 --     notice, this list of conditions and the following disclaimer.
0023 --  2. Redistributions in binary form must reproduce the above copyright
0024 --     notice, this list of conditions and the following disclaimer in the
0025 --     documentation and/or other materials provided with the distribution.
0026 --
0027 --  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
0028 --  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
0029 --  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
0030 --  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
0031 --  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0032 --  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
0033 --  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
0034 --  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
0035 --  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
0036 --  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
0037 --  POSSIBILITY OF SUCH DAMAGE.
0038 --
0039
0040 package body RTEMS.Timer is
0041
0042    --
0043    -- Timer Manager
0044    --
0045
0046    procedure Create
0047      (Name   : in RTEMS.Name;
0048       ID     : out RTEMS.ID;
0049       Result : out RTEMS.Status_Codes)
0050    is
0051       function Create_Base
0052         (Name : RTEMS.Name;
0053          ID   : access RTEMS.ID)
0054          return RTEMS.Status_Codes;
0055       pragma Import (C, Create_Base, "rtems_timer_create");
0056       ID_Base : aliased RTEMS.ID;
0057    begin
0058
0059       Result := Create_Base (Name, ID_Base'Access);
0060       ID     := ID_Base;
0061
0062    end Create;
0063
0064    procedure Ident
0065      (Name   : in RTEMS.Name;
0066       ID     : out RTEMS.ID;
0067       Result : out RTEMS.Status_Codes)
0068    is
0069       function Ident_Base
0070         (Name : RTEMS.Name;
0071          ID   : access RTEMS.ID)
0072          return RTEMS.Status_Codes;
0073       pragma Import (C, Ident_Base, "rtems_timer_ident");
0074       ID_Base : aliased RTEMS.ID;
0075    begin
0076
0077       Result := Ident_Base (Name, ID_Base'Access);
0078       ID     := ID_Base;
0079
0080    end Ident;
0081
0082    procedure Delete
0083      (ID     : in RTEMS.ID;
0084       Result : out RTEMS.Status_Codes)
0085    is
0086       function Delete_Base (ID : RTEMS.ID) return RTEMS.Status_Codes;
0087       pragma Import (C, Delete_Base, "rtems_timer_delete");
0088    begin
0089
0090       Result := Delete_Base (ID);
0091
0092    end Delete;
0093
0094    procedure Fire_After
0095      (ID        : in RTEMS.ID;
0096       Ticks     : in RTEMS.Interval;
0097       Routine   : in RTEMS.Timer.Service_Routine;
0098       User_Data : in RTEMS.Address;
0099       Result    : out RTEMS.Status_Codes)
0100    is
0101       function Fire_After_Base
0102         (ID        : RTEMS.ID;
0103          Ticks     : RTEMS.Interval;
0104          Routine   : RTEMS.Timer.Service_Routine;
0105          User_Data : RTEMS.Address)
0106          return      RTEMS.Status_Codes;
0107       pragma Import (C, Fire_After_Base, "rtems_timer_fire_after");
0108    begin
0109
0110       Result := Fire_After_Base (ID, Ticks, Routine, User_Data);
0111
0112    end Fire_After;
0113
0114    procedure Server_Fire_After
0115      (ID        : in RTEMS.ID;
0116       Ticks     : in RTEMS.Interval;
0117       Routine   : in RTEMS.Timer.Service_Routine;
0118       User_Data : in RTEMS.Address;
0119       Result    : out RTEMS.Status_Codes)
0120    is
0121       function Server_Fire_After_Base
0122         (ID        : RTEMS.ID;
0123          Ticks     : RTEMS.Interval;
0124          Routine   : RTEMS.Timer.Service_Routine;
0125          User_Data : RTEMS.Address)
0126          return      RTEMS.Status_Codes;
0127       pragma Import
0128         (C,
0129          Server_Fire_After_Base,
0130          "rtems_timer_server_fire_after");
0131    begin
0132
0133       Result := Server_Fire_After_Base (ID, Ticks, Routine, User_Data);
0134
0135    end Server_Fire_After;
0136
0137    procedure Fire_When
0138      (ID        : in RTEMS.ID;
0139       Wall_Time : in RTEMS.Time_Of_Day;
0140       Routine   : in RTEMS.Timer.Service_Routine;
0141       User_Data : in RTEMS.Address;
0142       Result    : out RTEMS.Status_Codes)
0143    is
0144       function Fire_When_Base
0145         (ID        : RTEMS.ID;
0146          Wall_Time : RTEMS.Time_Of_Day;
0147          Routine   : RTEMS.Timer.Service_Routine;
0148          User_Data : RTEMS.Address)
0149          return      RTEMS.Status_Codes;
0150       pragma Import (C, Fire_When_Base, "rtems_timer_fire_when");
0151    begin
0152
0153       Result := Fire_When_Base (ID, Wall_Time, Routine, User_Data);
0154
0155    end Fire_When;
0156
0157    procedure Server_Fire_When
0158      (ID        : in RTEMS.ID;
0159       Wall_Time : in RTEMS.Time_Of_Day;
0160       Routine   : in RTEMS.Timer.Service_Routine;
0161       User_Data : in RTEMS.Address;
0162       Result    : out RTEMS.Status_Codes)
0163    is
0164       function Server_Fire_When_Base
0165         (ID        : RTEMS.ID;
0166          Wall_Time : RTEMS.Time_Of_Day;
0167          Routine   : RTEMS.Timer.Service_Routine;
0168          User_Data : RTEMS.Address)
0169          return      RTEMS.Status_Codes;
0170       pragma Import
0171         (C,
0172          Server_Fire_When_Base,
0173          "rtems_timer_server_fire_when");
0174    begin
0175
0176       Result :=
0177          Server_Fire_When_Base (ID, Wall_Time, Routine, User_Data);
0178    end Server_Fire_When;
0179
0180    procedure Reset
0181      (ID     : in RTEMS.ID;
0182       Result : out RTEMS.Status_Codes)
0183    is
0184       function Reset_Base (ID : RTEMS.ID) return RTEMS.Status_Codes;
0185       pragma Import (C, Reset_Base, "rtems_timer_reset");
0186    begin
0187
0188       Result := Reset_Base (ID);
0189
0190    end Reset;
0191
0192    procedure Cancel
0193      (ID     : in RTEMS.ID;
0194       Result : out RTEMS.Status_Codes)
0195    is
0196       function Cancel_Base (ID : RTEMS.ID) return RTEMS.Status_Codes;
0197       pragma Import (C, Cancel_Base, "rtems_timer_cancel");
0198    begin
0199
0200       Result := Cancel_Base (ID);
0201
0202    end Cancel;
0203
0204    procedure Initiate_Server
0205      (Server_Priority : in RTEMS.Tasks.Priority;
0206       Stack_Size      : in RTEMS.Size;
0207       Attribute_Set   : in RTEMS.Attribute;
0208       Result          : out RTEMS.Status_Codes)
0209    is
0210       function Initiate_Server_Base
0211         (Server_Priority : RTEMS.Tasks.Priority;
0212          Stack_Size      : RTEMS.Size;
0213          Attribute_Set   : RTEMS.Attribute)
0214          return            RTEMS.Status_Codes;
0215       pragma Import
0216         (C,
0217          Initiate_Server_Base,
0218          "rtems_timer_initiate_server");
0219    begin
0220       Result :=
0221          Initiate_Server_Base
0222            (Server_Priority,
0223             Stack_Size,
0224             Attribute_Set);
0225    end Initiate_Server;
0226
0227 end RTEMS.Timer;