gcc/ada/libgnat/s-trasym__dwarf.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --           S Y S T E M . T R A C E B A C K . S Y M B O L I C              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1999-2023, AdaCore                     --
  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 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  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 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 --  Run-time symbolic traceback support for targets using DWARF debug data
  33
  34 with Ada.Unchecked_Deallocation;
  35
  36 with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
  37 with Ada.Containers.Generic_Array_Sort;
  38
  39 with System.Address_To_Access_Conversions;
  40 with System.Soft_Links;
  41 with System.CRTL;
  42 with System.Dwarf_Lines;
  43 with System.Exception_Traces;
  44 with System.Standard_Library;
  45 with System.Traceback_Entries;
  46 with System.Strings;
  47 with System.Bounded_Strings;
  48
  49 package body System.Traceback.Symbolic is
  50
  51    use System.Bounded_Strings;
  52    use System.Dwarf_Lines;
  53
  54    subtype Big_String is String (Positive);
  55    --  To deal with C strings
  56
  57    package Big_String_Conv is new System.Address_To_Access_Conversions
  58      (Big_String);
  59
  60    type Module_Cache;
  61    type Module_Cache_Acc is access all Module_Cache;
  62
  63    type Module_Cache is record
  64       Name : Strings.String_Access;
  65       --  Name of the module
  66
  67       C : Dwarf_Context (In_Exception => True);
  68       --  Context to symbolize an address within this module
  69
  70       Chain : Module_Cache_Acc;
  71    end record;
  72
  73    procedure Free is new Ada.Unchecked_Deallocation
  74      (Module_Cache,
  75       Module_Cache_Acc);
  76
  77    Cache_Chain : Module_Cache_Acc;
  78    --  Simply linked list of modules
  79
  80    type Module_Array is array (Natural range <>) of Module_Cache_Acc;
  81    type Module_Array_Acc is access Module_Array;
  82
  83    Modules_Cache : Module_Array_Acc;
  84    --  Sorted array of cached modules (if not null)
  85
  86    Exec_Module : aliased Module_Cache;
  87    --  Context for the executable
  88
  89    type Init_State is (Uninitialized, Initialized, Failed);
  90    Exec_Module_State : Init_State := Uninitialized;
  91    --  How Exec_Module is initialized
  92
  93    procedure Init_Exec_Module;
  94    --  Initialize Exec_Module if not already initialized
  95
  96    function Symbolic_Traceback
  97      (Traceback    : System.Traceback_Entries.Tracebacks_Array;
  98       Suppress_Hex : Boolean) return String;
  99    function Symbolic_Traceback
 100      (E            : Ada.Exceptions.Exception_Occurrence;
 101       Suppress_Hex : Boolean) return String;
 102    --  Suppress_Hex means do not print any hexadecimal addresses, even if the
 103    --  symbol is not available.
 104
 105    function Lt (Left, Right : Module_Cache_Acc) return Boolean;
 106    --  Sort function for Module_Cache
 107
 108    procedure Init_Module
 109      (Module       : out Module_Cache;
 110       Success      : out Boolean;
 111       Module_Name  :     String;
 112       Load_Address :     Address := Null_Address);
 113    --  Initialize Module
 114
 115    procedure Close_Module (Module : in out Module_Cache);
 116    --  Finalize Module
 117
 118    function Value (Item : System.Address) return String;
 119    --  Return the String contained in Item, up until the first NUL character
 120
 121    pragma Warnings (Off, "*Add_Module_To_Cache*");
 122    procedure Add_Module_To_Cache (Module_Name : String;
 123                                   Load_Address : System.Address);
 124    --  To be called by Build_Cache_For_All_Modules to add a new module to the
 125    --  list. May not be referenced.
 126
 127    package Module_Name is
 128
 129       procedure Build_Cache_For_All_Modules;
 130       --  Create the cache for all current modules
 131
 132       function Get (Addr : System.Address;
 133                     Load_Addr : access System.Address) return String;
 134       --  Returns the module name for the given address Addr, or an empty
 135       --  string for the main executable.  Load_Addr is set to the shared
 136       --  library load address if this information is available, or to
 137       --  System.Null_Address otherwise.
 138
 139       function Is_Supported return Boolean;
 140       pragma Inline (Is_Supported);
 141       --  Returns True if Module_Name is supported, so if the traceback is
 142       --  supported for shared libraries.
 143
 144    end Module_Name;
 145
 146    package body Module_Name is separate;
 147
 148    function Executable_Name return String;
 149    --  Returns the executable name as reported by argv[0]. If gnat_argv not
 150    --  initialized, return an empty string. If the argv[0] executable is not
 151    --  found in the PATH, return it unresolved.
 152
 153    function Get_Executable_Load_Address return System.Address;
 154    pragma Import
 155      (C,
 156       Get_Executable_Load_Address,
 157       "__gnat_get_executable_load_address");
 158    --  Get the load address of the executable, or Null_Address if not known
 159
 160    procedure Hexa_Traceback
 161      (Traceback    :        Tracebacks_Array;
 162       Suppress_Hex :        Boolean;
 163       Res          : in out Bounded_String);
 164    --  Non-symbolic traceback (simply write addresses in hexa)
 165
 166    procedure Symbolic_Traceback_No_Lock
 167      (Traceback    :        Tracebacks_Array;
 168       Suppress_Hex :        Boolean;
 169       Res          : in out Bounded_String);
 170    --  Like the public Symbolic_Traceback_No_Lock except there is no provision
 171    --  against concurrent accesses.
 172
 173    procedure Module_Symbolic_Traceback
 174      (Traceback    :        Tracebacks_Array;
 175       Module       :        Module_Cache;
 176       Suppress_Hex :        Boolean;
 177       Res          : in out Bounded_String);
 178    --  Returns the Traceback for a given module
 179
 180    procedure Multi_Module_Symbolic_Traceback
 181      (Traceback    :        Tracebacks_Array;
 182       Suppress_Hex :        Boolean;
 183       Res          : in out Bounded_String);
 184    --  Build string containing symbolic traceback for the given call chain
 185
 186    procedure Multi_Module_Symbolic_Traceback
 187      (Traceback    :        Tracebacks_Array;
 188       Module       :        Module_Cache;
 189       Suppress_Hex :        Boolean;
 190       Res          : in out Bounded_String);
 191    --  Likewise but using Module
 192
 193    Max_String_Length : constant := 4096;
 194    --  Arbitrary limit on Bounded_Str length
 195
 196    -----------
 197    -- Value --
 198    -----------
 199
 200    function Value (Item : System.Address) return String is
 201    begin
 202       if Item /= Null_Address then
 203          for J in Big_String'Range loop
 204             if Big_String_Conv.To_Pointer (Item) (J) = ASCII.NUL then
 205                return Big_String_Conv.To_Pointer (Item) (1 .. J - 1);
 206             end if;
 207          end loop;
 208       end if;
 209
 210       return "";
 211    end Value;
 212
 213    -------------------------
 214    -- Add_Module_To_Cache --
 215    -------------------------
 216
 217    procedure Add_Module_To_Cache (Module_Name : String;
 218                                   Load_Address : System.Address)
 219    is
 220       Module  : Module_Cache_Acc;
 221       Success : Boolean;
 222    begin
 223       Module := new Module_Cache;
 224       Init_Module (Module.all, Success, Module_Name, Load_Address);
 225       if not Success then
 226          Free (Module);
 227          return;
 228       end if;
 229       Module.Chain := Cache_Chain;
 230       Cache_Chain  := Module;
 231    end Add_Module_To_Cache;
 232
 233    ----------------------
 234    -- Init_Exec_Module --
 235    ----------------------
 236
 237    procedure Init_Exec_Module is
 238    begin
 239       if Exec_Module_State = Uninitialized then
 240          declare
 241             Exec_Path : constant String  := Executable_Name;
 242             Exec_Load : constant Address := Get_Executable_Load_Address;
 243             Success   : Boolean;
 244          begin
 245             Init_Module (Exec_Module, Success, Exec_Path, Exec_Load);
 246
 247             if Success then
 248                Exec_Module_State := Initialized;
 249             else
 250                Exec_Module_State := Failed;
 251             end if;
 252          end;
 253       end if;
 254    end Init_Exec_Module;
 255
 256    --------
 257    -- Lt --
 258    --------
 259
 260    function Lt (Left, Right : Module_Cache_Acc) return Boolean is
 261    begin
 262       return Low_Address (Left.C) < Low_Address (Right.C);
 263    end Lt;
 264
 265    -----------------------------
 266    -- Module_Cache_Array_Sort --
 267    -----------------------------
 268
 269    procedure Module_Cache_Array_Sort is new Ada.Containers.Generic_Array_Sort
 270      (Natural,
 271       Module_Cache_Acc,
 272       Module_Array,
 273       Lt);
 274
 275    ------------------
 276    -- Enable_Cache --
 277    ------------------
 278
 279    procedure Enable_Cache (Include_Modules : Boolean := False) is
 280    begin
 281       --  Can be called at most once
 282       if Cache_Chain /= null then
 283          return;
 284       end if;
 285
 286       --  Add all modules
 287       Init_Exec_Module;
 288
 289       if Exec_Module_State = Failed then
 290          raise Program_Error with
 291            "cannot enable cache, executable state initialization failed.";
 292       end if;
 293
 294       Cache_Chain := Exec_Module'Access;
 295
 296       if Include_Modules then
 297          Module_Name.Build_Cache_For_All_Modules;
 298       end if;
 299
 300       --  Build and fill the array of modules
 301       declare
 302          Count  : Natural;
 303          Module : Module_Cache_Acc;
 304       begin
 305          for Phase in 1 .. 2 loop
 306             Count  := 0;
 307             Module := Cache_Chain;
 308             while Module /= null loop
 309                Count := Count + 1;
 310
 311                if Phase = 1 then
 312                   Enable_Cache (Module.C);
 313                else
 314                   Modules_Cache (Count) := Module;
 315                end if;
 316                Module := Module.Chain;
 317             end loop;
 318
 319             if Phase = 1 then
 320                Modules_Cache := new Module_Array (1 .. Count);
 321             end if;
 322          end loop;
 323       end;
 324
 325       --  Sort the array
 326       Module_Cache_Array_Sort (Modules_Cache.all);
 327    end Enable_Cache;
 328
 329    ---------------------
 330    -- Executable_Name --
 331    ---------------------
 332
 333    function Executable_Name return String is
 334       --  We have to import gnat_argv as an Address to match the type of
 335       --  gnat_argv in the binder generated file. Otherwise, we get spurious
 336       --  warnings about type mismatch when LTO is turned on.
 337
 338       Gnat_Argv : System.Address;
 339       pragma Import (C, Gnat_Argv, "gnat_argv");
 340
 341       type Argv_Array is array (0 .. 0) of System.Address;
 342       package Conv is new System.Address_To_Access_Conversions (Argv_Array);
 343
 344       function locate_exec_on_path (A : System.Address) return System.Address;
 345       pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
 346
 347    begin
 348       if Gnat_Argv = Null_Address then
 349          return "";
 350       end if;
 351
 352       --  See if we can resolve argv[0] to a full path (to a file that we will
 353       --  be able to open). If the resolution fails, we were probably spawned
 354       --  by an imprecise exec call, typically passing a mere file name as
 355       --  argv[0] for a program in the current directory with '.' not on PATH.
 356       --  Best we can do is fallback to argv[0] unchanged in this case. If we
 357       --  fail opening that downstream, we'll just bail out.
 358
 359       declare
 360          Argv0 : constant System.Address
 361            := Conv.To_Pointer (Gnat_Argv) (0);
 362
 363          Resolved_Argv0 : constant System.Address
 364            := locate_exec_on_path (Argv0);
 365
 366          Exe_Argv : constant System.Address
 367            := (if Resolved_Argv0 /= System.Null_Address
 368                then Resolved_Argv0
 369                else Argv0);
 370
 371          Result : constant String := Value (Exe_Argv);
 372
 373       begin
 374          --  The buffer returned by locate_exec_on_path was allocated using
 375          --  malloc and we should release this memory.
 376
 377          if Resolved_Argv0 /= Null_Address then
 378             System.CRTL.free (Resolved_Argv0);
 379          end if;
 380
 381          return Result;
 382       end;
 383    end Executable_Name;
 384
 385    ------------------
 386    -- Close_Module --
 387    ------------------
 388
 389    procedure Close_Module (Module : in out Module_Cache) is
 390    begin
 391       Close (Module.C);
 392       Strings.Free (Module.Name);
 393    end Close_Module;
 394
 395    -----------------
 396    -- Init_Module --
 397    -----------------
 398
 399    procedure Init_Module
 400      (Module       : out Module_Cache;
 401       Success      : out Boolean;
 402       Module_Name  :     String;
 403       Load_Address :     Address := Null_Address)
 404    is
 405    begin
 406       --  Early return if the module is not known
 407
 408       if Module_Name = "" then
 409          Success := False;
 410          return;
 411       end if;
 412
 413       Open (Module_Name, Module.C, Success);
 414
 415       --  If a module can't be opened just return now, we just cannot give more
 416       --  information in this case.
 417
 418       if not Success then
 419          return;
 420       end if;
 421
 422       Set_Load_Address (Module.C, Load_Address);
 423
 424       Module.Name := new String'(Module_Name);
 425    end Init_Module;
 426
 427    -------------------------------
 428    -- Module_Symbolic_Traceback --
 429    -------------------------------
 430
 431    procedure Module_Symbolic_Traceback
 432      (Traceback    :        Tracebacks_Array;
 433       Module       :        Module_Cache;
 434       Suppress_Hex :        Boolean;
 435       Res          : in out Bounded_String)
 436    is
 437       Success : Boolean;
 438    begin
 439       if Symbolic.Module_Name.Is_Supported then
 440          Append (Res, '[');
 441          Append (Res, Module.Name.all);
 442          Append (Res, ']' & ASCII.LF);
 443       end if;
 444
 445       Dwarf_Lines.Symbolic_Traceback
 446         (Module.C,
 447          Traceback,
 448          Suppress_Hex,
 449          Success,
 450          Res);
 451
 452       if not Success then
 453          Hexa_Traceback (Traceback, Suppress_Hex, Res);
 454       end if;
 455
 456       --  We must not allow an unhandled exception here, since this function
 457       --  may be installed as a decorator for all automatic exceptions.
 458
 459    exception
 460       when others =>
 461          return;
 462    end Module_Symbolic_Traceback;
 463
 464    -------------------------------------
 465    -- Multi_Module_Symbolic_Traceback --
 466    -------------------------------------
 467
 468    procedure Multi_Module_Symbolic_Traceback
 469      (Traceback    :        Tracebacks_Array;
 470       Suppress_Hex :        Boolean;
 471       Res          : in out Bounded_String)
 472    is
 473       F : constant Natural := Traceback'First;
 474    begin
 475       if Traceback'Length = 0 or else Is_Full (Res) then
 476          return;
 477       end if;
 478
 479       if Modules_Cache /= null then
 480          --  Search in the cache
 481
 482          declare
 483             Addr        : constant Address := Traceback (F);
 484             Hi, Lo, Mid : Natural;
 485          begin
 486             Lo := Modules_Cache'First;
 487             Hi := Modules_Cache'Last;
 488             while Lo <= Hi loop
 489                Mid := (Lo + Hi) / 2;
 490                if Addr < Low_Address (Modules_Cache (Mid).C) then
 491                   Hi := Mid - 1;
 492                elsif Is_Inside (Modules_Cache (Mid).C, Addr) then
 493                   Multi_Module_Symbolic_Traceback
 494                     (Traceback,
 495                      Modules_Cache (Mid).all,
 496                      Suppress_Hex,
 497                      Res);
 498                   return;
 499                else
 500                   Lo := Mid + 1;
 501                end if;
 502             end loop;
 503
 504             --  Not found
 505             Hexa_Traceback (Traceback (F .. F), Suppress_Hex, Res);
 506             Multi_Module_Symbolic_Traceback
 507               (Traceback (F + 1 .. Traceback'Last),
 508                Suppress_Hex,
 509                Res);
 510          end;
 511       else
 512
 513          --  First try the executable
 514          if Is_Inside (Exec_Module.C, Traceback (F)) then
 515             Multi_Module_Symbolic_Traceback
 516               (Traceback,
 517                Exec_Module,
 518                Suppress_Hex,
 519                Res);
 520             return;
 521          end if;
 522
 523          --  Otherwise, try a shared library
 524          declare
 525             Load_Addr : aliased System.Address;
 526             M_Name  : constant String :=
 527               Module_Name.Get (Addr => Traceback (F),
 528                                Load_Addr => Load_Addr'Access);
 529             Module  : Module_Cache;
 530             Success : Boolean;
 531          begin
 532             Init_Module (Module, Success, M_Name, Load_Addr);
 533             if Success then
 534                Multi_Module_Symbolic_Traceback
 535                  (Traceback,
 536                   Module,
 537                   Suppress_Hex,
 538                   Res);
 539                Close_Module (Module);
 540             else
 541                --  Module not found
 542                Hexa_Traceback (Traceback (F .. F), Suppress_Hex, Res);
 543                Multi_Module_Symbolic_Traceback
 544                  (Traceback (F + 1 .. Traceback'Last),
 545                   Suppress_Hex,
 546                   Res);
 547             end if;
 548          end;
 549       end if;
 550    end Multi_Module_Symbolic_Traceback;
 551
 552    procedure Multi_Module_Symbolic_Traceback
 553      (Traceback    :        Tracebacks_Array;
 554       Module       :        Module_Cache;
 555       Suppress_Hex :        Boolean;
 556       Res          : in out Bounded_String)
 557    is
 558       Pos : Positive;
 559    begin
 560       --  Will symbolize the first address...
 561
 562       Pos := Traceback'First + 1;
 563
 564       --  ... and all addresses in the same module
 565
 566       Same_Module :
 567       loop
 568          exit Same_Module when Pos > Traceback'Last;
 569
 570          --  Get address to check for corresponding module name
 571
 572          exit Same_Module when not Is_Inside (Module.C, Traceback (Pos));
 573
 574          Pos := Pos + 1;
 575       end loop Same_Module;
 576
 577       Module_Symbolic_Traceback
 578         (Traceback (Traceback'First .. Pos - 1),
 579          Module,
 580          Suppress_Hex,
 581          Res);
 582       Multi_Module_Symbolic_Traceback
 583         (Traceback (Pos .. Traceback'Last),
 584          Suppress_Hex,
 585          Res);
 586    end Multi_Module_Symbolic_Traceback;
 587
 588    --------------------
 589    -- Hexa_Traceback --
 590    --------------------
 591
 592    procedure Hexa_Traceback
 593      (Traceback    :        Tracebacks_Array;
 594       Suppress_Hex :        Boolean;
 595       Res          : in out Bounded_String)
 596    is
 597       use System.Traceback_Entries;
 598    begin
 599       if Suppress_Hex then
 600          Append (Res, "...");
 601          Append (Res, ASCII.LF);
 602       else
 603          for J in Traceback'Range loop
 604             Append_Address (Res, PC_For (Traceback (J)));
 605             Append (Res, ASCII.LF);
 606          end loop;
 607       end if;
 608    end Hexa_Traceback;
 609
 610    --------------------------------
 611    -- Symbolic_Traceback_No_Lock --
 612    --------------------------------
 613
 614    procedure Symbolic_Traceback_No_Lock
 615      (Traceback    :        Tracebacks_Array;
 616       Suppress_Hex :        Boolean;
 617       Res          : in out Bounded_String)
 618    is
 619    begin
 620       if Symbolic.Module_Name.Is_Supported then
 621          Multi_Module_Symbolic_Traceback (Traceback, Suppress_Hex, Res);
 622       else
 623          if Exec_Module_State = Failed then
 624             Append (Res, "Call stack traceback locations:" & ASCII.LF);
 625             Hexa_Traceback (Traceback, Suppress_Hex, Res);
 626          else
 627             Module_Symbolic_Traceback
 628               (Traceback,
 629                Exec_Module,
 630                Suppress_Hex,
 631                Res);
 632          end if;
 633       end if;
 634    end Symbolic_Traceback_No_Lock;
 635
 636    ------------------------
 637    -- Symbolic_Traceback --
 638    ------------------------
 639
 640    function Symbolic_Traceback
 641      (Traceback    : Tracebacks_Array;
 642       Suppress_Hex : Boolean) return String
 643    is
 644       Res : Bounded_String (Max_Length => Max_String_Length);
 645    begin
 646       System.Soft_Links.Lock_Task.all;
 647       Init_Exec_Module;
 648       Symbolic_Traceback_No_Lock (Traceback, Suppress_Hex, Res);
 649       System.Soft_Links.Unlock_Task.all;
 650
 651       return To_String (Res);
 652
 653    exception
 654       when others =>
 655          System.Soft_Links.Unlock_Task.all;
 656          raise;
 657    end Symbolic_Traceback;
 658
 659    function Symbolic_Traceback
 660      (Traceback : System.Traceback_Entries.Tracebacks_Array) return String is
 661    begin
 662       return Symbolic_Traceback (Traceback, Suppress_Hex => False);
 663    end Symbolic_Traceback;
 664
 665    function Symbolic_Traceback_No_Hex
 666      (Traceback : System.Traceback_Entries.Tracebacks_Array) return String is
 667    begin
 668       return Symbolic_Traceback (Traceback, Suppress_Hex => True);
 669    end Symbolic_Traceback_No_Hex;
 670
 671    function Symbolic_Traceback
 672      (E            : Ada.Exceptions.Exception_Occurrence;
 673       Suppress_Hex : Boolean) return String
 674    is
 675    begin
 676       return Symbolic_Traceback
 677           (Ada.Exceptions.Traceback.Tracebacks (E),
 678            Suppress_Hex);
 679    end Symbolic_Traceback;
 680
 681    function Symbolic_Traceback
 682      (E : Ada.Exceptions.Exception_Occurrence) return String
 683    is
 684    begin
 685       return Symbolic_Traceback (E, Suppress_Hex => False);
 686    end Symbolic_Traceback;
 687
 688    function Symbolic_Traceback_No_Hex
 689      (E : Ada.Exceptions.Exception_Occurrence) return String is
 690    begin
 691       return Symbolic_Traceback (E, Suppress_Hex => True);
 692    end Symbolic_Traceback_No_Hex;
 693
 694    Exception_Tracebacks_Symbolic : constant Integer;
 695    pragma Import
 696      (C,
 697       Exception_Tracebacks_Symbolic,
 698       "__gl_exception_tracebacks_symbolic");
 699    --  Boolean indicating whether symbolic tracebacks should be generated.
 700
 701    use Standard_Library;
 702 begin
 703    --  If this version of this package is available, and the binder switch -Es
 704    --  was given, then we want to use this as the decorator by default, and we
 705    --  want to turn on tracing for Unhandled_Raise_In_Main. Note that the user
 706    --  cannot have already set Exception_Trace, because the runtime library is
 707    --  elaborated before user-defined code.
 708
 709    if Exception_Tracebacks_Symbolic /= 0 then
 710       Exception_Traces.Set_Trace_Decorator (Symbolic_Traceback'Access);
 711       pragma Assert (Exception_Trace = RM_Convention);
 712       Exception_Trace := Unhandled_Raise_In_Main;
 713    end if;
 714 end System.Traceback.Symbolic;