home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / exp_ch11.adb < prev    next >
Text File  |  1996-09-28  |  3KB  |  75 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                             E X P _ C H 1 1                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.3 $                              --
  10. --                                                                          --
  11. --             Copyright (c) 1992,1993, NYU, All Rights Reserved            --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms  of the GNU  General  Public  License  as  published  by the  Free --
  15. -- Software  Foundation;  either version 2,  or (at your option)  any later --
  16. -- version.  GNAT is distributed  in the hope  that it will be useful,  but --
  17. -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANT- --
  18. -- ABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public --
  19. -- License  for  more details.  You should have received  a copy of the GNU --
  20. -- General Public License along with GNAT;  see file COPYING. If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24. with Atree;   use Atree;
  25. with Einfo;   use Einfo;
  26. with Exp_Ch7; use Exp_Ch7;
  27. with Sinfo;   use Sinfo;
  28. with Sem;     use Sem;
  29. with Nlists;  use Nlists;
  30. with Nmake;   use Nmake;
  31. with Tbuild;  use Tbuild;
  32. with Rtsfind; use Rtsfind;
  33.  
  34. package body Exp_Ch11 is
  35.  
  36.    ---------------------------------------------
  37.    -- Expand_N_Handled_Sequence_Of_Statements --
  38.    ---------------------------------------------
  39.  
  40.    procedure Expand_N_Handled_Sequence_Of_Statements (N : Node_Id) is
  41.       Loc      : constant Source_Ptr := Sloc (N);
  42.       Undefer  : Node_Id;
  43.       Handler  : Node_Id;
  44.       Handlers : constant List_Id := Exception_Handlers (N);
  45.  
  46.    begin
  47.       --  Add a call to Abort_Undefer to the front of all exception handlers.
  48.       --  Abortion is deferred as part of raising an exception, to prevent
  49.       --  cleanup activities from being aborted.
  50.  
  51.       if Present (Handlers) then
  52.          Handler := First (Handlers);
  53.          while Present (Handler) loop
  54.             Undefer :=
  55.               Make_Procedure_Call_Statement (Loc,
  56.                 Name =>
  57.                   New_Reference_To (RTE (RE_Abort_Undefer), Loc),
  58.                 Parameter_Associations => Empty_List);
  59.  
  60.             Prepend_To (Statements (Handler), Undefer);
  61.             Analyze (Undefer);
  62.             Handler := Next (Handler);
  63.          end loop;
  64.       end if;
  65.  
  66.       if Nkind (Parent (N)) /= N_Package_Body
  67.         and then Nkind (Parent (N)) /= N_Accept_Statement
  68.       then
  69.          Expand_Cleanup_Actions (Parent (N));
  70.       end if;
  71.    end Expand_N_Handled_Sequence_Of_Statements;
  72.  
  73.  
  74. end Exp_Ch11;
  75.