home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / s-interr.adb < prev    next >
Text File  |  2000-07-19  |  9KB  |  304 lines

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