------------------------------------------------------------------------------
--                                                                          --
--                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
--                                                                          --
--                        S Y S T E M . T A S K I N G                       --
--                                                                          --
--                                  S p e c                                 --
--                                                                          --
--                             $Revision: 1.5 $                             --
--                                                                          --
--           Copyright (c) 1991,1992,1993, FSU, All Rights Reserved         --
--                                                                          --
--  GNARL is free software; you can redistribute it and/or modify it  under --
--  terms  of  the  GNU  Library General Public License as published by the --
--  Free Software Foundation; either version 2,  or (at  your  option)  any --
--  later  version.   GNARL is distributed in the hope that it will be use- --
--  ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
--  MERCHANTABILITY  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
--  eral Library Public License for more details.  You should have received --
--  a  copy of the GNU Library General Public License along with GNARL; see --
--  file COPYING. If not, write to the Free Software Foundation,  675  Mass --
--  Ave, Cambridge, MA 02139, USA.                                          --
--                                                                          --
------------------------------------------------------------------------------

--  This package provides the necessary type definitions for compiler
--  interface. A number of definitions has to be private. However,
--  current version does not provide private definitions (compiler error)

with System.Task_Primitives;
--  Used for,  Task_Primitives.Lock

package System.Tasking is

   --  This part has to be deleted when private part become stable.
   --  Commented out definitions has to be enabled for these types.

   Max_ATC_Nesting : constant Natural := 20;
   type Call_Modes is (Simple_Call, Conditional_Call, Asynchronous_Call);

   type Protection;
   type Protection_Access is access Protection;

   Null_Entry : constant := 0;

   Max_Entry : constant := System.Max_Int;

   Interrupt_Entry : constant := -2;

   Cancelled_Entry : constant := -1;

   type Entry_Index is range Interrupt_Entry .. Max_Entry;

   Null_Task_Entry : constant := Null_Entry;

   Max_Task_Entry : constant := Max_Entry;

   type Task_Entry_Index is new Entry_Index
     range Null_Task_Entry .. Entry_Index (Max_Task_Entry);
   --  Unnecessary conversion is to get round GNAT version 1.79 bug ???

   Null_Protected_Entry : constant := Null_Entry;

   Max_Protected_Entry : constant := Max_Entry;

   type Protected_Entry_Index is new Entry_Index
     range Null_Protected_Entry .. Entry_Index (Max_Protected_Entry);
   --  Unnecessary conversion is to get round GNAT version 1.79 bug ???

   --  Rendezvous related definitions

   Max_Select : constant Integer := Integer'Last;
   --  RTS-defined

   subtype Select_Index is Integer range 0 .. Max_Select;
   --  This is a subtype so that operations on it will be visible to
   --  the code generated by GNAT.

   type Accept_Alternative is record --  should be packed
      Null_Body : Boolean;
      S : Task_Entry_Index;
   end record;

   subtype Positive_Select_Index is
     Select_Index range 1 .. Select_Index'Last;

   type Accept_List is
     array (Positive_Select_Index range <>) of Accept_Alternative;

   type Accept_List_Access is access constant Accept_List;

   --  These definitions have to go into private part later ???

   type Dummy is new Integer;

   type Task_ID is access Dummy;

   Null_Task : constant Task_ID := null;

   --  This should be a constant, but this package is not elaborated.
   --  the following constant declartion doesn't seem to have problem.
   --  if not being used, can be got rid of later. ???

   type Exception_ID is new Integer;

   Null_Exception      : constant Exception_ID := 0;
   Constraint_Error_ID : constant Exception_ID := 1;
   Numeric_Error_ID    : constant Exception_ID := 2;
   Program_Error_ID    : constant Exception_ID := 3;
   Storage_Error_ID    : constant Exception_ID := 4;
   Tasking_Error_ID    : constant Exception_ID := 5;

   type tmp is record
      d : integer;
   end record;

   type Pre_Call_State is access tmp;

   --  Abortion related declarations

   subtype ATC_Level_Base is Integer range 0 .. Max_ATC_Nesting;

   ATC_Level_Infinity : constant ATC_Level_Base := ATC_Level_Base'Last;

   subtype ATC_Level is ATC_Level_Base range
     ATC_Level_Base'First .. ATC_Level_Base'Last - 1;

   subtype ATC_Level_Index is ATC_Level
     range ATC_Level'First + 1 .. ATC_Level'Last;

   type Task_List is array (Positive range <>) of Task_ID;

   --  Rendezvous related types

   Priority_Not_Boosted : constant Integer := System.Priority'First - 1;

   subtype Rendezvous_Priority is Integer
     range Priority_Not_Boosted .. System.Priority'Last;

   type Select_Modes is (
     Simple_Mode,
     Else_Mode,
     Terminate_Mode);

   --  Task Entry related definitions

   type Entry_Call_Record;

   type Entry_Call_Link is access Entry_Call_Record;

   type Entry_Queue is record
      Head : Entry_Call_Link;
      Tail : Entry_Call_Link;
   end record;

   type Entry_Call_Record is record

      Next : Entry_Call_Link;

      Call_Claimed : Boolean;
      --  This flag is True if the call has been queued
      --  and subsequently claimed
      --  for service or cancellation.
      --  Protection : Test_And_Set/gloabal update or some similar mechanism
      --  (e.g. global mutex).
      --  Caution : on machines were we use Test_And_Set, we may not want this
      --  field packed.  For example, the SPARC atomic ldsub instruction
      --  effects a whole byte.

      Self  : Task_ID;
      Level : ATC_Level;
      --  One of Self and Level are redundent in this implementation, since
      --  each Entry_Call_Record is at Self.Entry_Calls (Level).  Since we must
      --  have access to the entry call record to be reading this, we could
      --  get Self from Level, or Level from Self.  However, this requires
      --  non-portable address arithmetic.

      Mode : Call_Modes;
      Abortable : Boolean;

      Done : Boolean;
      --  Protection : Self.L.

      E : Entry_Index;

      Prio : System.Any_Priority;

      --  The above fields are those that there may be some hope of packing.
      --  They are gathered together to allow for compilers that lay records
      --  out contigously, to allow for such packing.

      Uninterpreted_Data : System.Address;

      Exception_To_Raise : Exception_ID;
      --  The exception to raise once this call has been completed without
      --  being aborted.

      --  Server : Server_Record;

      Called_Task : Task_ID;
      --  For task entry calls only.

      Acceptor_Prev_Call : Entry_Call_Link;
      --  For task entry calls only.

      Acceptor_Prev_Priority : Rendezvous_Priority;
      --  For task entry calls only.
      --  The priority of the most recent prior call being serviced.
      --  For protected entry calls, this function should be performed by
      --  GNULLI ceiling locking.

      Called_PO : Protection_Access;
      --  For protected entry calls only.

   end record;

   --  Protected_Objects replated definitions

   type Protected_Entry_Queue_Array is
        array (Protected_Entry_Index range <>) of
        Entry_Queue;

   type Protection (Num_Entries : Protected_Entry_Index) is tagged record
        L : Task_Primitives.Lock;
        Pending_Call : Entry_Call_Link;
        Call_In_Progress : Entry_Call_Link;
        Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
   end record;

   type Master_ID is new Integer;

   type Activation_Chain is new Task_ID;

   --  type Task_ID is private;
   --  Null_Task : constant Task_ID;
   --  ???

   function Self return Task_ID;
   pragma Inline (Self);

   --  Exception related types ???

   --  type Exception_ID is private;

   --  Null_Exception : constant Exception_ID;

   --  Constraint_Error_ID : constant Exception_ID;

   --  Numeric_Error_ID : constant Exception_ID;

   --  Program_Error_ID : constant Exception_ID;

   --  Storage_Error_ID : constant Exception_ID;

   --  Tasking_Error_ID : constant Exception_ID;

   --  Task size, initial_state and interrupt info.

   type Init_State is access procedure (Arg : System.Address);

   --  type Pre_Call_State is private;

   type Task_Storage_Size is new integer;

   type Interrupt_ID is range 0 .. 31;

   type Signal_Number is range 0 .. 31;
   for Signal_Number'Size use 32;
   --  This use of 32 is highly suspicious ???

   --  Interrupt_Info types

   type sigset_t is new Integer;

   type sigval is record
      u0 : Integer;
   end record;

   type struct_siginfo is record
      si_signo : Signal_Number;
      si_code : Integer;
      si_value : sigval;
   end record;

   type siginfo_ptr is access struct_siginfo;

   type Interrupt_Info is new siginfo_ptr;

   type Access_Boolean is access Boolean;

   type Size_Type is new Task_Storage_Size;

   Unspecified_Size : constant Size_Type := Size_Type'First;

   --  Abortion related types

   --   Max_ATC_Nesting : constant Natural := 20;

   --  Entry index type ???

   --  Null_Entry : constant := 0;

   --  Max_Entry : constant := System.Max_Int;

   --  Interrupt_Entry : constant := -2;

   --  Cancelled_Entry : constant := -1;

   --  type Entry_Index is range Interrupt_Entry .. Max_Entry;

   --  Derived types for Rendezvous and PO entry calls.

   --  Null_Task_Entry : constant := Null_Entry

   --  Max_Task_Entry : constant := Max_Entry;

   --  type Task_Entry_Index is new Entry_Index
   --    range Null_Task_Entry .. Max_Task_Entry;

   --  Null_Protected_Entry : constant := Null_Entry;

   --  Max_Protected_Entry : constant := Max_Entry;

   --  type Protected_Entry_Index is new Entry_Index
   --    range Null_Protected_Entry .. Max_Protected_Entry;

   --  Rendezvous related definitions

   --  Max_Select : constant Integer := Integer'Last;
   --  RTS-defined

   --  subtype Select_Index is Integer range 0 .. Max_Select;
   --  This is a subtype so that operations on it will be visible to
   --  the code generated by GNAT.

   No_Rendezvous : constant Select_Index := 0;

   --  Protected Object related definitions

   --  type Call_Modes is (Simple_Call, Conditional_Call, Asynchronous_Call);

   --  type Protection (Num_Entries : Protected_Entry_Index) is private;

   --  type Protection_Access is access Protection;

   type Communication_Block is record
      Self : Task_ID;
   end record;

   type Barrier_Vector is array (Protected_Entry_Index range <>) of Boolean;

   --  Task stage related types

   --   type Master_ID is private;

   --   type Activation_Chain is limited private;

   Unspecified_Priority : constant Integer := System.Priority'First - 1;


   --  Following part should be discarded. It is needed for now. ???

   --  type Entry_Call_Link is private;

   --  type Entry_Queue is private;

   --  type  Rendezvous_Priority is private;

--  private

--  These definitions actually belongs to Tasking.Queuing.
--  Moved to here in odrder to avoid compiler internal error.

   procedure Enqueue (E : in out Entry_Queue; Call : Entry_Call_Link);
   --  Enqueue Call at the end of entry_queue E

   procedure Dequeue (E : in out Entry_Queue; Call : Entry_Call_Link);
   --  Dequeue Call from entry_queue E

   function Head (E : in Entry_Queue) return Entry_Call_Link;
   --  Return the head of entry_queue E

   procedure Dequeue_Head
     (E    : in out Entry_Queue;
      Call : out Entry_Call_Link);
   --  Remove and return the head of entry_queue E

   function Onqueue (Call : Entry_Call_Link) return Boolean;
   --  Return True if Call is on any entry_queue at all

   function Count_Waiting (E : in Entry_Queue) return Natural;
   --  Return number of calls on the waiting queue of E

end System.Tasking;
