2005-09-01 Arnaud Charlet <charlet@adacore.com>

	    Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-vxworks.adb:
	Move with clauses outside Warnings Off now that dependent units are
	Preelaborate.
	(Initialize): Call Interrupt_Managemeent.Initialize to ensure proper
	initialization of this unit.
	(Specific): Add new procedures Initialize and Delete so that this
	package can be used for VxWorks 5.x and 6.x
	(ATCB_Key, ATCB_Key_Address): Moved to Specific package body to hide
	differences between VxWorks 5.x and 6.x
	Minor reformatting.
	(Timed_Delay): Remove calls to Defer/Undefer_Abort, now performed by
	caller.
	Use only Preelaborate-compatible constructs.

	* s-tpopsp-vxworks.adb (ATBC_Key, ATCB_Key_Addr): Moved from
	Primitives.Operations.
	(Delete, Initialize): New procedures.

	* s-osinte-vxworks.adb: Body used to handle differences between
	VxWorks 5.x and 6.x
	(kill, Set_Time_Slice, VX_FP_TASK): New functions.

	* s-osinte-vxworks.ads: Minor reformatting.
	Add VxWworks 6.x specific functions (only called from VxWorks 6 files).
	(VX_FP_TASK): Now a function, to handle differences between VxWorks 5
	and 6.
	(Set_Time_Slice): New function, replacing kerneltimeSlice to share code
	between Vxworks 5 and 6.
	(taskLock, taskUnlock): Removeed, no longer used.

	* adaint.c: The wait.h header is not located in the sys directory on
	VxWorks when using RTPs.
	(__gnat_set_env_value): Use setenv instead of putenv on VxWorks when
	using RTPs.
	(__gnat_dup): dup is available on Vxworks when using RTPs.
	(__gnat_dup2): dup2 is available on Vxworks when using RTPs.

	* cal.c: Use the header time.h for Vxworks 6.0 when using RTPs.

	* expect.c: The wait.h header is not located in the sys directory on
	VxWorks when using RTPs.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103852 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 30 insertions, 55 deletions

diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index e955398d7ff..2165ea7f39c 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -40,6 +40,11 @@ pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during
 --  tasking operations. It causes infinite loops and other problems.
 
+with System.Tasking;
+--  used for Ada_Task_Control_Block
+--           Task_Id
+--           ATCB components and types
+
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
@@ -49,25 +54,12 @@ with System.Interrupt_Management;
 --           Signal_ID
 --           Initialize_Interrupts
 
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
 with System.OS_Interface;
 --  used for various type, constant, and operations
 
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
---           ATCB components and types
-
 with Interfaces.C;
 
 with Unchecked_Conversion;
@@ -81,8 +73,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use type Interfaces.C.int;
 
-   package SSL renames System.Soft_Links;
-
    subtype int is System.OS_Interface.int;
 
    Relative : constant := 0;
@@ -99,15 +89,6 @@ package body System.Task_Primitives.Operations is
    --  time; it is used to execute in mutual exclusion from all other tasks.
    --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
 
-   ATCB_Key : aliased System.Address := System.Null_Address;
-   --  Key used to find the Ada Task_Id associated with a thread
-
-   ATCB_Key_Addr : System.Address := ATCB_Key'Address;
-   pragma Export (Ada, ATCB_Key_Addr, "__gnat_ATCB_key_addr");
-   --  Exported to support the temporary AE653 task registration
-   --  implementation. This mechanism is used to minimize impact on other
-   --  targets.
-
    Environment_Task_Id : Task_Id;
    --  A variable to hold Task_Id for the environment task
 
@@ -125,9 +106,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set
-
    Mutex_Protocol : Priority_Type;
 
    Foreign_Task_Elaborated : aliased Boolean := True;
@@ -139,6 +117,10 @@ package body System.Task_Primitives.Operations is
 
    package Specific is
 
+      procedure Initialize;
+      pragma Inline (Initialize);
+      --  Initialize task specific data
+
       function Is_Valid_Task return Boolean;
       pragma Inline (Is_Valid_Task);
       --  Does executing thread have a TCB?
@@ -147,6 +129,10 @@ package body System.Task_Primitives.Operations is
       pragma Inline (Set);
       --  Set the self id for the current task
 
+      procedure Delete;
+      pragma Inline (Delete);
+      --  Delete the task specific data associated with the current task
+
       function Self return Task_Id;
       pragma Inline (Self);
       --  Return a pointer to the Ada Task Control Block of the calling task
@@ -298,7 +284,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Finalize_Lock (L : access Lock) is
       Result : int;
-
    begin
       Result := semDelete (L.Mutex);
       pragma Assert (Result = 0);
@@ -306,7 +291,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Finalize_Lock (L : access RTS_Lock) is
       Result : int;
-
    begin
       Result := semDelete (L.Mutex);
       pragma Assert (Result = 0);
@@ -318,7 +302,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
       Result : int;
-
    begin
       if L.Protocol = Prio_Protect
         and then int (Self.Common.Current_Priority) > L.Prio_Ceiling
@@ -338,7 +321,6 @@ package body System.Task_Primitives.Operations is
       Global_Lock : Boolean := False)
    is
       Result : int;
-
    begin
       if not Single_Lock or else Global_Lock then
          Result := semTake (L.Mutex, WAIT_FOREVER);
@@ -348,7 +330,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Write_Lock (T : Task_Id) is
       Result : int;
-
    begin
       if not Single_Lock then
          Result := semTake (T.Common.LL.L.Mutex, WAIT_FOREVER);
@@ -370,8 +351,7 @@ package body System.Task_Primitives.Operations is
    ------------
 
    procedure Unlock (L : access Lock) is
-      Result  : int;
-
+      Result : int;
    begin
       Result := semGive (L.Mutex);
       pragma Assert (Result = 0);
@@ -379,7 +359,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
       Result : int;
-
    begin
       if not Single_Lock or else Global_Lock then
          Result := semGive (L.Mutex);
@@ -389,7 +368,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Unlock (T : Task_Id) is
       Result : int;
-
    begin
       if not Single_Lock then
          Result := semGive (T.Common.LL.L.Mutex);
@@ -568,9 +546,9 @@ package body System.Task_Primitives.Operations is
    --  caller is holding no locks.
 
    procedure Timed_Delay
-     (Self_ID  : Task_Id;
-      Time     : Duration;
-      Mode     : ST.Delay_Modes)
+     (Self_ID : Task_Id;
+      Time    : Duration;
+      Mode    : ST.Delay_Modes)
    is
       Orig     : constant Duration := Monotonic_Clock;
       Absolute : Duration;
@@ -580,8 +558,6 @@ package body System.Task_Primitives.Operations is
       Aborted  : Boolean := False;
 
    begin
-      SSL.Abort_Defer.all;
-
       if Mode = Relative then
          Absolute := Orig + Time;
          Ticks    := To_Clock_Ticks (Time);
@@ -654,7 +630,7 @@ package body System.Task_Primitives.Operations is
             end if;
 
             --  Take back the lock after having slept, to protect further
-            --  access to Self_ID
+            --  access to Self_ID.
 
             if Single_Lock then
                Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
@@ -678,8 +654,6 @@ package body System.Task_Primitives.Operations is
       else
          taskDelay (0);
       end if;
-
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -754,7 +728,7 @@ package body System.Task_Primitives.Operations is
           (T.Common.LL.Thread, To_VxWorks_Priority (int (Prio)));
       pragma Assert (Result = 0);
 
-      if FIFO_Within_Priorities then
+      if Dispatching_Policy = 'F' then
 
          --  Annex D requirement [RM D.2.2 par. 9]:
 
@@ -905,15 +879,15 @@ package body System.Task_Primitives.Operations is
       --  Ask for four extra bytes of stack space so that the ATCB pointer can
       --  be stored below the stack limit, plus extra space for the frame of
       --  Task_Wrapper. This is so the user gets the amount of stack requested
-      --  exclusive of the needs
-      --
+      --  exclusive of the needs.
+
       --  We also have to allocate n more bytes for the task name storage and
       --  enough space for the Wind Task Control Block which is around 0x778
       --  bytes. VxWorks also seems to carve out additional space, so use 2048
       --  as a nice round number. We might want to increment to the nearest
       --  page size in case we ever support VxVMI.
-      --
-      --  XXX - we should come back and visit this so we can set the task name
+
+      --  ??? - we should come back and visit this so we can set the task name
       --        to something appropriate.
 
       Adjusted_Stack_Size := Adjusted_Stack_Size + 2048;
@@ -990,8 +964,7 @@ package body System.Task_Primitives.Operations is
       Free (Tmp);
 
       if Is_Self then
-         Result := taskVarDelete (taskIdSelf, ATCB_Key'Access);
-         pragma Assert (Result /= ERROR);
+         Specific.Delete;
       end if;
    end Finalize_TCB;
 
@@ -1249,8 +1222,12 @@ package body System.Task_Primitives.Operations is
 
    procedure Initialize (Environment_Task : Task_Id) is
       Result : int;
-
    begin
+      Environment_Task_Id := Environment_Task;
+
+      Interrupt_Management.Initialize;
+      Specific.Initialize;
+
       if Locking_Policy = 'C' then
          Mutex_Protocol := Prio_Protect;
       elsif Locking_Policy = 'I' then
@@ -1260,7 +1237,7 @@ package body System.Task_Primitives.Operations is
       end if;
 
       if Time_Slice_Val > 0 then
-         Result := kernelTimeSlice
+         Result := Set_Time_Slice
            (To_Clock_Ticks
              (Duration (Time_Slice_Val) / Duration (1_000_000.0)));
       end if;
@@ -1275,8 +1252,6 @@ package body System.Task_Primitives.Operations is
          end if;
       end loop;
 
-      Environment_Task_Id := Environment_Task;
-
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);