home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / s-os2~tp.ads < prev    next >
Text File  |  1996-09-28  |  6KB  |  184 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  4. --                                                                          --
  5. --                S Y S T E M . T A S K _ P R I M I T I V E S               --
  6. --                                                                          --
  7. --                                  S p e c                                 --
  8. --                               (OS/2 version)                             --
  9. --                                                                          --
  10. --                             $Revision: 1.5 $                             --
  11. --                                                                          --
  12. --           Copyright (c) 1993,1994,1995 NYU, All Rights Reserved          --
  13. --                                                                          --
  14. --  GNARL is free software; you can redistribute it and/or modify it  under --
  15. --  terms  of  the  GNU  Library General Public License as published by the --
  16. --  Free Software Foundation; either version 2, or (at  your  option)  any  --
  17. --  later  version.   GNARL is distributed in the hope that it will be use- --
  18. --  ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
  19. --  MERCHANTABILITY  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  20. --  eral Library Public License for more details.  You should have received --
  21. --  a  copy of the GNU Library General Public License along with GNARL; see --
  22. --  file COPYING. If not, write to the Free Software Foundation,  675  Mass --
  23. --  Ave, Cambridge, MA 02139, USA.                                          --
  24. --                                                                          --
  25. ------------------------------------------------------------------------------
  26.  
  27. with System.Task_Clock;
  28. with System.OS2Lib.Threads;
  29. with System.OS2Lib.Synchronization;
  30.  
  31. package System.Task_Primitives is
  32. --  Cannot be preelaborated, because body requires initialization
  33. --  of Test_And_Set lock
  34. --  pragma Preelaborate (Task_Primitives);
  35.  
  36.    type LL_Task_Procedure_Access is new System.OS2Lib.Threads.PFNTHREAD;
  37.    --  type LL_Task_Procedure_Access is private; -- should be private ???
  38.  
  39.    type Pre_Call_State     is private;
  40.    type Task_Storage_Size  is range 0 .. Integer'Last;
  41.    type Machine_Exceptions is range 0 .. Integer'Last;
  42.    type Interrupt_ID       is range 0 .. Integer'Last;
  43.    type Interrupt_Info     is new String;
  44.    type Error_information  is new String;
  45.  
  46.    Task_Wrapper_Frame : constant Integer := 72;
  47.    --  This is the size of the frame for the Pthread_Wrapper procedure.
  48.  
  49.    -----------
  50.    -- Tasks --
  51.    -----------
  52.  
  53.    type Task_Control_Block is private;
  54.    type TCB_Ptr is access all Task_Control_Block;
  55.  
  56.    procedure Initialize_LL_Tasks (T : TCB_Ptr);
  57.  
  58.    procedure Create_LL_Task
  59.       (Priority       : Priority;
  60.        Stack_Size     : Task_Storage_Size;
  61.        LL_Entry_Point : LL_Task_Procedure_Access;
  62.        Arg            : Address;
  63.        T              : TCB_Ptr);
  64.  
  65.    procedure Exit_LL_Task;
  66.  
  67.    function Self return TCB_Ptr;
  68.  
  69.    -----------
  70.    -- Locks --
  71.    -----------
  72.  
  73.    type Lock is private;
  74.  
  75.    procedure Initialize_Lock (Prio : Integer; L : in out Lock);
  76.  
  77.    procedure Finalize_Lock (L : in out Lock);
  78.  
  79.    procedure Write_Lock (L : in out Lock; Ceiling_Violation : out Boolean);
  80.  
  81.    procedure Read_Lock (L : in out Lock; Ceiling_Violation : out Boolean);
  82.  
  83.    procedure Unlock (L : in out Lock);
  84.  
  85.    -------------------------
  86.    -- Condition Variables --
  87.    -------------------------
  88.  
  89.    type Condition_Variable is private;
  90.  
  91.    procedure Initialize_Cond (Cond : in out Condition_Variable);
  92.  
  93.    procedure Finalize_Cond (Cond : in out Condition_Variable);
  94.  
  95.    procedure Cond_Wait (Cond : in out Condition_Variable; L : in out Lock);
  96.  
  97.    procedure Cond_Timed_Wait
  98.      (Cond      : in out Condition_Variable;
  99.       L         : in out Lock;
  100.       Abs_Time  : System.Task_Clock.Stimespec;
  101.       Timed_Out : out Boolean);
  102.  
  103.    procedure Cond_Signal (Cond : in out Condition_Variable);
  104.  
  105.    ----------------
  106.    -- Priorities --
  107.    ----------------
  108.  
  109.    procedure Set_Priority (T : TCB_Ptr; Prio : Integer);
  110.  
  111.    procedure Set_Own_Priority (Prio : Integer);
  112.  
  113.    function Get_Priority (T : TCB_Ptr) return Integer;
  114.  
  115.    function Get_Own_Priority return Integer;
  116.  
  117.    -----------------------------
  118.    -- Signals, Errors, Aborts --
  119.    -----------------------------
  120.  
  121.    procedure Abort_Task (T : TCB_Ptr);
  122.  
  123.    procedure Test_Abort;
  124.  
  125.    type Abort_Handler_Pointer is access procedure (Context : Pre_Call_State);
  126.  
  127.    procedure Install_Abort_Handler (Handler : Abort_Handler_Pointer);
  128.  
  129.    procedure Install_Error_Handler (Handler : Address);
  130.  
  131.    procedure Signal_Task (T : TCB_Ptr; I : Interrupt_ID);
  132.  
  133.    procedure Wait_for_Signal (I : Interrupt_ID);
  134.  
  135.    function Reserved_Signal (I : Interrupt_ID) return Boolean;
  136.  
  137.    procedure LL_Assert (B : Boolean; M : String);
  138.  
  139.    --------------------------
  140.    -- Test and Set Support --
  141.    --------------------------
  142.    type TAS_Cell is private;
  143.    procedure Initialize_TAS_Cell (Cell :    out TAS_Cell);
  144.    pragma Inline (Initialize_TAS_Cell);
  145.    procedure Finalize_TAS_Cell   (Cell : in out TAS_Cell);
  146.    pragma Inline (Finalize_TAS_Cell);
  147.    procedure Clear        (Cell : in out TAS_Cell);
  148.    pragma Inline (Clear);
  149.    procedure Test_And_Set (Cell : in out TAS_Cell; Result : out Boolean);
  150.    pragma Inline (Test_And_Set);
  151.    function  Is_Set       (Cell : in     TAS_Cell) return Boolean;
  152.    pragma Inline (Is_Set);
  153. private
  154.    use System.OS2Lib,
  155.        System.OS2Lib.Threads,
  156.        System.OS2Lib.Synchronization;
  157.  
  158.    --  type LL_Task_Procedure_Access is new PFNTHREAD; ???
  159.  
  160.    type Pre_Call_State is new Integer;
  161.    --  Unused for OS/2
  162.  
  163.    type Task_Control_Block is record
  164.       LL_Entry_Point  : LL_Task_Procedure_Access;
  165.       LL_Arg          : Address;
  166.       Thread          : TID;
  167.       Active_Priority : Priority;
  168.       Aborted         : Boolean := False;
  169.    end record;
  170.  
  171.    type Lock is
  172.       record
  173.          Mutex          : aliased HMTX;
  174.          Priority       : Integer;
  175.          Owner_Priority : Integer;
  176.       end record;
  177.  
  178.    type Condition_Variable is new HEV;
  179.    type TAS_Cell is record
  180.       Value : aliased Boolean := False;
  181.    end record;
  182.  
  183. end System.Task_Primitives;
  184.