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;