gcc/ada/libgnarl/a-interr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --                         A D A . I N T E R R U P T S                      --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --             Copyright (C) 1991-2017, Florida State University            --
  10 --                     Copyright (C) 1995-2020, 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 with Ada.Unchecked_Conversion;
  34
  35 package body Ada.Interrupts is
  36
  37    package SI renames System.Interrupts;
  38
  39    function To_System is new Ada.Unchecked_Conversion
  40      (Parameterless_Handler, SI.Parameterless_Handler);
  41
  42    function To_Ada is new Ada.Unchecked_Conversion
  43      (SI.Parameterless_Handler, Parameterless_Handler);
  44
  45    --------------------
  46    -- Attach_Handler --
  47    --------------------
  48
  49    procedure Attach_Handler
  50      (New_Handler : Parameterless_Handler;
  51       Interrupt   : Interrupt_ID)
  52    is
  53    begin
  54       SI.Attach_Handler
  55         (To_System (New_Handler), SI.Interrupt_ID (Interrupt), False);
  56    end Attach_Handler;
  57
  58    ---------------------
  59    -- Current_Handler --
  60    ---------------------
  61
  62    function Current_Handler
  63      (Interrupt : Interrupt_ID) return Parameterless_Handler
  64    is
  65    begin
  66       return To_Ada (SI.Current_Handler (SI.Interrupt_ID (Interrupt)));
  67    end Current_Handler;
  68
  69    --------------------
  70    -- Detach_Handler --
  71    --------------------
  72
  73    procedure Detach_Handler (Interrupt : Interrupt_ID) is
  74    begin
  75       SI.Detach_Handler (SI.Interrupt_ID (Interrupt), False);
  76    end Detach_Handler;
  77
  78    ----------------------
  79    -- Exchange_Handler --
  80    ----------------------
  81
  82    procedure Exchange_Handler
  83      (Old_Handler : out Parameterless_Handler;
  84       New_Handler : Parameterless_Handler;
  85       Interrupt   : Interrupt_ID)
  86    is
  87       H : SI.Parameterless_Handler;
  88
  89    begin
  90       SI.Exchange_Handler
  91         (H, To_System (New_Handler),
  92          SI.Interrupt_ID (Interrupt), False);
  93       Old_Handler := To_Ada (H);
  94    end Exchange_Handler;
  95
  96    -------------
  97    -- Get_CPU --
  98    -------------
  99
 100    function Get_CPU
 101      (Interrupt : Interrupt_ID) return System.Multiprocessors.CPU_Range
 102    is
 103       pragma Unreferenced (Interrupt);
 104
 105    begin
 106       --  The underlying operating system does not indicate the processor on
 107       --  which the handler for Interrupt is executed.
 108
 109       return System.Multiprocessors.Not_A_Specific_CPU;
 110    end Get_CPU;
 111
 112    -----------------
 113    -- Is_Attached --
 114    -----------------
 115
 116    function Is_Attached (Interrupt : Interrupt_ID) return Boolean is
 117    begin
 118       return SI.Is_Handler_Attached (SI.Interrupt_ID (Interrupt));
 119    end Is_Attached;
 120
 121    -----------------
 122    -- Is_Reserved --
 123    -----------------
 124
 125    function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
 126    begin
 127       return SI.Is_Reserved (SI.Interrupt_ID (Interrupt));
 128    end Is_Reserved;
 129
 130    ---------------
 131    -- Reference --
 132    ---------------
 133
 134    function Reference (Interrupt : Interrupt_ID) return System.Address is
 135    begin
 136       return SI.Reference (SI.Interrupt_ID (Interrupt));
 137    end Reference;
 138
 139 end Ada.Interrupts;