1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- ADA.EXCEPTIONS.EXCEPTION_PROPAGATION -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2003 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 2, 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. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from this -- 23-- unit, or you link this unit with other files to produce an executable, -- 24-- this unit does not by itself cause the resulting executable to be -- 25-- covered by the GNU General Public License. This exception does not -- 26-- however invalidate any other reasons why the executable file might be -- 27-- covered by the GNU Public License. -- 28-- -- 29-- GNAT was originally developed by the GNAT team at New York University. -- 30-- Extensive contributions were provided by Ada Core Technologies Inc. -- 31-- -- 32------------------------------------------------------------------------------ 33 34with Interfaces; 35 36with Ada.Unchecked_Conversion; 37with Ada.Unchecked_Deallocation; 38 39pragma Warnings (Off); 40-- Since several constructs give warnings in 3.14a1, including unreferenced 41-- variables and pragma Unreferenced itself. 42 43separate (Ada.Exceptions) 44package body Exception_Propagation is 45 46 ------------------------------------------------ 47 -- Entities to interface with the GCC runtime -- 48 ------------------------------------------------ 49 50 -- These come from "C++ ABI for Itanium: Exception handling", which is 51 -- the reference for GCC. They are used only when we are relying on 52 -- back-end tables for exception propagation, which in turn is currenly 53 -- only the case for Zero_Cost_Exceptions in GNAT5. 54 55 -- Return codes from the GCC runtime functions used to propagate 56 -- an exception. 57 58 type Unwind_Reason_Code is 59 (URC_NO_REASON, 60 URC_FOREIGN_EXCEPTION_CAUGHT, 61 URC_PHASE2_ERROR, 62 URC_PHASE1_ERROR, 63 URC_NORMAL_STOP, 64 URC_END_OF_STACK, 65 URC_HANDLER_FOUND, 66 URC_INSTALL_CONTEXT, 67 URC_CONTINUE_UNWIND); 68 69 pragma Unreferenced 70 (URC_FOREIGN_EXCEPTION_CAUGHT, 71 URC_PHASE2_ERROR, 72 URC_PHASE1_ERROR, 73 URC_NORMAL_STOP, 74 URC_END_OF_STACK, 75 URC_HANDLER_FOUND, 76 URC_INSTALL_CONTEXT, 77 URC_CONTINUE_UNWIND); 78 79 pragma Convention (C, Unwind_Reason_Code); 80 81 -- Phase identifiers 82 83 type Unwind_Action is 84 (UA_SEARCH_PHASE, 85 UA_CLEANUP_PHASE, 86 UA_HANDLER_FRAME, 87 UA_FORCE_UNWIND); 88 89 for Unwind_Action use 90 (UA_SEARCH_PHASE => 1, 91 UA_CLEANUP_PHASE => 2, 92 UA_HANDLER_FRAME => 4, 93 UA_FORCE_UNWIND => 8); 94 95 pragma Convention (C, Unwind_Action); 96 97 -- Mandatory common header for any exception object handled by the 98 -- GCC unwinding runtime. 99 100 subtype Exception_Class is Interfaces.Unsigned_64; 101 102 GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#; 103 -- "GNU-Ada\0" 104 105 type Unwind_Exception is record 106 Class : Exception_Class := GNAT_Exception_Class; 107 Cleanup : System.Address := System.Null_Address; 108 Private1 : Integer; 109 Private2 : Integer; 110 end record; 111 112 pragma Convention (C, Unwind_Exception); 113 114 for Unwind_Exception'Alignment use Standard'Maximum_Alignment; 115 -- The C++ ABI mandates the common exception header to be at least 116 -- doubleword aligned, and the libGCC implementation actually makes it 117 -- maximally aligned (see unwind.h). We need to match this because: 118 119 -- 1/ We pass pointers to such headers down to the underlying 120 -- libGCC unwinder, 121 122 -- and 123 124 -- 2/ The GNAT_GCC_Exception record below starts with this common 125 -- common header and has a C counterpart which needs to be laid 126 -- out identically in raise.c. If the alignment of the C and Ada 127 -- common headers mismatch, their size may also differ, and the 128 -- layouts may not match anymore. 129 130 --------------------------------------------------------------- 131 -- GNAT specific entities to deal with the GCC eh circuitry -- 132 --------------------------------------------------------------- 133 134 -- A GNAT exception object to be dealt with by the personality routine 135 -- called by the GCC unwinding runtime. This structure shall match the 136 -- one in raise.c and is currently experimental as it might be merged 137 -- with the GNAT runtime definition some day. 138 139 type GNAT_GCC_Exception is record 140 Header : Unwind_Exception; 141 -- ABI Exception header first. 142 143 Id : Exception_Id; 144 -- GNAT Exception identifier. This is used by the personality 145 -- routine to determine if the context it examines contains a 146 -- handler for the exception beeing propagated. 147 148 Handled_By_Others : Boolean; 149 -- Is this exception handled by "when others" ? This is used by the 150 -- personality routine to determine if an "others" handler in the 151 -- context it examines may catch the exception beeing propagated. 152 153 N_Cleanups_To_Trigger : Integer; 154 -- Number of cleanup only frames encountered in SEARCH phase. 155 -- This is used to control the forced unwinding triggered when 156 -- no handler has been found. 157 158 Next_Exception : EOA; 159 -- Used to create a linked list of exception occurrences. 160 end record; 161 162 pragma Convention (C, GNAT_GCC_Exception); 163 164 type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception; 165 166 function To_GNAT_GCC_Exception is new 167 Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access); 168 169 procedure Free is new Unchecked_Deallocation 170 (GNAT_GCC_Exception, GNAT_GCC_Exception_Access); 171 172 procedure Free is new Unchecked_Deallocation 173 (Exception_Occurrence, EOA); 174 175 function Remove 176 (Top : EOA; 177 Excep : GNAT_GCC_Exception_Access) 178 return Boolean; 179 -- Remove Excep from the stack starting at Top. 180 -- Return True if Excep was found and removed, false otherwise. 181 182 -- Hooks called when entering/leaving an exception handler for a given 183 -- occurrence, aimed at handling the stack of active occurrences. The 184 -- calls are generated by gigi in tree_transform/N_Exception_Handler. 185 186 procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access); 187 pragma Export (C, Begin_Handler, "__gnat_begin_handler"); 188 189 procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access); 190 pragma Export (C, End_Handler, "__gnat_end_handler"); 191 192 function CleanupUnwind_Handler 193 (UW_Version : Integer; 194 UW_Phases : Unwind_Action; 195 UW_Eclass : Exception_Class; 196 UW_Exception : access GNAT_GCC_Exception; 197 UW_Context : System.Address; 198 UW_Argument : System.Address) 199 return Unwind_Reason_Code; 200 -- Hook called at each step of the forced unwinding we perform to 201 -- trigger cleanups found during the propagation of an unhandled 202 -- exception. 203 204 -- GCC runtime functions used. These are C non-void functions, actually, 205 -- but we ignore the return values. See raise.c as to why we are using 206 -- __gnat stubs for these. 207 208 procedure Unwind_RaiseException 209 (UW_Exception : access GNAT_GCC_Exception); 210 pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException"); 211 212 procedure Unwind_ForcedUnwind 213 (UW_Exception : access GNAT_GCC_Exception; 214 UW_Handler : System.Address; 215 UW_Argument : System.Address); 216 pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind"); 217 218 ------------ 219 -- Remove -- 220 ------------ 221 222 function Remove 223 (Top : EOA; 224 Excep : GNAT_GCC_Exception_Access) 225 return Boolean 226 is 227 Prev : GNAT_GCC_Exception_Access := null; 228 Iter : EOA := Top; 229 GCC_Exception : GNAT_GCC_Exception_Access; 230 231 begin 232 -- Pop stack 233 234 loop 235 pragma Assert (Iter.Private_Data /= System.Null_Address); 236 237 GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data); 238 239 if GCC_Exception = Excep then 240 if Prev = null then 241 242 -- Special case for the top of the stack: shift the contents 243 -- of the next item to the top, since top is at a fixed 244 -- location and can't be changed. 245 246 Iter := GCC_Exception.Next_Exception; 247 248 if Iter = null then 249 250 -- Stack is now empty 251 252 Top.Private_Data := System.Null_Address; 253 254 else 255 Save_Occurrence_And_Private (Top.all, Iter.all); 256 Free (Iter); 257 end if; 258 259 else 260 Prev.Next_Exception := GCC_Exception.Next_Exception; 261 Free (Iter); 262 end if; 263 264 Free (GCC_Exception); 265 266 return True; 267 end if; 268 269 exit when GCC_Exception.Next_Exception = null; 270 271 Prev := GCC_Exception; 272 Iter := GCC_Exception.Next_Exception; 273 end loop; 274 275 return False; 276 end Remove; 277 278 --------------------------- 279 -- CleanupUnwind_Handler -- 280 --------------------------- 281 282 function CleanupUnwind_Handler 283 (UW_Version : Integer; 284 UW_Phases : Unwind_Action; 285 UW_Eclass : Exception_Class; 286 UW_Exception : access GNAT_GCC_Exception; 287 UW_Context : System.Address; 288 UW_Argument : System.Address) 289 return Unwind_Reason_Code 290 is 291 begin 292 -- Terminate as soon as we know there is nothing more to run. The 293 -- count is maintained by the personality routine. 294 295 if UW_Exception.N_Cleanups_To_Trigger = 0 then 296 Unhandled_Exception_Terminate; 297 end if; 298 299 -- We know there is at least one cleanup further up. Return so that it 300 -- is searched and entered, after which Unwind_Resume will be called 301 -- and this hook will gain control (with an updated count) again. 302 303 return URC_NO_REASON; 304 end CleanupUnwind_Handler; 305 306 --------------------- 307 -- Setup_Exception -- 308 --------------------- 309 310 -- Push the current exception occurrence on the stack before overriding it. 311 312 procedure Setup_Exception 313 (Excep : EOA; 314 Current : EOA; 315 Reraised : Boolean := False) 316 is 317 Top : constant EOA := Current; 318 Next : EOA; 319 GCC_Exception : GNAT_GCC_Exception_Access; 320 321 -- Note that we make no use of the Reraised indication at this point. 322 323 -- The information is still passed around just in case of future needs, 324 -- since we've already switched between using/not-using it a number of 325 -- times. 326 327 begin 328 -- If the current exception is not live, the stack is empty and there 329 -- is nothing to do. Note that the stack always appears empty for 330 -- mechanisms that do not require one. For the mechanism we implement 331 -- in this unit, the initial Private_Data allocation for an occurrence 332 -- is issued by Propagate_Exception. 333 334 if Top.Private_Data = System.Null_Address then 335 return; 336 end if; 337 338 -- Shift the contents of the Top of the stack in a freshly allocated 339 -- entry, which leaves the room in the fixed Top entry available for the 340 -- occurrence about to be propagated. 341 342 Next := new Exception_Occurrence; 343 Save_Occurrence_And_Private (Next.all, Top.all); 344 345 -- Allocate Private_Data for the occurrence about to be propagated 346 -- and link everything together. 347 348 GCC_Exception := new GNAT_GCC_Exception; 349 GCC_Exception.Next_Exception := Next; 350 351 Top.Private_Data := GCC_Exception.all'Address; 352 353 end Setup_Exception; 354 355 ------------------- 356 -- Begin_Handler -- 357 ------------------- 358 359 procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is 360 begin 361 -- Every necessary operation related to the occurrence stack has 362 -- already been performed by Propagate_Exception. This hook remains for 363 -- potential future necessity in optimizing the overall scheme, as well 364 -- a useful debugging tool. 365 null; 366 end Begin_Handler; 367 368 ----------------- 369 -- End_Handler -- 370 ----------------- 371 372 procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is 373 Removed : Boolean; 374 375 begin 376 Removed := Remove (Get_Current_Excep.all, GCC_Exception); 377 pragma Assert (Removed); 378 end End_Handler; 379 380 ------------------------- 381 -- Propagate_Exception -- 382 ------------------------- 383 384 -- Build an object suitable for the libgcc processing and call 385 -- Unwind_RaiseException to actually throw, taking care of handling 386 -- the two phase scheme it implements. 387 388 procedure Propagate_Exception (From_Signal_Handler : Boolean) is 389 Excep : EOA := Get_Current_Excep.all; 390 GCC_Exception : GNAT_GCC_Exception_Access; 391 392 begin 393 if Excep.Private_Data = System.Null_Address then 394 GCC_Exception := new GNAT_GCC_Exception; 395 Excep.Private_Data := GCC_Exception.all'Address; 396 else 397 GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data); 398 end if; 399 400 -- Fill in the useful flags for the personality routine called for each 401 -- frame via Unwind_RaiseException below. 402 403 GCC_Exception.Id := Excep.Id; 404 GCC_Exception.Handled_By_Others := not Excep.Id.Not_Handled_By_Others; 405 GCC_Exception.N_Cleanups_To_Trigger := 0; 406 407 -- Compute the backtrace for this occurrence if the corresponding 408 -- binder option has been set. Call_Chain takes care of the reraise 409 -- case. 410 411 -- ??? Using Call_Chain here means we are going to walk up the stack 412 -- once only for backtracing purposes before doing it again for the 413 -- propagation per se. 414 415 -- The first inspection is much lighter, though, as it only requires 416 -- partial unwinding of each frame. Additionally, although we could use 417 -- the personality routine to record the addresses while propagating, 418 -- this method has two drawbacks: 419 420 -- 1) the trace is incomplete if the exception is handled since we 421 -- don't walk past the frame with the handler, 422 423 -- and 424 425 -- 2) we would miss the frames for which our personality routine is not 426 -- called, e.g. if C or C++ calls are on the way. 427 428 Call_Chain (Excep); 429 430 -- Perform a standard raise first. If a regular handler is found, it 431 -- will be entered after all the intermediate cleanups have run. If 432 -- there is no regular handler, control will get back to after the 433 -- call, with N_Cleanups_To_Trigger set to the number of frames with 434 -- cleanups found on the way up, and none of these already run. 435 436 Unwind_RaiseException (GCC_Exception); 437 438 -- If we get here we know the exception is not handled, as otherwise 439 -- Unwind_RaiseException arranges for the handler to be entered. Take 440 -- the necessary steps to enable the debugger to gain control while the 441 -- stack is still intact. 442 443 Notify_Unhandled_Exception; 444 445 -- Now, if cleanups have been found, run a forced unwind to trigger 446 -- them. Control should not resume there, as the unwinding hook calls 447 -- Unhandled_Exception_Terminate as soon as the last cleanup has been 448 -- triggered. 449 450 if GCC_Exception.N_Cleanups_To_Trigger /= 0 then 451 Unwind_ForcedUnwind (GCC_Exception, 452 CleanupUnwind_Handler'Address, 453 System.Null_Address); 454 end if; 455 456 -- We get here when there is no handler or cleanup to be run at 457 -- all. The debugger has been notified before the second step above. 458 459 Unhandled_Exception_Terminate; 460 end Propagate_Exception; 461 462 ----------- 463 -- Notes -- 464 ----------- 465 466 -- The current model implemented for the stack of occurrences is a 467 -- simplification of previous attempts, which all prooved to be flawed or 468 -- would have needed significant additional circuitry to be made to work 469 -- correctly. 470 471 -- We now represent every propagation by a new entry on the stack, which 472 -- means that an exception occurrence may appear more than once (e.g. when 473 -- it is reraised during the course of its own handler). 474 475 -- This may seem overcostly compared to the C++ model as implemented in 476 -- the g++ v3 libstd. This is actually understandable when one considers 477 -- the extra variations of possible run-time configurations induced by the 478 -- freedom offered by the Save_Occurrence/Reraise_Occurrence public 479 -- interface. 480 481 -- The basic point is that arranging for an occurrence to always appear at 482 -- most once on the stack requires a way to determine if a given occurence 483 -- is already there, which is not as easy as it might seem. 484 485 -- An attempt was made to use the Private_Data pointer for this purpose. 486 -- It did not work because: 487 488 -- 1/ The Private_Data has to be saved by Save_Occurrence to be usable 489 -- as a key in case of a later reraise, 490 491 -- 2/ There is no easy way to synchronize End_Handler for an occurrence 492 -- and the data attached to potential copies, so these copies may end 493 -- up pointing to stale data. Moreover ... 494 495 -- 3/ The same address may be reused for different occurrences, which 496 -- defeats the idea of using it as a key. 497 498 -- The example below illustrates: 499 500 -- Saved_CE : Exception_Occurrence; 501 -- 502 -- begin 503 -- raise Constraint_Error; 504 -- exception 505 -- when CE: others => 506 -- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA 507 -- end; 508 -- 509 -- <= Saved_CE.PDA is stale (!) 510 -- 511 -- begin 512 -- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!) 513 -- exception 514 -- when others => 515 -- Reraise_Occurrence (Saved_CE); 516 -- end; 517 518 -- Not releasing the Private_Data via End_Handler could be an option, 519 -- but making this to work while still avoiding memory leaks is far 520 -- from trivial. 521 522 -- The current scheme has the advantage of beeing simple, and induces 523 -- extra costs only in reraise cases which is acceptable. 524 525end Exception_Propagation; 526