gcc/ada/s-inmaop-vxworks.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
   4 --                                                                          --
   5 --                   SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                 --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --             Copyright (C) 1991-1994, Florida State University            --
  10 --                     Copyright (C) 1995-2011, AdaCore                     --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  18 --                                                                          --
  19 -- As a special exception under Section 7 of GPL version 3, you are granted --
  20 -- additional permissions described in the GCC Runtime Library Exception,   --
  21 -- version 3.1, as published by the Free Software Foundation.               --
  22 --                                                                          --
  23 -- You should have received a copy of the GNU General Public License and    --
  24 -- a copy of the GCC Runtime Library Exception along with this program;     --
  25 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  26 -- <http://www.gnu.org/licenses/>.                                          --
  27 --                                                                          --
  28 -- GNARL was developed by the GNARL team at Florida State University.       --
  29 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  30 --                                                                          --
  31 ------------------------------------------------------------------------------
  32
  33 --  This is a VxWorks version of this package. Many operations are null as this
  34 --  package supports the use of Ada interrupt handling facilities for signals,
  35 --  while those facilities are used for hardware interrupts on these targets.
  36
  37 with Ada.Exceptions;
  38
  39 with Interfaces.C;
  40
  41 with System.OS_Interface;
  42
  43 package body System.Interrupt_Management.Operations is
  44
  45    use Ada.Exceptions;
  46    use Interfaces.C;
  47    use System.OS_Interface;
  48
  49    ----------------------------
  50    -- Thread_Block_Interrupt --
  51    ----------------------------
  52
  53    procedure Thread_Block_Interrupt
  54      (Interrupt : Interrupt_ID)
  55    is
  56       pragma Unreferenced (Interrupt);
  57    begin
  58       Raise_Exception
  59         (Program_Error'Identity,
  60          "Thread_Block_Interrupt unimplemented");
  61    end Thread_Block_Interrupt;
  62
  63    ------------------------------
  64    -- Thread_Unblock_Interrupt --
  65    ------------------------------
  66
  67    procedure Thread_Unblock_Interrupt
  68      (Interrupt : Interrupt_ID)
  69    is
  70       pragma Unreferenced (Interrupt);
  71    begin
  72       Raise_Exception
  73         (Program_Error'Identity,
  74          "Thread_Unblock_Interrupt unimplemented");
  75    end Thread_Unblock_Interrupt;
  76
  77    ------------------------
  78    -- Set_Interrupt_Mask --
  79    ------------------------
  80
  81    procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
  82       pragma Unreferenced (Mask);
  83    begin
  84       null;
  85    end Set_Interrupt_Mask;
  86
  87    procedure Set_Interrupt_Mask
  88      (Mask  : access Interrupt_Mask;
  89       OMask : access Interrupt_Mask)
  90    is
  91       pragma Unreferenced (Mask, OMask);
  92    begin
  93       Raise_Exception
  94         (Program_Error'Identity,
  95          "Set_Interrupt_Mask unimplemented");
  96    end Set_Interrupt_Mask;
  97
  98    ------------------------
  99    -- Get_Interrupt_Mask --
 100    ------------------------
 101
 102    procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
 103       pragma Unreferenced (Mask);
 104    begin
 105       Raise_Exception
 106         (Program_Error'Identity,
 107          "Get_Interrupt_Mask unimplemented");
 108    end Get_Interrupt_Mask;
 109
 110    --------------------
 111    -- Interrupt_Wait --
 112    --------------------
 113
 114    function Interrupt_Wait
 115      (Mask : access Interrupt_Mask) return Interrupt_ID
 116    is
 117       pragma Unreferenced (Mask);
 118    begin
 119       Raise_Exception
 120         (Program_Error'Identity,
 121          "Interrupt_Wait unimplemented");
 122       return 0;
 123    end Interrupt_Wait;
 124
 125    ----------------------------
 126    -- Install_Default_Action --
 127    ----------------------------
 128
 129    procedure Install_Default_Action (Interrupt : Interrupt_ID) is
 130       pragma Unreferenced (Interrupt);
 131    begin
 132       Raise_Exception
 133         (Program_Error'Identity,
 134          "Install_Default_Action unimplemented");
 135    end Install_Default_Action;
 136
 137    ---------------------------
 138    -- Install_Ignore_Action --
 139    ---------------------------
 140
 141    procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
 142       pragma Unreferenced (Interrupt);
 143    begin
 144       Raise_Exception
 145         (Program_Error'Identity,
 146          "Install_Ignore_Action unimplemented");
 147    end Install_Ignore_Action;
 148
 149    -------------------------
 150    -- Fill_Interrupt_Mask --
 151    -------------------------
 152
 153    procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
 154       pragma Unreferenced (Mask);
 155    begin
 156       Raise_Exception
 157         (Program_Error'Identity,
 158          "Fill_Interrupt_Mask unimplemented");
 159    end Fill_Interrupt_Mask;
 160
 161    --------------------------
 162    -- Empty_Interrupt_Mask --
 163    --------------------------
 164
 165    procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
 166       pragma Unreferenced (Mask);
 167    begin
 168       Raise_Exception
 169         (Program_Error'Identity,
 170          "Empty_Interrupt_Mask unimplemented");
 171    end Empty_Interrupt_Mask;
 172
 173    ---------------------------
 174    -- Add_To_Interrupt_Mask --
 175    ---------------------------
 176
 177    procedure Add_To_Interrupt_Mask
 178      (Mask      : access Interrupt_Mask;
 179       Interrupt : Interrupt_ID)
 180    is
 181       pragma Unreferenced (Mask, Interrupt);
 182    begin
 183       Raise_Exception
 184         (Program_Error'Identity,
 185          "Add_To_Interrupt_Mask unimplemented");
 186    end Add_To_Interrupt_Mask;
 187
 188    --------------------------------
 189    -- Delete_From_Interrupt_Mask --
 190    --------------------------------
 191
 192    procedure Delete_From_Interrupt_Mask
 193      (Mask      : access Interrupt_Mask;
 194       Interrupt : Interrupt_ID)
 195    is
 196       pragma Unreferenced (Mask, Interrupt);
 197    begin
 198       Raise_Exception
 199         (Program_Error'Identity,
 200          "Delete_From_Interrupt_Mask unimplemented");
 201    end Delete_From_Interrupt_Mask;
 202
 203    ---------------
 204    -- Is_Member --
 205    ---------------
 206
 207    function Is_Member
 208      (Mask      : access Interrupt_Mask;
 209       Interrupt : Interrupt_ID) return Boolean
 210    is
 211       pragma Unreferenced (Mask, Interrupt);
 212    begin
 213       Raise_Exception
 214         (Program_Error'Identity,
 215          "Is_Member unimplemented");
 216       return False;
 217    end Is_Member;
 218
 219    -------------------------
 220    -- Copy_Interrupt_Mask --
 221    -------------------------
 222
 223    procedure Copy_Interrupt_Mask
 224      (X : out Interrupt_Mask;
 225       Y : Interrupt_Mask) is
 226       pragma Unreferenced (X, Y);
 227    begin
 228       Raise_Exception
 229         (Program_Error'Identity,
 230          "Copy_Interrupt_Mask unimplemented");
 231    end Copy_Interrupt_Mask;
 232
 233    ----------------------------
 234    -- Interrupt_Self_Process --
 235    ----------------------------
 236
 237    procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
 238       Result : Interfaces.C.int;
 239    begin
 240       Result := kill (getpid, Signal (Interrupt));
 241       pragma Assert (Result = 0);
 242    end Interrupt_Self_Process;
 243
 244    --------------------------
 245    -- Setup_Interrupt_Mask --
 246    --------------------------
 247
 248    procedure Setup_Interrupt_Mask is
 249    begin
 250       --  Nothing to be done. Ada interrupt facilities on VxWorks do not use
 251       --  signals but hardware interrupts. Therefore, interrupt management does
 252       --  not need anything related to signal masking. Note that this procedure
 253       --  cannot raise an exception (as some others in this package) because
 254       --  the generic implementation of the Timer_Server and timing events make
 255       --  explicit calls to this routine to make ensure proper signal masking
 256       --  on targets needed that.
 257
 258       null;
 259    end Setup_Interrupt_Mask;
 260
 261 end System.Interrupt_Management.Operations;