gcc/ada/s-traceb-hpux.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 --                             (HP/UX Version)                              --
   7 --                                                                          --
   8 --                                 B o d y                                  --
   9 --                                                                          --
  10 --           Copyright (C) 2009-2014, Free Software Foundation, Inc.        --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  18 --                                                                          --
  19 -- As a special exception under Section 7 of GPL version 3, you are granted --
  20 -- additional permissions described in the GCC Runtime Library Exception,   --
  21 -- version 3.1, as published by the Free Software Foundation.               --
  22 --                                                                          --
  23 -- You should have received a copy of the GNU General Public License and    --
  24 -- a copy of the GCC Runtime Library Exception along with this program;     --
  25 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  26 -- <http://www.gnu.org/licenses/>.                                          --
  27 --                                                                          --
  28 -- GNAT was originally developed  by the GNAT team at  New York University. --
  29 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  30 --                                                                          --
  31 ------------------------------------------------------------------------------
  32
  33 with Ada.Unchecked_Conversion;
  34
  35 package body System.Traceback is
  36
  37    --  This package implements the backtracing facility by way of a dedicated
  38    --  HP library for stack unwinding described in the "Runtime Architecture
  39    --  Document".
  40
  41    pragma Linker_Options ("/usr/lib/libcl.a");
  42
  43    --  The library basically offers services to fetch information about a
  44    --  "previous" frame based on information about a "current" one.
  45
  46    type Current_Frame_Descriptor is record
  47       cur_fsz : Address;  --  Frame size of current routine.
  48       cur_sp  : Address;  --  The current value of stack pointer.
  49       cur_rls : Address;  --  PC-space of the caller.
  50       cur_rlo : Address;  --  PC-offset of the caller.
  51       cur_dp  : Address;  --  Data Pointer of the current routine.
  52       top_rp  : Address;  --  Initial value of RP.
  53       top_mrp : Address;  --  Initial value of MRP.
  54       top_sr0 : Address;  --  Initial value of sr0.
  55       top_sr4 : Address;  --  Initial value of sr4.
  56       top_r3  : Address;  --  Initial value of gr3.
  57       cur_r19 : Address;  --  GR19 value of the calling routine.
  58       top_r4  : Address;  --  Initial value of gr4.
  59       dummy   : Address;  --  Reserved.
  60       out_rlo : Address;  --  PC-offset of the caller after get_previous.
  61    end record;
  62
  63    type Previous_Frame_Descriptor is record
  64       prev_fsz : Address;  --  frame size of calling routine.
  65       prev_sp  : Address;  --  SP of calling routine.
  66       prev_rls : Address;  --  PC_space of calling routine's caller.
  67       prev_rlo : Address;  --  PC_offset of calling routine's caller.
  68       prev_dp  : Address;  --  DP of calling routine.
  69       udescr0  : Address;  --  low word of calling routine's unwind desc.
  70       udescr1  : Address;  --  high word of calling routine's unwind desc.
  71       ustart   : Address;  --  start of the unwind region.
  72       uend     : Address;  --  end of the unwind region.
  73       uw_index : Address;  --  index into the unwind table.
  74       prev_r19 : Address;  --  GR19 value of the caller's caller.
  75       top_r3   : Address;  --  Caller's initial gr3.
  76       top_r4   : Address;  --  Caller's initial gr4.
  77    end record;
  78
  79    --  Provide useful shortcuts for the names
  80
  81    subtype CFD is Current_Frame_Descriptor;
  82    subtype PFD is Previous_Frame_Descriptor;
  83
  84    --  Frames with dynamic stack allocation are handled using the associated
  85    --  frame pointer, but HP compilers and GCC setup this pointer differently.
  86    --  HP compilers set it to point at the top (highest address) of the static
  87    --  part of the frame, whereas GCC sets it to point at the bottom of this
  88    --  region. We have to fake the unwinder to compensate for this difference,
  89    --  for which we'll need to access some subprograms unwind descriptors.
  90
  91    type Bits_2_Value is mod 2 ** 2;
  92    for Bits_2_Value'Size use 2;
  93
  94    type Bits_4_Value  is mod 2 ** 4;
  95    for Bits_4_Value'Size use 4;
  96
  97    type Bits_5_Value  is mod 2 ** 5;
  98    for Bits_5_Value'Size use 5;
  99
 100    type Bits_27_Value is mod 2 ** 27;
 101    for Bits_27_Value'Size use 27;
 102
 103    type Unwind_Descriptor is record
 104       cannot_unwind         : Boolean;
 105       mcode                 : Boolean;
 106       mcode_save_restore    : Boolean;
 107       region_desc           : Bits_2_Value;
 108       reserved0             : Boolean;
 109       entry_sr              : Boolean;
 110       entry_fr              : Bits_4_Value;
 111       entry_gr              : Bits_5_Value;
 112
 113       args_stored           : Boolean;
 114       variable_frame        : Boolean;
 115       separate_package_body : Boolean;
 116       frame_extension_mcode : Boolean;
 117
 118       stack_overflow_check  : Boolean;
 119       two_steps_sp_adjust   : Boolean;
 120       sr4_export            : Boolean;
 121       cxx_info              : Boolean;
 122
 123       cxx_try_catch         : Boolean;
 124       sched_entry_seq       : Boolean;
 125       reserved1             : Boolean;
 126       save_sp               : Boolean;
 127
 128       save_rp               : Boolean;
 129       save_mrp              : Boolean;
 130       save_r19              : Boolean;
 131       cleanups              : Boolean;
 132
 133       hpe_interrupt_marker  : Boolean;
 134       hpux_interrupt_marker : Boolean;
 135       large_frame           : Boolean;
 136       alloca_frame          : Boolean;
 137
 138       reserved2             : Boolean;
 139       frame_size            : Bits_27_Value;
 140    end record;
 141
 142    for Unwind_Descriptor'Size use 64;
 143
 144    for Unwind_Descriptor use record
 145       cannot_unwind         at 0 range 0 .. 0;
 146       mcode                 at 0 range 1 .. 1;
 147       mcode_save_restore    at 0 range 2 .. 2;
 148       region_desc           at 0 range 3 .. 4;
 149       reserved0             at 0 range 5 .. 5;
 150       entry_sr              at 0 range 6 .. 6;
 151       entry_fr              at 0 range 7 .. 10;
 152
 153       entry_gr              at 1 range 3 .. 7;
 154
 155       args_stored           at 2 range 0 .. 0;
 156       variable_frame        at 2 range 1 .. 1;
 157       separate_package_body at 2 range 2 .. 2;
 158       frame_extension_mcode at 2 range 3 .. 3;
 159       stack_overflow_check  at 2 range 4 .. 4;
 160       two_steps_sp_adjust   at 2 range 5 .. 5;
 161       sr4_export            at 2 range 6 .. 6;
 162       cxx_info              at 2 range 7 .. 7;
 163
 164       cxx_try_catch         at 3 range 0 .. 0;
 165       sched_entry_seq       at 3 range 1 .. 1;
 166       reserved1             at 3 range 2 .. 2;
 167       save_sp               at 3 range 3 .. 3;
 168       save_rp               at 3 range 4 .. 4;
 169       save_mrp              at 3 range 5 .. 5;
 170       save_r19              at 3 range 6 .. 6;
 171       cleanups              at 3 range 7 .. 7;
 172
 173       hpe_interrupt_marker  at 4 range 0 .. 0;
 174       hpux_interrupt_marker at 4 range 1 .. 1;
 175       large_frame           at 4 range 2 .. 2;
 176       alloca_frame          at 4 range 3 .. 3;
 177
 178       reserved2             at 4 range 4 .. 4;
 179       frame_size            at 4 range 5 .. 31;
 180    end record;
 181
 182    subtype UWD is Unwind_Descriptor;
 183    type UWD_Ptr is access all UWD;
 184
 185    function To_UWD_Access is new Ada.Unchecked_Conversion (Address, UWD_Ptr);
 186
 187    --  The descriptor associated with a given code location is retrieved
 188    --  using functions imported from the HP library, requiring the definition
 189    --  of additional structures.
 190
 191    type Unwind_Table_Region is record
 192       Table_Start : Address;
 193       Table_End   : Address;
 194    end record;
 195    --  An Unwind Table region, which is a memory area containing Unwind
 196    --  Descriptors.
 197
 198    subtype UWT is Unwind_Table_Region;
 199
 200    --  The subprograms imported below are provided by the HP library
 201
 202    function U_get_unwind_table return UWT;
 203    pragma Import (C, U_get_unwind_table, "U_get_unwind_table");
 204    --  Get the unwind table region associated with the current executable.
 205    --  This function is actually documented as having an argument, but which
 206    --  is only used for the MPE/iX targets.
 207
 208    function U_get_shLib_unwind_table (r19 : Address) return UWT;
 209    pragma Import (C, U_get_shLib_unwind_table, "U_get_shLib_unw_tbl");
 210    --  Return the unwind table region associated with a possible shared
 211    --  library, as determined by the provided r19 value.
 212
 213    function U_get_shLib_text_addr (r19 : Address) return Address;
 214    pragma Import (C, U_get_shLib_text_addr, "U_get_shLib_text_addr");
 215    --  Return the address at which the code for a shared library begins, or
 216    --  -1 if the value provided for r19 does not identify shared library code.
 217
 218    function U_get_unwind_entry
 219      (Pc          : Address;
 220       Space       : Address;
 221       Table_Start : Address;
 222       Table_End   : Address) return Address;
 223    pragma Import (C, U_get_unwind_entry, "U_get_unwind_entry");
 224    --  Given the bounds of an unwind table, return the address of the
 225    --  unwind descriptor associated with a code location/space. In the case
 226    --  of shared library code, the offset from the beginning of the library
 227    --  is expected as Pc.
 228
 229    procedure U_init_frame_record (Frame : not null access CFD);
 230    pragma Import (C, U_init_frame_record, "U_init_frame_record");
 231
 232    procedure U_prep_frame_rec_for_unwind (Frame : not null access CFD);
 233    pragma Import (C, U_prep_frame_rec_for_unwind,
 234                     "U_prep_frame_rec_for_unwind");
 235
 236    --  Fetch the description data of the frame in which these two procedures
 237    --  are called.
 238
 239    function U_get_u_rlo
 240      (Cur : not null access CFD; Prev : not null access PFD) return Integer;
 241    pragma Import (C, U_get_u_rlo, "U_IS_STUB_OR_CALLX");
 242    --  From a complete current frame with a return location possibly located
 243    --  into a linker generated stub, and basic information about the previous
 244    --  frame, place the first non stub return location into the current frame.
 245    --  Return -1 if something went wrong during the computation.
 246
 247    function U_is_shared_pc (rlo : Address; r19 : Address) return Address;
 248    pragma Import (C, U_is_shared_pc, "U_is_shared_pc");
 249    --  Return 0 if the provided return location does not correspond to code
 250    --  in a shared library, or something non null otherwise.
 251
 252    function U_get_previous_frame_x
 253      (current_frame  : not null access CFD;
 254       previous_frame : not null access PFD;
 255       previous_size  : Integer) return Integer;
 256    pragma Import (C, U_get_previous_frame_x, "U_get_previous_frame_x");
 257    --  Fetch the data describing the "previous" frame relatively to the
 258    --  "current" one. "previous_size" should be the size of the "previous"
 259    --  frame descriptor provided.
 260    --
 261    --  The library provides a simpler interface without the size parameter
 262    --  but it is not usable when frames with dynamically allocated space are
 263    --  on the way.
 264
 265 --   procedure Call_Chain
 266 --     (Traceback   : System.Address;
 267 --      Max_Len     : Natural;
 268 --      Len         : out Natural;
 269 --      Exclude_Min : System.Address := System.Null_Address;
 270 --      Exclude_Max : System.Address := System.Null_Address;
 271 --      Skip_Frames : Natural := 1);
 272 --   --  Same as the exported version, but takes Traceback as an Address
 273 --  ???See declaration in the spec for why this is temporarily commented out.
 274
 275    ------------------
 276    -- C_Call_Chain --
 277    ------------------
 278
 279    function C_Call_Chain
 280      (Traceback : System.Address;
 281       Max_Len   : Natural) return Natural
 282    is
 283       Val : Natural;
 284    begin
 285       Call_Chain (Traceback, Max_Len, Val);
 286       return Val;
 287    end C_Call_Chain;
 288
 289    ----------------
 290    -- Call_Chain --
 291    ----------------
 292
 293    procedure Call_Chain
 294      (Traceback   : System.Address;
 295       Max_Len     : Natural;
 296       Len         : out Natural;
 297       Exclude_Min : System.Address := System.Null_Address;
 298       Exclude_Max : System.Address := System.Null_Address;
 299       Skip_Frames : Natural := 1)
 300    is
 301       type Tracebacks_Array is array (1 .. Max_Len) of System.Address;
 302       pragma Suppress_Initialization (Tracebacks_Array);
 303
 304       --  The code location returned by the unwinder is a return location but
 305       --  what we need is a call point. Under HP-UX call instructions are 4
 306       --  bytes long and the return point they specify is 4 bytes beyond the
 307       --  next instruction because of the delay slot.
 308
 309       Call_Size  : constant := 4;
 310       DSlot_Size : constant := 4;
 311       Rlo_Offset : constant := Call_Size + DSlot_Size;
 312
 313       --  Moreover, the return point is passed via a register which two least
 314       --  significant bits specify a privilege level that we will have to mask.
 315
 316       Priv_Mask  : constant := 16#00000003#;
 317
 318       Frame       : aliased CFD;
 319       Code        : System.Address;
 320       J           : Natural := 1;
 321       Pop_Success : Boolean;
 322       Trace       : Tracebacks_Array;
 323       for Trace'Address use Traceback;
 324
 325       --  The backtracing process needs a set of subprograms :
 326
 327       function UWD_For_RLO_Of (Frame : not null access CFD) return UWD_Ptr;
 328       --  Return an access to the unwind descriptor for the caller of
 329       --  a given frame, using only the provided return location.
 330
 331       function UWD_For_Caller_Of (Frame : not null access CFD) return UWD_Ptr;
 332       --  Return an access to the unwind descriptor for the user code caller
 333       --  of a given frame, or null if the information is not available.
 334
 335       function Pop_Frame (Frame : not null access CFD) return Boolean;
 336       --  Update the provided machine state structure so that it reflects
 337       --  the state one call frame "above" the initial one.
 338       --
 339       --  Return True if the operation has been successful, False otherwise.
 340       --  Failure typically occurs when the top of the call stack has been
 341       --  reached.
 342
 343       function Prepare_For_Unwind_Of
 344         (Frame : not null access CFD) return Boolean;
 345       --  Perform the necessary adaptations to the machine state before
 346       --  calling the unwinder. Currently used for the specific case of
 347       --  dynamically sized previous frames.
 348       --
 349       --  Return True if everything went fine, or False otherwise.
 350
 351       Program_UWT : constant UWT := U_get_unwind_table;
 352
 353       ---------------
 354       -- Pop_Frame --
 355       ---------------
 356
 357       function Pop_Frame (Frame : not null access CFD) return Boolean is
 358          Up_Frame    : aliased PFD;
 359          State_Ready : Boolean;
 360
 361       begin
 362          --  Check/adapt the state before calling the unwinder and return
 363          --  if anything went wrong.
 364
 365          State_Ready := Prepare_For_Unwind_Of (Frame);
 366
 367          if not State_Ready then
 368             return False;
 369          end if;
 370
 371          --  Now, safely call the unwinder and use the results
 372
 373          if U_get_previous_frame_x (Frame,
 374                                     Up_Frame'Access,
 375                                     Up_Frame'Size) /= 0
 376          then
 377             return False;
 378          end if;
 379
 380          --  In case a stub is on the way, the usual previous return location
 381          --  (the one in prev_rlo) is the one in the stub and the "real" one
 382          --  is placed in the "current" record, so let's take this one into
 383          --  account.
 384
 385          Frame.out_rlo := Frame.cur_rlo;
 386
 387          Frame.cur_fsz := Up_Frame.prev_fsz;
 388          Frame.cur_sp  := Up_Frame.prev_sp;
 389          Frame.cur_rls := Up_Frame.prev_rls;
 390          Frame.cur_rlo := Up_Frame.prev_rlo;
 391          Frame.cur_dp  := Up_Frame.prev_dp;
 392          Frame.cur_r19 := Up_Frame.prev_r19;
 393          Frame.top_r3  := Up_Frame.top_r3;
 394          Frame.top_r4  := Up_Frame.top_r4;
 395
 396          return True;
 397       end Pop_Frame;
 398
 399       ---------------------------------
 400       -- Prepare_State_For_Unwind_Of --
 401       ---------------------------------
 402
 403       function Prepare_For_Unwind_Of
 404         (Frame : not null access CFD) return Boolean
 405       is
 406          Caller_UWD    : UWD_Ptr;
 407          FP_Adjustment : Integer;
 408
 409       begin
 410          --  No need to bother doing anything if the stack is already fully
 411          --  unwound.
 412
 413          if Frame.cur_rlo = 0 then
 414             return False;
 415          end if;
 416
 417          --  When ALLOCA_FRAME is set in an unwind descriptor, the unwinder
 418          --  uses the value provided in current.top_r3 or current.top_r4 as
 419          --  a frame pointer to compute the size of the frame. What decides
 420          --  between r3 or r4 is the unwind descriptor LARGE_FRAME bit, with
 421          --  r4 chosen if the bit is set.
 422
 423          --  The size computed by the unwinder is STATIC_PART + (SP - FP),
 424          --  which is correct with HP's frame pointer convention, but not
 425          --  with GCC's one since we end up with the static part accounted
 426          --  for twice.
 427
 428          --  We have to compute r4 when it is required because the unwinder
 429          --  has looked for it at a place where it was not if we went through
 430          --  GCC frames.
 431
 432          --  The size of the static part of a frame can be found in the
 433          --  associated unwind descriptor.
 434
 435          Caller_UWD := UWD_For_Caller_Of (Frame);
 436
 437          --  If we cannot get it, we are unable to compute the potentially
 438          --  necessary adjustments. We'd better not try to go on then.
 439
 440          if Caller_UWD = null then
 441             return False;
 442          end if;
 443
 444          --  If the caller frame is a GCC one, r3 is its frame pointer and
 445          --  points to the bottom of the frame. The value to provide for r4
 446          --  can then be computed directly from the one of r3, compensating
 447          --  for the static part of the frame.
 448
 449          --  If the caller frame is an HP one, r3 is used to locate the
 450          --  previous frame marker, that is it also points to the bottom of
 451          --  the frame (this is why r3 cannot be used as the frame pointer in
 452          --  the HP sense for large frames). The value to provide for r4 can
 453          --  then also be computed from the one of r3 with the compensation
 454          --  for the static part of the frame.
 455
 456          FP_Adjustment := Integer (Caller_UWD.frame_size * 8);
 457          Frame.top_r4  := Address (Integer (Frame.top_r3) + FP_Adjustment);
 458
 459          return True;
 460       end Prepare_For_Unwind_Of;
 461
 462       -----------------------
 463       -- UWD_For_Caller_Of --
 464       -----------------------
 465
 466       function UWD_For_Caller_Of (Frame : not null access CFD) return UWD_Ptr
 467       is
 468          UWD_Access : UWD_Ptr;
 469
 470       begin
 471          --  First try the most direct path, using the return location data
 472          --  associated with the frame.
 473
 474          UWD_Access := UWD_For_RLO_Of (Frame);
 475
 476          if UWD_Access /= null then
 477             return UWD_Access;
 478          end if;
 479
 480          --  If we did not get a result, we might face an in-stub return
 481          --  address. In this case U_get_previous_frame can tell us what the
 482          --  first not-in-stub return point is. We cannot call it directly,
 483          --  though, because we haven't computed the potentially necessary
 484          --  frame pointer adjustments, which might lead to SEGV in some
 485          --  circumstances. Instead, we directly call the libcl routine which
 486          --  is called by U_get_previous_frame and which only requires few
 487          --  information. Take care, however, that the information is provided
 488          --  in the "current" argument, so we need to work on a copy to avoid
 489          --  disturbing our caller.
 490
 491          declare
 492             U_Current  : aliased CFD := Frame.all;
 493             U_Previous : aliased PFD;
 494
 495          begin
 496             U_Previous.prev_dp  := U_Current.cur_dp;
 497             U_Previous.prev_rls := U_Current.cur_rls;
 498             U_Previous.prev_sp  := U_Current.cur_sp - U_Current.cur_fsz;
 499
 500             if U_get_u_rlo (U_Current'Access, U_Previous'Access) /= -1 then
 501                UWD_Access := UWD_For_RLO_Of (U_Current'Access);
 502             end if;
 503          end;
 504
 505          return UWD_Access;
 506       end UWD_For_Caller_Of;
 507
 508       --------------------
 509       -- UWD_For_RLO_Of --
 510       --------------------
 511
 512       function UWD_For_RLO_Of (Frame : not null access CFD) return UWD_Ptr
 513       is
 514          UWD_Address : Address;
 515
 516          --  The addresses returned by the library point to full descriptors
 517          --  including the frame information bits but also the applicable PC
 518          --  range. We need to account for this.
 519
 520          Frame_Info_Offset  : constant := 8;
 521
 522       begin
 523          --  First try to locate the descriptor in the program's unwind table
 524
 525          UWD_Address := U_get_unwind_entry (Frame.cur_rlo,
 526                                             Frame.cur_rls,
 527                                             Program_UWT.Table_Start,
 528                                             Program_UWT.Table_End);
 529
 530          --  If we did not get it, we might have a frame from code in a
 531          --  stub or shared library. For code in stub we would have to
 532          --  compute the first non-stub return location but this is not
 533          --  the role of this subprogram, so let's just try to see if we
 534          --  can get a result from the tables in shared libraries.
 535
 536          if UWD_Address = -1
 537            and then U_is_shared_pc (Frame.cur_rlo, Frame.cur_r19) /= 0
 538          then
 539             declare
 540                Shlib_UWT   : constant UWT     :=
 541                                U_get_shLib_unwind_table (Frame.cur_r19);
 542                Shlib_Start : constant Address :=
 543                                U_get_shLib_text_addr (Frame.cur_r19);
 544                Rlo_Offset  : constant Address :=
 545                                Frame.cur_rlo - Shlib_Start;
 546             begin
 547                UWD_Address := U_get_unwind_entry (Rlo_Offset,
 548                                                   Frame.cur_rls,
 549                                                   Shlib_UWT.Table_Start,
 550                                                   Shlib_UWT.Table_End);
 551             end;
 552          end if;
 553
 554          if UWD_Address /= -1 then
 555             return To_UWD_Access (UWD_Address + Frame_Info_Offset);
 556          else
 557             return null;
 558          end if;
 559       end UWD_For_RLO_Of;
 560
 561    --  Start of processing for Call_Chain
 562
 563    begin
 564       --  Fetch the state for this subprogram's frame and pop it so that we
 565       --  start with an initial out_rlo "here".
 566
 567       U_init_frame_record (Frame'Access);
 568       Frame.top_sr0 := 0;
 569       Frame.top_sr4 := 0;
 570
 571       U_prep_frame_rec_for_unwind (Frame'Access);
 572
 573       Pop_Success := Pop_Frame (Frame'Access);
 574
 575       --  Skip the requested number of frames
 576
 577       for I in 1 .. Skip_Frames loop
 578          Pop_Success := Pop_Frame (Frame'Access);
 579       end loop;
 580
 581       --  Loop popping frames and storing locations until either a problem
 582       --  occurs, or the top of the call chain is reached, or the provided
 583       --  array is full.
 584
 585       loop
 586          --  We have to test some conditions against the return location
 587          --  as it is returned, so get it as is first.
 588
 589          Code := Frame.out_rlo;
 590
 591          exit when not Pop_Success or else Code = 0 or else J = Max_Len + 1;
 592
 593          --  Compute the call point from the retrieved return location :
 594          --  Mask the privilege bits and account for the delta between the
 595          --  call site and the return point.
 596
 597          Code := (Code and not Priv_Mask) - Rlo_Offset;
 598
 599          if Code < Exclude_Min or else Code > Exclude_Max then
 600             Trace (J) := Code;
 601             J := J + 1;
 602          end if;
 603
 604          Pop_Success := Pop_Frame (Frame'Access);
 605       end loop;
 606
 607       Len := J - 1;
 608    end Call_Chain;
 609
 610    procedure Call_Chain
 611      (Traceback   : in out System.Traceback_Entries.Tracebacks_Array;
 612       Max_Len     : Natural;
 613       Len         : out Natural;
 614       Exclude_Min : System.Address := System.Null_Address;
 615       Exclude_Max : System.Address := System.Null_Address;
 616       Skip_Frames : Natural := 1)
 617    is
 618    begin
 619       Call_Chain
 620         (Traceback'Address, Max_Len, Len,
 621          Exclude_Min, Exclude_Max,
 622
 623          --  Skip one extra frame to skip the other Call_Chain entry as well
 624
 625          Skip_Frames => Skip_Frames + 1);
 626    end Call_Chain;
 627
 628 end System.Traceback;