gcc/ada/5ointerr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
   4 --                                                                          --
   5 --                     S Y S T E M . I N T E R R U P T S                    --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --                                                                          --
  10 --            Copyright (C) 1991-2001 Florida State University              --
  11 --                                                                          --
  12 -- GNARL 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 2,  or (at your option) any later ver- --
  15 -- sion. GNARL 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.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- As a special exception,  if other files  instantiate  generics from this --
  24 -- unit, or you link  this unit with other files  to produce an executable, --
  25 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  26 -- covered  by the  GNU  General  Public  License.  This exception does not --
  27 -- however invalidate  any other reasons why  the executable file  might be --
  28 -- covered by the  GNU Public License.                                      --
  29 --                                                                          --
  30 -- GNARL was developed by the GNARL team at Florida State University. It is --
  31 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
  32 -- State University (http://www.gnat.com).                                  --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35
  36 --  This is an OS/2 version of this package.
  37
  38 --  This version is a stub, for systems that
  39 --  do not support interrupts (or signals).
  40
  41 with Ada.Exceptions;
  42
  43 package body System.Interrupts is
  44
  45    pragma Warnings (Off); -- kill warnings on unreferenced formals
  46
  47    use System.Tasking;
  48
  49    -----------------------
  50    -- Local Subprograms --
  51    -----------------------
  52
  53    procedure Unimplemented;
  54    --  This procedure raises a Program_Error with an appropriate message
  55    --  indicating that an unimplemented feature has been used.
  56
  57    --------------------
  58    -- Attach_Handler --
  59    --------------------
  60
  61    procedure Attach_Handler
  62      (New_Handler : in Parameterless_Handler;
  63       Interrupt   : in Interrupt_ID;
  64       Static      : in Boolean := False)
  65    is
  66    begin
  67       Unimplemented;
  68    end Attach_Handler;
  69
  70    -----------------------------
  71    -- Bind_Interrupt_To_Entry --
  72    -----------------------------
  73
  74    procedure Bind_Interrupt_To_Entry
  75      (T       : Task_ID;
  76       E       : Task_Entry_Index;
  77       Int_Ref : System.Address)
  78    is
  79    begin
  80       Unimplemented;
  81    end Bind_Interrupt_To_Entry;
  82
  83    ---------------------
  84    -- Block_Interrupt --
  85    ---------------------
  86
  87    procedure Block_Interrupt (Interrupt : Interrupt_ID) is
  88    begin
  89       Unimplemented;
  90    end Block_Interrupt;
  91
  92    ---------------------
  93    -- Current_Handler --
  94    ---------------------
  95
  96    function Current_Handler
  97      (Interrupt : Interrupt_ID)
  98       return      Parameterless_Handler
  99    is
 100    begin
 101       Unimplemented;
 102       return null;
 103    end Current_Handler;
 104
 105    --------------------
 106    -- Detach_Handler --
 107    --------------------
 108
 109    procedure Detach_Handler
 110      (Interrupt : in Interrupt_ID;
 111       Static    : in Boolean := False)
 112    is
 113    begin
 114       Unimplemented;
 115    end Detach_Handler;
 116
 117    ------------------------------
 118    -- Detach_Interrupt_Entries --
 119    ------------------------------
 120
 121    procedure Detach_Interrupt_Entries (T : Task_ID) is
 122    begin
 123       Unimplemented;
 124    end Detach_Interrupt_Entries;
 125
 126    ----------------------
 127    -- Exchange_Handler --
 128    ----------------------
 129
 130    procedure Exchange_Handler
 131      (Old_Handler : out Parameterless_Handler;
 132       New_Handler : in Parameterless_Handler;
 133       Interrupt   : in Interrupt_ID;
 134       Static      : in Boolean := False)
 135    is
 136    begin
 137       Old_Handler := null;
 138       Unimplemented;
 139    end Exchange_Handler;
 140
 141    --------------
 142    -- Finalize --
 143    --------------
 144
 145    procedure Finalize (Object : in out Static_Interrupt_Protection) is
 146    begin
 147       Unimplemented;
 148    end Finalize;
 149
 150    -------------------------------------
 151    -- Has_Interrupt_Or_Attach_Handler --
 152    -------------------------------------
 153
 154    function Has_Interrupt_Or_Attach_Handler
 155      (Object : access Dynamic_Interrupt_Protection)
 156       return   Boolean
 157    is
 158    begin
 159       Unimplemented;
 160       return True;
 161    end Has_Interrupt_Or_Attach_Handler;
 162
 163    function Has_Interrupt_Or_Attach_Handler
 164      (Object : access Static_Interrupt_Protection)
 165       return   Boolean
 166    is
 167    begin
 168       Unimplemented;
 169       return True;
 170    end Has_Interrupt_Or_Attach_Handler;
 171
 172    ----------------------
 173    -- Ignore_Interrupt --
 174    ----------------------
 175
 176    procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
 177    begin
 178       Unimplemented;
 179    end Ignore_Interrupt;
 180
 181    ----------------------
 182    -- Install_Handlers --
 183    ----------------------
 184
 185    procedure Install_Handlers
 186      (Object       : access Static_Interrupt_Protection;
 187       New_Handlers : in New_Handler_Array)
 188    is
 189    begin
 190       Unimplemented;
 191    end Install_Handlers;
 192
 193    ----------------
 194    -- Is_Blocked --
 195    ----------------
 196
 197    function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
 198    begin
 199       Unimplemented;
 200       return True;
 201    end Is_Blocked;
 202
 203    -----------------------
 204    -- Is_Entry_Attached --
 205    -----------------------
 206
 207    function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
 208    begin
 209       Unimplemented;
 210       return True;
 211    end Is_Entry_Attached;
 212
 213    -------------------------
 214    -- Is_Handler_Attached --
 215    -------------------------
 216
 217    function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
 218    begin
 219       Unimplemented;
 220       return True;
 221    end Is_Handler_Attached;
 222
 223    ----------------
 224    -- Is_Ignored --
 225    ----------------
 226
 227    function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
 228    begin
 229       Unimplemented;
 230       return True;
 231    end Is_Ignored;
 232
 233    -----------------
 234    -- Is_Reserved --
 235    -----------------
 236
 237    function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
 238    begin
 239       Unimplemented;
 240       return True;
 241    end Is_Reserved;
 242
 243    ---------------
 244    -- Reference --
 245    ---------------
 246
 247    function Reference (Interrupt : Interrupt_ID) return System.Address is
 248    begin
 249       Unimplemented;
 250       return Interrupt'Address;
 251    end Reference;
 252
 253    --------------------------------
 254    -- Register_Interrupt_Handler --
 255    --------------------------------
 256
 257    procedure Register_Interrupt_Handler
 258      (Handler_Addr : System.Address)
 259    is
 260    begin
 261       Unimplemented;
 262    end Register_Interrupt_Handler;
 263
 264    -----------------------
 265    -- Unblock_Interrupt --
 266    -----------------------
 267
 268    procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
 269    begin
 270       Unimplemented;
 271    end Unblock_Interrupt;
 272
 273    ------------------
 274    -- Unblocked_By --
 275    ------------------
 276
 277    function Unblocked_By (Interrupt : Interrupt_ID)
 278      return System.Tasking.Task_ID is
 279    begin
 280       Unimplemented;
 281       return null;
 282    end Unblocked_By;
 283
 284    ------------------------
 285    -- Unignore_Interrupt --
 286    ------------------------
 287
 288    procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
 289    begin
 290       Unimplemented;
 291    end Unignore_Interrupt;
 292
 293    -------------------
 294    -- Unimplemented; --
 295    -------------------
 296
 297    procedure Unimplemented is
 298    begin
 299       Ada.Exceptions.Raise_Exception
 300         (Program_Error'Identity, "interrupts/signals not implemented");
 301       raise Program_Error;
 302    end Unimplemented;
 303
 304 end System.Interrupts;