File : s-traceb-zfp-ppc.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                     S Y S T E M . T R A C E B A C K                      --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1999-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 --  This is the bare board version of this package for PPC targets
  33 
  34 with Ada.Unchecked_Conversion;
  35 
  36 with System.Machine_Code; use System.Machine_Code;
  37 
  38 package body System.Traceback is
  39 
  40    type Address_Ptr is access all System.Address;
  41    function To_Pointer is new
  42      Ada.Unchecked_Conversion (System.Address, Address_Ptr);
  43 
  44    procedure Call_Chain
  45      (Frame_Pointer : System.Address;
  46       Traceback     : in out System.Traceback_Entries.Tracebacks_Array;
  47       Len           : out Natural;
  48       Exclude_Min   : System.Address := System.Null_Address;
  49       Exclude_Max   : System.Address := System.Null_Address;
  50       Skip_Frames   : Natural := 0)
  51    is
  52       Return_Address_Offset : constant System.Address := 4;
  53       pragma Assert (Return_Address_Offset mod System.Address'Alignment = 0);
  54       --  Offset in bytes where return address of current frame stored,
  55       --  relative to current frame. This value is required to be a multiple
  56       --  of the ppc instruction size (4).
  57 
  58       PC_Adjust : constant := 4;
  59       --  Size of call instruction to subtract from return address to get the
  60       --  PC for the calling frame.
  61 
  62       Frame : System.Address := Frame_Pointer;
  63       --  Frame being processed
  64 
  65       Index : Natural := Traceback'First;
  66       --  Index of next item to store in Traceback
  67 
  68    begin
  69       Len := 0;
  70 
  71       --  Set to correct frame location, with correct return address
  72 
  73       --  Exclude Skip_Frames frames from the traceback. The PPC ABI has
  74       --  (System.Null_Address) as the back pointer address of the shallowest
  75       --  frame in the stack.
  76 
  77       for J in 1 .. Skip_Frames loop
  78          if Frame = System.Null_Address
  79            or else Frame mod System.Address'Alignment /= 0
  80            or else To_Pointer (Frame).all = System.Null_Address
  81          then
  82             --  Something is wrong. Skip_Frames is greater than the number of
  83             --  frames on the current stack. Do not return a trace.
  84 
  85             return;
  86          end if;
  87 
  88          Frame := To_Pointer (Frame).all;
  89       end loop;
  90 
  91       pragma Assert (Frame /= System.Null_Address);
  92 
  93       while Frame mod System.Address'Alignment = 0
  94         and then To_Pointer (Frame).all /= System.Null_Address
  95         and then Len < Traceback'Length
  96       loop
  97          declare
  98             PC : constant System.Address :=
  99                    To_Pointer (Frame + Return_Address_Offset).all - PC_Adjust;
 100 
 101          begin
 102             if PC not in Exclude_Min .. Exclude_Max then
 103 
 104                --  Skip specified routines, if any (e.g. Ada.Exceptions)
 105 
 106                Traceback (Index) := PC;
 107                Len   := Len + 1;
 108                Index := Index + 1;
 109             end if;
 110 
 111             Frame := To_Pointer (Frame).all;
 112          end;
 113 
 114          pragma Assert (Frame /= System.Null_Address);
 115       end loop;
 116    end Call_Chain;
 117 
 118    procedure Call_Chain
 119      (Traceback   : in out System.Traceback_Entries.Tracebacks_Array;
 120       Max_Len     : Natural;
 121       Len         : out Natural;
 122       Exclude_Min : System.Address := System.Null_Address;
 123       Exclude_Max : System.Address := System.Null_Address;
 124       Skip_Frames : Natural := 1)
 125    is
 126       procedure Forced_Callee;
 127       --  Force save of return address of Call_Chain on PPC
 128 
 129       -------------------
 130       -- Forced_Callee --
 131       -------------------
 132 
 133       --  The PPC ABI has an unusual characteristic: the return address saved
 134       --  by a subprogram is located in its caller's frame, and the save
 135       --  operation only occurs if the function performs a call.
 136 
 137       --  To make Call_Chain able to consistently retrieve its own return
 138       --  address, we define Forced_Callee and call it. This routine should
 139       --  never be inlined.
 140 
 141       procedure Forced_Callee is
 142          Dummy : aliased Integer := 0;
 143          pragma Volatile (Dummy);
 144          pragma Warnings (Off, Dummy);
 145          --  Force allocation of a frame. Dummy must be both volatile and
 146          --  referenced (achieved by declaring it aliased). Suppress warning
 147          --  that it could be declared a constant, and that pragma Volatile
 148          --  has no effect (it forces creation of the frame).
 149       begin
 150          null;
 151       end Forced_Callee;
 152 
 153       Frame_Pointer : System.Address;
 154 
 155    begin
 156       Forced_Callee;
 157 
 158       --  Move contents of r1 (sp) to "Frame_Pointer"
 159 
 160       Asm ("mr %0, 1",
 161            Outputs  => Address'Asm_Output ("=r", Frame_Pointer),
 162            Volatile => True);
 163       Call_Chain
 164         (Frame_Pointer,
 165          Traceback (Traceback'First .. Traceback'First + Max_Len - 1),
 166          Len, Exclude_Min, Exclude_Max, Skip_Frames);
 167    end Call_Chain;
 168 
 169    ------------------
 170    -- C_Call_Chain --
 171    ------------------
 172 
 173    function C_Call_Chain
 174      (Frame_Pointer : System.Address;
 175       Traceback     : System.Address;
 176       Traceback_Len : Integer) return Integer
 177    is
 178       subtype Tracebacks is System.Traceback_Entries.Tracebacks_Array
 179                               (1 .. Traceback_Len);
 180       type Ptr is access all Tracebacks;
 181       function To_Ptr is new Ada.Unchecked_Conversion (System.Address, Ptr);
 182 
 183       Len : Integer;
 184 
 185    begin
 186       Call_Chain (Frame_Pointer, To_Ptr (Traceback).all, Len);
 187       return Len;
 188    end C_Call_Chain;
 189 
 190 end System.Traceback;