s-taprop-linux.adb (Get_Stack_Attributes): New subprogram.

2007-08-14  Olivier Hainque  <hainque@adacore.com>

	* s-taprop-linux.adb (Get_Stack_Attributes): New subprogram. Fetch the
	stack size and initial stack pointer value for a given task.
	(Enter_Task): Get the stack attributes of the task we are entering and
	let the stack checking engine know about them.

	* s-stchop.adb, s-stchop.ads (Notify_Stack_Attributes): New subprogram.
	Let the stack-checking engine know about the initial sp value and stack
	size associated with the current task.
	(Set_Stack_Info): If a stack base has been notified for the current
	task, honor it. Fallback to the previous less accurate method otherwise.

	* s-stchop-vxworks.adb (Notify_Stack_Attributes): Dummy body.

From-SVN: r127435

gcc/ada/s-stchop-vxworks.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1999-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -95,6 +95,24 @@ package body System.Stack_Checking.Operations is
       Cache := Null_Stack;
    end Invalidate_Stack_Cache;
 
+   -----------------------------
+   -- Notify_Stack_Attributes --
+   -----------------------------
+
+   procedure Notify_Stack_Attributes
+     (Initial_SP : System.Address;
+      Size       : System.Storage_Elements.Storage_Offset)
+   is
+      --  We retrieve the attributes directly from Set_Stack_Info below, so
+      --  this implementation has nothing to do.
+
+      pragma Unreferenced (Initial_SP);
+      pragma Unreferenced (Size);
+
+   begin
+      null;
+   end Notify_Stack_Attributes;
+
    --------------------
    -- Set_Stack_Info --
    --------------------
@@ -120,7 +138,7 @@ package body System.Stack_Checking.Operations is
       Task_Info : aliased OS_Stack_Info;
 
    begin
-      --  The order of steps 1 .. 3 is important, see specification.
+      --  The order of steps 1 .. 3 is important, see specification
 
       --  1) Get the Stack_Access value for the current task
 

gcc/ada/s-stchop.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1999-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -86,6 +86,26 @@ package body System.Stack_Checking.Operations is
       Cache := Null_Stack;
    end Invalidate_Stack_Cache;
 
+   -----------------------------
+   -- Notify_Stack_Attributes --
+   -----------------------------
+
+   procedure Notify_Stack_Attributes
+     (Initial_SP : System.Address;
+      Size       : System.Storage_Elements.Storage_Offset)
+   is
+      My_Stack : constant Stack_Access := Soft_Links.Get_Stack_Info.all;
+
+      --  We piggyback on the 'Limit' field to store what will be used as the
+      --  'Base' and leave the 'Size' alone to not interfere with the logic in
+      --  Set_Stack_Info below.
+
+      pragma Unreferenced (Size);
+
+   begin
+      My_Stack.Limit := Initial_SP;
+   end Notify_Stack_Attributes;
+
    --------------------
    -- Set_Stack_Info --
    --------------------
@@ -102,7 +122,7 @@ package body System.Stack_Checking.Operations is
       Limit       : Integer;
 
    begin
-      --  The order of steps 1 .. 3 is important, see specification.
+      --  The order of steps 1 .. 3 is important, see specification
 
       --  1) Get the Stack_Access value for the current task
 
@@ -131,7 +151,14 @@ package body System.Stack_Checking.Operations is
             end if;
          end if;
 
-         My_Stack.Base := Frame_Address;
+         --  If a stack base address has been registered, honor it.
+         --  Fallback to the address of a local object otherwise.
+
+         if My_Stack.Limit /= System.Null_Address then
+            My_Stack.Base := My_Stack.Limit;
+         else
+            My_Stack.Base := Frame_Address;
+         end if;
 
          if Stack_Grows_Down then
 

gcc/ada/s-stchop.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1999-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -42,6 +42,8 @@ pragma Polling (Off);
 --  Turn off polling, we do not want polling to take place during stack
 --  checking operations. It causes infinite loops and other problems.
 
+with System.Storage_Elements;
+
 package System.Stack_Checking.Operations is
    pragma Preelaborate;
 
@@ -59,6 +61,14 @@ package System.Stack_Checking.Operations is
    function Stack_Check (Stack_Address : System.Address) return Stack_Access;
    --  This version of Stack_Check should not be inlined
 
+   procedure Notify_Stack_Attributes
+     (Initial_SP : System.Address;
+      Size       : System.Storage_Elements.Storage_Offset);
+   --  Register Initial_SP as the initial stack pointer value for the current
+   --  task when it starts and Size as the associated stack area size. This
+   --  should be called once, after the soft-links have been initialized and
+   --  prior to the first "Stack_Check" call.
+
 private
    Cache : aliased Stack_Access := Null_Stack;
 

gcc/ada/s-taprop-linux.adb

@@ -63,8 +63,9 @@ with System.Soft_Links;
 --  For example when using the restricted run time, it is replaced by
 --  System.Tasking.Restricted.Stages.
 
+with System.Storage_Elements;
 with System.Stack_Checking.Operations;
---  Used for Invalidate_Stack_Cache;
+--  Used for Invalidate_Stack_Cache and Notify_Stack_Attributes;
 
 with Ada.Exceptions;
 --  used for Raise_Exception
@@ -85,6 +86,7 @@ package body System.Task_Primitives.Operations is
    use System.OS_Interface;
    use System.Parameters;
    use System.OS_Primitives;
+   use System.Storage_Elements;
 
    ----------------
    -- Local Data --
@@ -175,6 +177,13 @@ package body System.Task_Primitives.Operations is
    function To_pthread_t is new Ada.Unchecked_Conversion
      (unsigned_long, System.OS_Interface.pthread_t);
 
+   procedure Get_Stack_Attributes
+     (T    : Task_Id;
+      ISP  : out System.Address;
+      Size : out Storage_Offset);
+   --  Fill ISP and Size with the Initial Stack Pointer value and the
+   --  thread stack size for task T.
+
    -------------------
    -- Abort_Handler --
    -------------------
@@ -705,6 +714,50 @@ package body System.Task_Primitives.Operations is
       return T.Common.Current_Priority;
    end Get_Priority;
 
+   --------------------------
+   -- Get_Stack_Attributes --
+   --------------------------
+
+   procedure Get_Stack_Attributes
+     (T    : Task_Id;
+      ISP  : out System.Address;
+      Size : out Storage_Offset)
+   is
+      function pthread_getattr_np
+        (thread : pthread_t;
+         attr   : System.Address) return Interfaces.C.int;
+      pragma Import (C, pthread_getattr_np, "pthread_getattr_np");
+
+      function pthread_attr_getstack
+        (attr : System.Address;
+         base : System.Address;
+         size : System.Address) return Interfaces.C.int;
+      pragma Import (C, pthread_attr_getstack, "pthread_attr_getstack");
+
+      Result : Interfaces.C.int;
+
+      Attributes : aliased pthread_attr_t;
+      Stack_Base : aliased System.Address;
+      Stack_Size : aliased Storage_Offset;
+
+   begin
+      Result :=
+        pthread_getattr_np
+          (T.Common.LL.Thread, Attributes'Address);
+      pragma Assert (Result = 0);
+
+      Result :=
+        pthread_attr_getstack
+          (Attributes'Address, Stack_Base'Address, Stack_Size'Address);
+      pragma Assert (Result = 0);
+
+      Result := pthread_attr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
+
+      ISP  := Stack_Base + Stack_Size;
+      Size := Stack_Size;
+   end Get_Stack_Attributes;
+
    ----------------
    -- Enter_Task --
    ----------------
@@ -726,6 +779,18 @@ package body System.Task_Primitives.Operations is
       end loop;
 
       Unlock_RTS;
+
+      --  Determine where the task stack starts, how large it is, and let the
+      --  stack checking engine know about it.
+
+      declare
+         Initial_SP : System.Address;
+         Stack_Size : Storage_Offset;
+      begin
+         Get_Stack_Attributes (Self_ID, Initial_SP, Stack_Size);
+         System.Stack_Checking.Operations.Notify_Stack_Attributes
+           (Initial_SP, Stack_Size);
+      end;
    end Enter_Task;
 
    --------------
@@ -1141,6 +1206,25 @@ package body System.Task_Primitives.Operations is
       end if;
    end Resume_Task;
 
+   --------------------
+   -- Stop_All_Tasks --
+   --------------------
+
+   procedure Stop_All_Tasks is
+   begin
+      null;
+   end Stop_All_Tasks;
+
+   -------------------
+   -- Continue_Task --
+   -------------------
+
+   function Continue_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Continue_Task;
+
    ----------------
    -- Initialize --
    ----------------