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-tasdeb.adb < prev    next >
Text File  |  2000-07-19  |  20KB  |  702 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  4. --                                                                          --
  5. --                  S Y S T E M . T A S K I N G . D E B U G                 --
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.20 $
  10. --                                                                          --
  11. --          Copyright (C) 1997-1999 Free Software Foundation, Inc.          --
  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 package encapsulates all direct interfaces to task debugging services
  38. --  that are needed by gdb with gnat mode (1.13 and higher)
  39.  
  40. --  Note : This file *must* be compiled with debugging information
  41.  
  42. --  Do not add any dependency to GNARL packages since this package is used
  43. --  in both normal and resticted (ravenscar) environments.
  44.  
  45. with System.Task_Info,
  46.      System.Task_Primitives.Operations,
  47.      Unchecked_Conversion;
  48.  
  49. package body System.Tasking.Debug is
  50.  
  51.    use Interfaces.C;
  52.  
  53.    package STPO renames System.Task_Primitives.Operations;
  54.  
  55.    type Integer_Address is mod 2 ** Standard'Address_Size;
  56.    type Integer_Address_Ptr is access all Integer_Address;
  57.  
  58.    function "+" is new
  59.      Unchecked_Conversion (System.Address, Integer_Address_Ptr);
  60.  
  61.    function "+" is new
  62.      Unchecked_Conversion (Task_ID, Integer_Address);
  63.  
  64.    Hex_Address_Width : constant := (Standard'Address_Size / 4);
  65.  
  66.    Zero_Pos : constant := Character'Pos ('0');
  67.  
  68.    Hex_Digits : constant array (0 .. Integer_Address'(15)) of Character :=
  69.                   "0123456789abcdef";
  70.  
  71.    subtype Buf_Range is Integer range 1 .. 80;
  72.    type Buf_Array is array (Buf_Range) of aliased Character;
  73.  
  74.    type Buffer is record
  75.       Next  : Buf_Range := Buf_Range'First;
  76.       Chars : Buf_Array := (Buf_Range => ' ');
  77.    end record;
  78.  
  79.    type Buffer_Ptr is access all Buffer;
  80.  
  81.    type Trace_Flag_Set is array (Character) of Boolean;
  82.  
  83.    Trace_On : Trace_Flag_Set := ('A' .. 'Z' => False, others => True);
  84.  
  85.    -----------------------
  86.    -- Local Subprograms --
  87.    -----------------------
  88.  
  89.    procedure Put
  90.      (T      : ST.Task_ID;
  91.       Width  : Integer;
  92.       Buffer : Buffer_Ptr);
  93.    --  Put TCB pointer T, (coded in hexadecimal) into Buffer
  94.    --  right-justififed in Width characters.
  95.  
  96.    procedure Put
  97.      (N      : Integer_Address;
  98.       Width  : Integer;
  99.       Buffer : Buffer_Ptr);
  100.    --  Put N (coded in decimal) into Buf right-justified in Width
  101.    --  characters starting at Buf (Next).
  102.  
  103.    procedure Put
  104.      (S      : String;
  105.       Width  : Integer;
  106.       Buffer : Buffer_Ptr);
  107.    --  Put string S into Buf left-justified in Width characters
  108.    --  starting with space in Buf (Next), truncated as necessary.
  109.  
  110.    procedure Put
  111.      (C      : Character;
  112.       Buffer : Buffer_Ptr);
  113.    --  Put character C into Buf, left-justified, starting at Buf (Next)
  114.  
  115.    procedure Space (Buffer : Buffer_Ptr);
  116.    --  Increment Next, resulting in a space
  117.  
  118.    procedure Space
  119.      (N      : Integer;
  120.       Buffer : Buffer_Ptr);
  121.    --  Increment Next by N, resulting in N spaces
  122.  
  123.    procedure Clear (Buffer : Buffer_Ptr);
  124.    --  Clear Buf and reset Next to 1
  125.  
  126.    procedure Write_Buf (Buffer : Buffer_Ptr);
  127.    --  Write contents of Buf (1 .. Next) to standard output
  128.  
  129.    ------------------------
  130.    -- Task_Creation_Hook --
  131.    ------------------------
  132.  
  133.    procedure Task_Creation_Hook (Thread : OS_Interface.Thread_Id) is
  134.       pragma Inspection_Point (Thread);
  135.    begin
  136.       null;
  137.    end Task_Creation_Hook;
  138.  
  139.    ---------------------------
  140.    -- Task_Termination_Hook --
  141.    ---------------------------
  142.  
  143.    procedure Task_Termination_Hook is
  144.    begin
  145.       null;
  146.    end Task_Termination_Hook;
  147.  
  148.    ----------
  149.    -- Self --
  150.    ----------
  151.  
  152.    function Self return Task_ID is
  153.    begin
  154.       return STPO.Self;
  155.    end Self;
  156.  
  157.    --------------------
  158.    -- Set_User_State --
  159.    --------------------
  160.  
  161.    procedure Set_User_State (Value : Integer) is
  162.    begin
  163.       STPO.Self.User_State := Value;
  164.    end Set_User_State;
  165.  
  166.    ---------
  167.    -- Put --
  168.    ---------
  169.  
  170.    procedure Put
  171.      (T      : ST.Task_ID;
  172.       Width  : Integer;
  173.       Buffer : Buffer_Ptr)
  174.    is
  175.       J     : Integer;
  176.       X     : Integer_Address := +T;
  177.       Next  : Buf_Range renames Buffer.Next;
  178.       Buf   : Buf_Array renames Buffer.Chars;
  179.       First : constant Integer := Next;
  180.       Wdth  : Integer := Width;
  181.  
  182.    begin
  183.       if Wdth > Buf'Last - Next then
  184.          Wdth := Buf'Last - Next;
  185.       end if;
  186.  
  187.       J := Next + (Wdth - 1);
  188.  
  189.       if X = 0 then
  190.          Buf (J) := '0';
  191.  
  192.       else
  193.          while X > 0 loop
  194.             Buf (J) := Hex_Digits (X rem 16);
  195.             J := J - 1;
  196.             X := X / 16;
  197.  
  198.             --  Check for overflow
  199.  
  200.             if J < First and then X > 0 then
  201.                Buf (J + 1) := '*';
  202.                exit;
  203.             end if;
  204.  
  205.          end loop;
  206.       end if;
  207.  
  208.       Next := Next + Wdth;
  209.    end Put;
  210.  
  211.    procedure Put
  212.      (N      : Integer_Address;
  213.       Width  : Integer;
  214.       Buffer : Buffer_Ptr)
  215.    is
  216.       J     : Integer;
  217.       X     : Integer_Address := N;
  218.       Next  : Buf_Range renames Buffer.Next;
  219.       Buf   : Buf_Array renames Buffer.Chars;
  220.       First : constant Integer := Next;
  221.       Wdth  : Integer := Width;
  222.  
  223.    begin
  224.       if Wdth > Buf'Last - Next then
  225.          Wdth := Buf'Last - Next;
  226.       end if;
  227.  
  228.       J := Next + (Wdth - 1);
  229.  
  230.       if N = 0 then
  231.          Buf (J) := '0';
  232.  
  233.       else
  234.          while X > 0 loop
  235.             Buf (J) := Hex_Digits (X rem 10);
  236.             J := J - 1;
  237.             X := X / 10;
  238.  
  239.             --  Check for overflow
  240.  
  241.             if J < First and then X > 0 then
  242.                Buf (J + 1) := '*';
  243.                exit;
  244.             end if;
  245.          end loop;
  246.       end if;
  247.  
  248.       Next := Next + Wdth;
  249.    end Put;
  250.  
  251.    procedure Put
  252.      (S      : String;
  253.       Width  : Integer;
  254.       Buffer : Buffer_Ptr)
  255.    is
  256.       Next  : Buf_Range renames Buffer.Next;
  257.       Buf   : Buf_Array renames Buffer.Chars;
  258.       Bound : constant Integer := Integer'Min (Next + Width, Buf'Last);
  259.       J     : Integer := Next;
  260.  
  261.    begin
  262.       for K in S'Range loop
  263.  
  264.          --  Check overflow
  265.  
  266.          if J >= Bound then
  267.             Buf (J - 1) := '*';
  268.             exit;
  269.          end if;
  270.  
  271.          Buf (J) := S (K);
  272.          J := J + 1;
  273.       end loop;
  274.  
  275.       Next := Bound;
  276.    end Put;
  277.  
  278.    procedure Put
  279.      (C      : Character;
  280.       Buffer : Buffer_Ptr)
  281.    is
  282.       Next : Buf_Range renames Buffer.Next;
  283.       Buf  : Buf_Array renames Buffer.Chars;
  284.  
  285.    begin
  286.       if Next >= Buf'Last then
  287.          Buf (Next) := '*';
  288.       else Buf (Next) := C;
  289.          Next := Next + 1;
  290.       end if;
  291.    end Put;
  292.  
  293.    -----------
  294.    -- Space --
  295.    -----------
  296.  
  297.    procedure Space (Buffer : Buffer_Ptr) is
  298.       Next : Buf_Range renames Buffer.Next;
  299.       Buf  : Buf_Array renames Buffer.Chars;
  300.  
  301.    begin
  302.       if Next >= Buf'Last then
  303.          Buf (Next) := '*';
  304.       else
  305.          Next := Next + 1;
  306.       end if;
  307.    end Space;
  308.  
  309.    procedure Space
  310.      (N      : Integer;
  311.       Buffer : Buffer_Ptr)
  312.    is
  313.       Next : Buf_Range renames Buffer.Next;
  314.       Buf  : Buf_Array renames Buffer.Chars;
  315.  
  316.    begin
  317.       if Next + N > Buf'Last then
  318.          Buf (Next) := '*';
  319.       else
  320.          Next := Next + N;
  321.       end if;
  322.    end Space;
  323.  
  324.    -----------
  325.    -- Clear --
  326.    -----------
  327.  
  328.    procedure Clear (Buffer : Buffer_Ptr) is
  329.       Next : Buf_Range renames Buffer.Next;
  330.       Buf  : Buf_Array renames Buffer.Chars;
  331.  
  332.    begin
  333.       Buf := (Buf_Range => ' ');
  334.       Next := 1;
  335.    end Clear;
  336.  
  337.    ---------------
  338.    -- Write_Buf --
  339.    ---------------
  340.  
  341.    procedure Write_Buf (Buffer : Buffer_Ptr) is
  342.       Next : Buf_Range renames Buffer.Next;
  343.       Buf  : Buf_Array renames Buffer.Chars;
  344.  
  345.       procedure put_char (C : Integer);
  346.       pragma Import (C, put_char, "put_char");
  347.  
  348.    begin
  349.       for J in 1 .. Next - 1 loop
  350.          put_char (Character'Pos (Buf (J)));
  351.       end loop;
  352.  
  353.       put_char (Character'Pos (ASCII.LF));
  354.    end Write_Buf;
  355.  
  356.    ---------------------
  357.    -- Print_Task_Info --
  358.    ---------------------
  359.  
  360.    procedure Print_Task_Info (T : ST.Task_ID) is
  361.       Entry_Call : Entry_Call_Link;
  362.       Buf        : aliased Buffer;
  363.  
  364.       use type System.Task_Info.Task_Image_Type;
  365.  
  366.    begin
  367.       Clear (Buf'Unchecked_Access);
  368.       Put (T, Hex_Address_Width, Buf'Unchecked_Access);
  369.       Put (':', Buf'Unchecked_Access);
  370.       Put (' ', Buf'Unchecked_Access);
  371.       Put (':', Buf'Unchecked_Access);
  372.  
  373.       if T = null then
  374.          Put (" null task", 10, Buf'Unchecked_Access);
  375.          Write_Buf (Buf'Unchecked_Access);
  376.          return;
  377.       end if;
  378.  
  379.       Put (Integer_Address (T.Serial_Number), 4, Buf'Unchecked_Access);
  380.       Space (Buf'Unchecked_Access);
  381.  
  382.       if T.Common.Task_Image = null then
  383.          Put ("", 15, Buf'Unchecked_Access);
  384.       else
  385.          Put (T.Common.Task_Image.all, 15, Buf'Unchecked_Access);
  386.       end if;
  387.  
  388.       Space (Buf'Unchecked_Access);
  389.       Put (Task_States'Image (T.Common.State), 10, Buf'Unchecked_Access);
  390.       Space (Buf'Unchecked_Access);
  391.  
  392.       if T.Callable then
  393.          Put ('C', Buf'Unchecked_Access);
  394.       else
  395.          Space (Buf'Unchecked_Access);
  396.       end if;
  397.  
  398.       if T.Open_Accepts /= null then
  399.          Put ('A', Buf'Unchecked_Access);
  400.       else
  401.          Space (Buf'Unchecked_Access);
  402.       end if;
  403.  
  404.       if T.Common.Call /= null then
  405.          Put ('C', Buf'Unchecked_Access);
  406.       else
  407.          Space (Buf'Unchecked_Access);
  408.       end if;
  409.  
  410.       if T.Terminate_Alternative then
  411.          Put ('T', Buf'Unchecked_Access);
  412.       else
  413.          Space (Buf'Unchecked_Access);
  414.       end if;
  415.  
  416.       if T.Aborting then
  417.          Put ('A', Buf'Unchecked_Access);
  418.       else
  419.          Space (Buf'Unchecked_Access);
  420.       end if;
  421.  
  422.       if T.Deferral_Level = 0 then
  423.          Space (3, Buf'Unchecked_Access);
  424.       else
  425.          Put ('D', Buf'Unchecked_Access);
  426.          if T.Deferral_Level < 0 then
  427.             Put ("<0", 2, Buf'Unchecked_Access);
  428.          elsif T.Deferral_Level > 1 then
  429.             Put (Integer_Address (T.Deferral_Level), 2, Buf'Unchecked_Access);
  430.          else
  431.             Space (2, Buf'Unchecked_Access);
  432.          end if;
  433.       end if;
  434.  
  435.       Space (Buf'Unchecked_Access);
  436.       Put (Integer_Address (T.Master_of_Task), 1, Buf'Unchecked_Access);
  437.       Space (Buf'Unchecked_Access);
  438.       Put (Integer_Address (T.Master_Within), 1, Buf'Unchecked_Access);
  439.       Put (',', Buf'Unchecked_Access);
  440.       Space (Buf'Unchecked_Access);
  441.       Put (Integer_Address (T.Awake_Count), 1, Buf'Unchecked_Access);
  442.       Space (Buf'Unchecked_Access);
  443.       Put (Integer_Address (T.Alive_Count), 1, Buf'Unchecked_Access);
  444.       Put (',', Buf'Unchecked_Access);
  445.       Space (Buf'Unchecked_Access);
  446.       Put (Integer_Address (T.ATC_Nesting_Level), 1, Buf'Unchecked_Access);
  447.       Space (Buf'Unchecked_Access);
  448.       Put (Integer_Address (T.Pending_ATC_Level), 1, Buf'Unchecked_Access);
  449.       Put (',', Buf'Unchecked_Access);
  450.       Space (Buf'Unchecked_Access);
  451.       Put (Integer_Address (T.Common.Wait_Count), 1, Buf'Unchecked_Access);
  452.       Put (',', Buf'Unchecked_Access);
  453.       Space (Buf'Unchecked_Access);
  454.       Put (Integer_Address (T.User_State), 1, Buf'Unchecked_Access);
  455.       Write_Buf (Buf'Unchecked_Access);
  456.  
  457.       if T.Common.Call /= null then
  458.          Entry_Call := T.Common.Call;
  459.          Clear (Buf'Unchecked_Access);
  460.          Space (10, Buf'Unchecked_Access);
  461.          Put ("serving:", 8, Buf'Unchecked_Access);
  462.  
  463.          while Entry_Call /= null loop
  464.             Put (Integer_Address
  465.               (Entry_Call.Self.Serial_Number), 5, Buf'Unchecked_Access);
  466.             Entry_Call := Entry_Call.Acceptor_Prev_Call;
  467.          end loop;
  468.  
  469.          Write_Buf (Buf'Unchecked_Access);
  470.       end if;
  471.  
  472.       Print_Accept_Info (T);
  473.    end Print_Task_Info;
  474.  
  475.    ----------------------------
  476.    -- Print_Task_Info_Header --
  477.    ----------------------------
  478.  
  479.    procedure Print_Task_Info_Header is
  480.       Buf : aliased Buffer;
  481.  
  482.    begin
  483.       Clear (Buf'Unchecked_Access);
  484.       Put ("TASK_ID", Hex_Address_Width, Buf'Unchecked_Access);
  485.       Put (':', Buf'Unchecked_Access);
  486.       Put ('F', Buf'Unchecked_Access);
  487.       Put (':', Buf'Unchecked_Access);
  488.       Put ("SERIAL_NUMBER", 4, Buf'Unchecked_Access);
  489.       Space (Buf'Unchecked_Access);
  490.       Put (" NAME", 15, Buf'Unchecked_Access);
  491.       Put (" STATE", 10, Buf'Unchecked_Access);
  492.       Space (11, Buf'Unchecked_Access);
  493.       Put ("MAST", 5, Buf'Unchecked_Access);
  494.       Put ("AWAK", 5, Buf'Unchecked_Access);
  495.       Put ("ATC", 5, Buf'Unchecked_Access);
  496.       Put ("WT", 3, Buf'Unchecked_Access);
  497.       Put ("DBG", 3, Buf'Unchecked_Access);
  498.       Write_Buf (Buf'Unchecked_Access);
  499.    end Print_Task_Info_Header;
  500.  
  501.    ------------------------
  502.    -- Print_Current_Task --
  503.    ------------------------
  504.  
  505.    procedure Print_Current_Task is
  506.    begin
  507.       Print_Task_Info (STPO.Self);
  508.    end Print_Current_Task;
  509.  
  510.    ----------------------
  511.    -- Print_List_Tasks --
  512.    ----------------------
  513.  
  514.    procedure List_Tasks is
  515.       C : ST.Task_ID;
  516.  
  517.    begin
  518.       Print_Task_Info_Header;
  519.       C := All_Tasks_List;
  520.  
  521.       while C /= null loop
  522.          Print_Task_Info (C);
  523.          C := C.Common.All_Tasks_Link;
  524.       end loop;
  525.    end List_Tasks;
  526.  
  527.    -----------------------
  528.    -- Print_Accept_Info --
  529.    -----------------------
  530.  
  531.    procedure Print_Accept_Info (T : ST.Task_ID) is
  532.       Buf : aliased Buffer;
  533.  
  534.    begin
  535.       if T.Open_Accepts = null then
  536.          return;
  537.       end if;
  538.  
  539.       Clear (Buf'Unchecked_Access);
  540.       Space (10, Buf'Unchecked_Access);
  541.       Put ("accepting:", 11, Buf'Unchecked_Access);
  542.  
  543.       for J in T.Open_Accepts.all'Range loop
  544.          Put (Integer_Address (T.Open_Accepts (J).S), 3, Buf'Unchecked_Access);
  545.       end loop;
  546.  
  547.       Write_Buf (Buf'Unchecked_Access);
  548.    end Print_Accept_Info;
  549.  
  550.    -----------
  551.    -- Trace --
  552.    -----------
  553.  
  554.    procedure Trace
  555.      (Self_ID  : ST.Task_ID;
  556.       Msg      : String;
  557.       Other_ID : ST.Task_ID;
  558.       Flag     : Character)
  559.    is
  560.       Buf : aliased Buffer;
  561.       use type System.Task_Info.Task_Image_Type;
  562.  
  563.    begin
  564.       if Trace_On (Flag) then
  565.          Clear (Buf'Unchecked_Access);
  566.          Put (Self_ID, Hex_Address_Width, Buf'Unchecked_Access);
  567.          Put (':', Buf'Unchecked_Access);
  568.          Put (Flag, Buf'Unchecked_Access);
  569.          Put (':', Buf'Unchecked_Access);
  570.          Put
  571.            (Integer_Address (Self_ID.Serial_Number),
  572.             4, Buf'Unchecked_Access);
  573.          Space (Buf'Unchecked_Access);
  574.  
  575.          if Self_ID.Common.Task_Image = null then
  576.             Put ("", 15, Buf'Unchecked_Access);
  577.          else
  578.             Put (Self_ID.Common.Task_Image.all, 15, Buf'Unchecked_Access);
  579.          end if;
  580.  
  581.          Space (Buf'Unchecked_Access);
  582.  
  583.          if Other_ID /= null then
  584.             Put
  585.               (Integer_Address (Other_ID.Serial_Number),
  586.                4, Buf'Unchecked_Access);
  587.             Space (Buf'Unchecked_Access);
  588.          end if;
  589.  
  590.          Put (Msg, Buf.Chars'Last - Buf.Next + 1, Buf'Unchecked_Access);
  591.          Write_Buf (Buf'Unchecked_Access);
  592.       end if;
  593.    end Trace;
  594.  
  595.    procedure Trace
  596.      (Self_ID : ST.Task_ID;
  597.       Msg     : String;
  598.       Flag    : Character)
  599.    is
  600.    begin
  601.       Trace (Self_ID, Msg, null, Flag);
  602.    end Trace;
  603.  
  604.    procedure Trace
  605.      (Msg : String;
  606.       Flag : Character)
  607.    is
  608.       Self_ID : constant ST.Task_ID := STPO.Self;
  609.  
  610.    begin
  611.       Trace (Self_ID, Msg, null, Flag);
  612.    end Trace;
  613.  
  614.    procedure Trace
  615.      (Msg      : String;
  616.       Other_ID : ST.Task_ID;
  617.       Flag     : Character)
  618.    is
  619.       Self_ID : constant ST.Task_ID := STPO.Self;
  620.  
  621.    begin
  622.       Trace (Self_ID, Msg, null, Flag);
  623.    end Trace;
  624.  
  625.    ---------------
  626.    -- Set_Trace --
  627.    ---------------
  628.  
  629.    procedure Set_Trace
  630.      (Flag  : Character;
  631.       Value : Boolean := True)
  632.    is
  633.    begin
  634.       Trace_On (Flag) := Value;
  635.    end Set_Trace;
  636.  
  637.    -----------
  638.    -- Image --
  639.    -----------
  640.  
  641.    function Image (T : ST.Task_ID) return String is
  642.       Buf    : aliased Buffer;
  643.       Result : String (1 .. Hex_Address_Width + 21);
  644.  
  645.       use type System.Task_Info.Task_Image_Type;
  646.  
  647.    begin
  648.       Clear (Buf'Unchecked_Access);
  649.       Put (T, Hex_Address_Width, Buf'Unchecked_Access);
  650.       Put (':', Buf'Unchecked_Access);
  651.       Put (Integer_Address (T.Serial_Number), 4, Buf'Unchecked_Access);
  652.       Space (Buf'Unchecked_Access);
  653.  
  654.       if T.Common.Task_Image = null then
  655.          Put ("", 15, Buf'Unchecked_Access);
  656.       else
  657.          Put (T.Common.Task_Image.all, 15, Buf'Unchecked_Access);
  658.       end if;
  659.  
  660.       for J in Result'Range loop
  661.          Result (J) := Buf.Chars (J);
  662.       end loop;
  663.  
  664.       return Result;
  665.    end Image;
  666.  
  667.    -----------------------
  668.    -- Suspend_All_Tasks --
  669.    -----------------------
  670.  
  671.    procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is
  672.       C : ST.Task_ID;
  673.       R : Boolean;
  674.  
  675.    begin
  676.       C := All_Tasks_List;
  677.  
  678.       while C /= null loop
  679.          R := STPO.Suspend_Task (C, Thread_Self);
  680.          C := C.Common.All_Tasks_Link;
  681.       end loop;
  682.    end Suspend_All_Tasks;
  683.  
  684.    ------------------------
  685.    -- Continue_All_Tasks --
  686.    ------------------------
  687.  
  688.    procedure Resume_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is
  689.       C : ST.Task_ID;
  690.       R : Boolean;
  691.  
  692.    begin
  693.       C := All_Tasks_List;
  694.  
  695.       while C /= null loop
  696.          R := STPO.Resume_Task (C, Thread_Self);
  697.          C := C.Common.All_Tasks_Link;
  698.       end loop;
  699.    end Resume_All_Tasks;
  700.  
  701. end System.Tasking.Debug;
  702.