1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                              E X P _ S E L                               --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 1992-2011, 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.  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 COPYING3.  If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26--  Routines used in Chapter 9 for the expansion of dispatching triggers in
27--  select statements (Ada 2005: AI-345)
28
29with Types; use Types;
30
31package Exp_Sel is
32
33   function Build_Abort_Block
34     (Loc         : Source_Ptr;
35      Abr_Blk_Ent : Entity_Id;
36      Cln_Blk_Ent : Entity_Id;
37      Blk         : Node_Id) return Node_Id;
38   --  Generate:
39   --    begin
40   --       Blk
41   --    exception
42   --       when Abort_Signal => Abort_Undefer / null;
43   --    end;
44   --  Abr_Blk_Ent is the name of the generated block, Cln_Blk_Ent is the name
45   --  of the encapsulated cleanup block, Blk is the actual block name.
46   --  The exception handler code is built by Build_Abort_Block_Handler.
47
48   function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id;
49   --  Generate if front-end exception:
50   --    when others =>
51   --      Abort_Under;
52   --  or if back-end exception:
53   --    when others =>
54   --      null;
55   --  This is an exception handler to stop propagation of aborts, without
56   --  modifying the deferal level.
57
58   function Build_B
59     (Loc   : Source_Ptr;
60      Decls : List_Id) return Entity_Id;
61   --  Generate:
62   --    B : Boolean := False;
63   --  Append the object declaration to the list and return its defining
64   --  identifier.
65
66   function Build_C
67     (Loc   : Source_Ptr;
68      Decls : List_Id) return Entity_Id;
69   --  Generate:
70   --    C : Ada.Tags.Prim_Op_Kind;
71   --  Append the object declaration to the list and return its defining
72   --  identifier.
73
74   function Build_Cleanup_Block
75     (Loc       : Source_Ptr;
76      Blk_Ent   : Entity_Id;
77      Stmts     : List_Id;
78      Clean_Ent : Entity_Id) return Node_Id;
79   --  Generate:
80   --    declare
81   --       procedure _clean is
82   --       begin
83   --          ...
84   --       end _clean;
85   --    begin
86   --       Stmts
87   --    at end
88   --       _clean;
89   --    end;
90   --  Blk_Ent is the name of the generated block, Stmts is the list of
91   --  encapsulated statements and Clean_Ent is the parameter to the
92   --  _clean procedure.
93
94   function Build_K
95     (Loc   : Source_Ptr;
96      Decls : List_Id;
97      Obj   : Entity_Id) return Entity_Id;
98   --  Generate
99   --    K : Ada.Tags.Tagged_Kind :=
100   --          Ada.Tags.Get_Tagged_Kind (Ada.Tags.Tag (Obj));
101   --  where Obj is the pointer to a secondary table. Append the object
102   --  declaration to the list and return its defining identifier.
103
104   function Build_S
105     (Loc  : Source_Ptr;
106      Decls : List_Id) return Entity_Id;
107   --  Generate:
108   --    S : Integer;
109   --  Append the object declaration to the list and return its defining
110   --  identifier.
111
112   function Build_S_Assignment
113     (Loc      : Source_Ptr;
114      S        : Entity_Id;
115      Obj      : Entity_Id;
116      Call_Ent : Entity_Id) return Node_Id;
117   --  Generate:
118   --    S := Ada.Tags.Get_Offset_Index (
119   --           Ada.Tags.Tag (Obj), DT_Position (Call_Ent));
120   --  where Obj is the pointer to a secondary table, Call_Ent is the entity
121   --  of the dispatching call name. Return the generated assignment.
122
123end Exp_Sel;
124