aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/exp_sel.ads
blob: 47a49e6b78b134529e62b4ac5275aa7dbbf3e2f0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              E X P _ S E L                               --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--          Copyright (C) 1992-2024, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  Routines used in Chapter 9 for the expansion of dispatching triggers in
--  select statements (Ada 2005: AI-345)

with Types; use Types;

package Exp_Sel is

   function Build_Abort_Block
     (Loc         : Source_Ptr;
      Abr_Blk_Ent : Entity_Id;
      Cln_Blk_Ent : Entity_Id;
      Blk         : Node_Id) return Node_Id;
   --  Generate:
   --    begin
   --       Blk
   --    exception
   --       when Abort_Signal => null;
   --    end;
   --  Abr_Blk_Ent is the name of the generated block, Cln_Blk_Ent is the name
   --  of the encapsulated cleanup block, Blk is the actual block name.
   --  The exception handler code is built by Build_Abort_Block_Handler.

   function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id;
   --  Generate:
   --    when others =>
   --      null;
   --  This is an exception handler to stop propagation of aborts, without
   --  modifying the deferral level.

   function Build_B
     (Loc   : Source_Ptr;
      Decls : List_Id) return Entity_Id;
   --  Generate:
   --    B : Boolean := False;
   --  Append the object declaration to the list and return its defining
   --  identifier.

   function Build_C
     (Loc   : Source_Ptr;
      Decls : List_Id) return Entity_Id;
   --  Generate:
   --    C : Ada.Tags.Prim_Op_Kind;
   --  Append the object declaration to the list and return its defining
   --  identifier.

   function Build_Cleanup_Block
     (Loc       : Source_Ptr;
      Blk_Ent   : Entity_Id;
      Stmts     : List_Id;
      Clean_Ent : Entity_Id) return Node_Id;
   --  Generate:
   --    declare
   --       procedure _clean is
   --       begin
   --          ...
   --       end _clean;
   --    begin
   --       Stmts
   --    at end
   --       _clean;
   --    end;
   --  Blk_Ent is the name of the generated block, Stmts is the list of
   --  encapsulated statements and Clean_Ent is the parameter to the
   --  _clean procedure.

   function Build_K
     (Loc   : Source_Ptr;
      Decls : List_Id;
      Obj   : Entity_Id) return Entity_Id;
   --  Generate
   --    K : Ada.Tags.Tagged_Kind :=
   --          Ada.Tags.Get_Tagged_Kind (Ada.Tags.Tag (Obj));
   --  where Obj is the pointer to a secondary table. Append the object
   --  declaration to the list and return its defining identifier.

   function Build_S
     (Loc  : Source_Ptr;
      Decls : List_Id) return Entity_Id;
   --  Generate:
   --    S : Integer;
   --  Append the object declaration to the list and return its defining
   --  identifier.

   function Build_S_Assignment
     (Loc      : Source_Ptr;
      S        : Entity_Id;
      Obj      : Entity_Id;
      Call_Ent : Entity_Id) return Node_Id;
   --  Generate:
   --    S := Ada.Tags.Get_Offset_Index (
   --           Ada.Tags.Tag (Obj), DT_Position (Call_Ent));
   --  where Obj is the pointer to a secondary table, Call_Ent is the entity
   --  of the dispatching call name. Return the generated assignment.

end Exp_Sel;