File : s-traceb-vx653-sim.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 with System.Address_To_Access_Conversions;
  33 with Interfaces.C;
  34 with System.Machine_Code; use System.Machine_Code;
  35 
  36 --  This version is for the AE653 Level A runtime, VxSim
  37 
  38 package body System.Traceback is
  39 
  40    package Addr is new System.Address_To_Access_Conversions (System.Address);
  41    use Addr;
  42 
  43    procedure Call_Chain
  44      (Traceback   : in out System.Traceback_Entries.Tracebacks_Array;
  45       Max_Len     : Natural;
  46       Len         : out Natural;
  47       Exclude_Min : System.Address := System.Null_Address;
  48       Exclude_Max : System.Address := System.Null_Address;
  49       Skip_Frames : Natural := 1) is
  50 
  51       Frame_Link_Offset     : constant System.Address := 0;
  52       --  Offset of memory location where address of previous frame
  53       --  is stored, relative to current frame. This must be
  54       --  a multiple of System.Address'Alignment.
  55       pragma Assert (Frame_Link_Offset mod System.Address'Alignment = 0);
  56 
  57       Return_Address_Offset : constant System.Address := 4;
  58       --  Offset in bytes where return address of current frame stored,
  59       --  relative to current frame.
  60       pragma Assert (Return_Address_Offset mod System.Address'Alignment = 0);
  61 
  62       PC_Adjust : constant := 2;
  63       --  Size of call instruction to subtract from return address to
  64       --  get the PC for the calling frame.
  65 
  66       Frame : System.Address;
  67       --  Frame being processed
  68 
  69       Top_Of_Stack : System.Address;
  70       --  Address of top frame
  71 
  72       Last  : Integer := Traceback'First - 1;
  73       --  Index of last traceback written to the buffer
  74 
  75    begin
  76       Len := 0;
  77 
  78       --  Move contents of FP
  79 
  80       Asm ("mov %%ebp, %0",
  81            Outputs  => Address'Asm_Output ("=r", Frame),
  82            Volatile => True);
  83 
  84       --  Set to correct frame location, with correct return address
  85 
  86       Top_Of_Stack := Frame;
  87 
  88       --  Exclude Skip_Frames frames from the traceback
  89 
  90       for J in 1 .. Skip_Frames - 1 loop
  91          if Frame = System.Null_Address
  92            or else Frame mod System.Address'Alignment /= 0
  93            or else To_Pointer (Frame).all = System.Null_Address
  94            or else To_Pointer (Frame + Return_Address_Offset).all <=
  95                                             System.Null_Address
  96            or else Frame < Top_Of_Stack
  97          then
  98             --  Something is wrong. Skip_Frames > the number of frames on the
  99             --  current stack. Do not return a trace.
 100 
 101             return;
 102          end if;
 103 
 104          Frame := To_Pointer (Frame).all;
 105       end loop;
 106 
 107       pragma Assert (Frame /= System.Null_Address);
 108 
 109       while Frame mod System.Address'Alignment = 0
 110         and then To_Pointer (Frame).all /= System.Null_Address
 111         and then To_Pointer (Frame + Return_Address_Offset).all >
 112                                            System.Null_Address
 113         and then Frame >= Top_Of_Stack
 114         and then Last < Traceback'Last
 115         and then Len < Max_Len
 116       loop
 117          declare
 118             PC : constant System.Address :=
 119                    To_Pointer (Frame + Return_Address_Offset).all - PC_Adjust;
 120 
 121          begin
 122             if PC not in Exclude_Min .. Exclude_Max then
 123 
 124                --  Skip Ada.Exceptions routines
 125 
 126                Last := Last + 1;
 127                Len := Len + 1;
 128                Traceback (Last) := PC;
 129             end if;
 130 
 131             Frame := To_Pointer (Frame).all;
 132          end;
 133 
 134          pragma Assert (Frame /= System.Null_Address);
 135       end loop;
 136    end Call_Chain;
 137 
 138 end System.Traceback;