gcc/ada/libgnarl/s-inmaop__hwint.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-2017, Florida State University            --
  10 --                     Copyright (C) 1995-2024, 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 hardware interrupt version of this package. Many operations are
  34 --  null as this package supports the use of Ada interrupt handling facilities
  35 --  for signals, while those facilities are used for hardware interrupts on
  36 --  these targets.
  37
  38 with Ada.Exceptions;
  39
  40 with Interfaces.C;
  41
  42 with System.OS_Interface;
  43
  44 package body System.Interrupt_Management.Operations is
  45
  46    use Ada.Exceptions;
  47    use Interfaces.C;
  48    use System.OS_Interface;
  49
  50    ----------------------------
  51    -- Thread_Block_Interrupt --
  52    ----------------------------
  53
  54    procedure Thread_Block_Interrupt
  55      (Interrupt : Interrupt_ID)
  56    is
  57       pragma Unreferenced (Interrupt);
  58    begin
  59       Raise_Exception
  60         (Program_Error'Identity,
  61          "Thread_Block_Interrupt unimplemented");
  62    end Thread_Block_Interrupt;
  63
  64    ------------------------------
  65    -- Thread_Unblock_Interrupt --
  66    ------------------------------
  67
  68    procedure Thread_Unblock_Interrupt
  69      (Interrupt : Interrupt_ID)
  70    is
  71       pragma Unreferenced (Interrupt);
  72    begin
  73       Raise_Exception
  74         (Program_Error'Identity,
  75          "Thread_Unblock_Interrupt unimplemented");
  76    end Thread_Unblock_Interrupt;
  77
  78    ------------------------
  79    -- Set_Interrupt_Mask --
  80    ------------------------
  81
  82    procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
  83       pragma Unreferenced (Mask);
  84    begin
  85       null;
  86    end Set_Interrupt_Mask;
  87
  88    procedure Set_Interrupt_Mask
  89      (Mask  : access Interrupt_Mask;
  90       OMask : access Interrupt_Mask)
  91    is
  92       pragma Unreferenced (Mask, OMask);
  93    begin
  94       Raise_Exception
  95         (Program_Error'Identity,
  96          "Set_Interrupt_Mask unimplemented");
  97    end Set_Interrupt_Mask;
  98
  99    ------------------------
 100    -- Get_Interrupt_Mask --
 101    ------------------------
 102
 103    procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
 104       pragma Unreferenced (Mask);
 105    begin
 106       Raise_Exception
 107         (Program_Error'Identity,
 108          "Get_Interrupt_Mask unimplemented");
 109    end Get_Interrupt_Mask;
 110
 111    --------------------
 112    -- Interrupt_Wait --
 113    --------------------
 114
 115    function Interrupt_Wait
 116      (Mask : access Interrupt_Mask) return Interrupt_ID
 117    is
 118       pragma Unreferenced (Mask);
 119    begin
 120       Raise_Exception
 121         (Program_Error'Identity,
 122          "Interrupt_Wait unimplemented");
 123       return 0;
 124    end Interrupt_Wait;
 125
 126    ----------------------------
 127    -- Install_Default_Action --
 128    ----------------------------
 129
 130    procedure Install_Default_Action (Interrupt : Interrupt_ID) is
 131       pragma Unreferenced (Interrupt);
 132    begin
 133       Raise_Exception
 134         (Program_Error'Identity,
 135          "Install_Default_Action unimplemented");
 136    end Install_Default_Action;
 137
 138    ---------------------------
 139    -- Install_Ignore_Action --
 140    ---------------------------
 141
 142    procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
 143       pragma Unreferenced (Interrupt);
 144    begin
 145       Raise_Exception
 146         (Program_Error'Identity,
 147          "Install_Ignore_Action unimplemented");
 148    end Install_Ignore_Action;
 149
 150    -------------------------
 151    -- Fill_Interrupt_Mask --
 152    -------------------------
 153
 154    procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
 155       pragma Unreferenced (Mask);
 156    begin
 157       Raise_Exception
 158         (Program_Error'Identity,
 159          "Fill_Interrupt_Mask unimplemented");
 160    end Fill_Interrupt_Mask;
 161
 162    --------------------------
 163    -- Empty_Interrupt_Mask --
 164    --------------------------
 165
 166    procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
 167       pragma Unreferenced (Mask);
 168    begin
 169       Raise_Exception
 170         (Program_Error'Identity,
 171          "Empty_Interrupt_Mask unimplemented");
 172    end Empty_Interrupt_Mask;
 173
 174    ---------------------------
 175    -- Add_To_Interrupt_Mask --
 176    ---------------------------
 177
 178    procedure Add_To_Interrupt_Mask
 179      (Mask      : access Interrupt_Mask;
 180       Interrupt : Interrupt_ID)
 181    is
 182       pragma Unreferenced (Mask, Interrupt);
 183    begin
 184       Raise_Exception
 185         (Program_Error'Identity,
 186          "Add_To_Interrupt_Mask unimplemented");
 187    end Add_To_Interrupt_Mask;
 188
 189    --------------------------------
 190    -- Delete_From_Interrupt_Mask --
 191    --------------------------------
 192
 193    procedure Delete_From_Interrupt_Mask
 194      (Mask      : access Interrupt_Mask;
 195       Interrupt : Interrupt_ID)
 196    is
 197       pragma Unreferenced (Mask, Interrupt);
 198    begin
 199       Raise_Exception
 200         (Program_Error'Identity,
 201          "Delete_From_Interrupt_Mask unimplemented");
 202    end Delete_From_Interrupt_Mask;
 203
 204    ---------------
 205    -- Is_Member --
 206    ---------------
 207
 208    function Is_Member
 209      (Mask      : access Interrupt_Mask;
 210       Interrupt : Interrupt_ID) return Boolean
 211    is
 212       pragma Unreferenced (Mask, Interrupt);
 213    begin
 214       Raise_Exception
 215         (Program_Error'Identity,
 216          "Is_Member unimplemented");
 217       return False;
 218    end Is_Member;
 219
 220    -------------------------
 221    -- Copy_Interrupt_Mask --
 222    -------------------------
 223
 224    procedure Copy_Interrupt_Mask
 225      (X : out Interrupt_Mask;
 226       Y : Interrupt_Mask) is
 227       pragma Unreferenced (X, Y);
 228    begin
 229       Raise_Exception
 230         (Program_Error'Identity,
 231          "Copy_Interrupt_Mask unimplemented");
 232    end Copy_Interrupt_Mask;
 233
 234    ----------------------------
 235    -- Interrupt_Self_Process --
 236    ----------------------------
 237
 238    procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
 239       Result : Interfaces.C.int;
 240    begin
 241       Result := kill (getpid, Signal (Interrupt));
 242       pragma Assert (Result = 0);
 243    end Interrupt_Self_Process;
 244
 245    --------------------------
 246    -- Setup_Interrupt_Mask --
 247    --------------------------
 248
 249    procedure Setup_Interrupt_Mask is
 250    begin
 251       --  Nothing to be done. Ada interrupt facilities on VxWorks do not use
 252       --  signals but hardware interrupts. Therefore, interrupt management does
 253       --  not need anything related to signal masking. Note that this procedure
 254       --  cannot raise an exception (as some others in this package) because
 255       --  the generic implementation of the Timer_Server and timing events make
 256       --  explicit calls to this routine to make ensure proper signal masking
 257       --  on targets needed that.
 258
 259       null;
 260    end Setup_Interrupt_Mask;
 261
 262 end System.Interrupt_Management.Operations;