OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [aspects.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              A S P E C T S                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2010-2012, 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.                                     --
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
with Atree;    use Atree;
33
with Einfo;    use Einfo;
34
with Nlists;   use Nlists;
35
with Sinfo;    use Sinfo;
36
with Tree_IO;  use Tree_IO;
37
 
38
with GNAT.HTable;           use GNAT.HTable;
39
 
40
package body Aspects is
41
 
42
   procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id);
43
   --  Same as Set_Aspect_Specifications, but does not contain the assertion
44
   --  that checks that N does not already have aspect specifications. This
45
   --  subprogram is supposed to be used as a part of Tree_Read. When reading
46
   --  tree, first read nodes with their basic properties (as Atree.Tree_Read),
47
   --  this includes reading the Has_Aspects flag for each node, then we reed
48
   --  all the list tables and only after that we call Tree_Read for Aspects.
49
   --  That is, when reading the tree, the list of aspects is attached to the
50
   --  node that already has Has_Aspects flag set ON.
51
 
52
   ------------------------------------------
53
   -- Hash Table for Aspect Specifications --
54
   ------------------------------------------
55
 
56
   type AS_Hash_Range is range 0 .. 510;
57
   --  Size of hash table headers
58
 
59
   function AS_Hash (F : Node_Id) return AS_Hash_Range;
60
   --  Hash function for hash table
61
 
62
   function AS_Hash (F : Node_Id) return AS_Hash_Range is
63
   begin
64
      return AS_Hash_Range (F mod 511);
65
   end AS_Hash;
66
 
67
   package Aspect_Specifications_Hash_Table is new
68
     GNAT.HTable.Simple_HTable
69
       (Header_Num => AS_Hash_Range,
70
        Element    => List_Id,
71
        No_Element => No_List,
72
        Key        => Node_Id,
73
        Hash       => AS_Hash,
74
        Equal      => "=");
75
 
76
   -------------------------------------
77
   -- Hash Table for Aspect Id Values --
78
   -------------------------------------
79
 
80
   type AI_Hash_Range is range 0 .. 112;
81
   --  Size of hash table headers
82
 
83
   function AI_Hash (F : Name_Id) return AI_Hash_Range;
84
   --  Hash function for hash table
85
 
86
   function AI_Hash (F : Name_Id) return AI_Hash_Range is
87
   begin
88
      return AI_Hash_Range (F mod 113);
89
   end AI_Hash;
90
 
91
   package Aspect_Id_Hash_Table is new
92
     GNAT.HTable.Simple_HTable
93
       (Header_Num => AI_Hash_Range,
94
        Element    => Aspect_Id,
95
        No_Element => No_Aspect,
96
        Key        => Name_Id,
97
        Hash       => AI_Hash,
98
        Equal      => "=");
99
 
100
   ---------------------------
101
   -- Aspect_Specifications --
102
   ---------------------------
103
 
104
   function Aspect_Specifications (N : Node_Id) return List_Id is
105
   begin
106
      if Has_Aspects (N) then
107
         return Aspect_Specifications_Hash_Table.Get (N);
108
      else
109
         return No_List;
110
      end if;
111
   end Aspect_Specifications;
112
 
113
   -------------------
114
   -- Get_Aspect_Id --
115
   -------------------
116
 
117
   function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
118
   begin
119
      return Aspect_Id_Hash_Table.Get (Name);
120
   end Get_Aspect_Id;
121
 
122
   -----------------
123
   -- Find_Aspect --
124
   -----------------
125
 
126
   function Find_Aspect (Ent : Entity_Id; A : Aspect_Id) return Node_Id is
127
      Ritem : Node_Id;
128
      Typ   : Entity_Id;
129
 
130
   begin
131
 
132
      --  If the aspect is an inherited one and the entity is a class-wide
133
      --  type, use the aspect of the specific type. If the type is a base
134
      --  aspect, examine the rep. items of the base type.
135
 
136
      if Is_Type (Ent) then
137
         if Base_Aspect (A) then
138
            Typ := Base_Type (Ent);
139
         else
140
            Typ := Ent;
141
         end if;
142
 
143
         if Is_Class_Wide_Type (Typ)
144
           and then Inherited_Aspect (A)
145
         then
146
            Ritem := First_Rep_Item (Etype (Typ));
147
         else
148
            Ritem := First_Rep_Item (Typ);
149
         end if;
150
 
151
      else
152
         Ritem := First_Rep_Item (Ent);
153
      end if;
154
 
155
      while Present (Ritem) loop
156
         if Nkind (Ritem) = N_Aspect_Specification
157
           and then Get_Aspect_Id (Chars (Identifier (Ritem))) = A
158
         then
159
            if A = Aspect_Default_Iterator then
160
               return Expression (Aspect_Rep_Item (Ritem));
161
            else
162
               return Expression (Ritem);
163
            end if;
164
         end if;
165
 
166
         Next_Rep_Item (Ritem);
167
      end loop;
168
 
169
      return Empty;
170
   end Find_Aspect;
171
 
172
   ------------------
173
   -- Move_Aspects --
174
   ------------------
175
 
176
   procedure Move_Aspects (From : Node_Id; To : Node_Id) is
177
      pragma Assert (not Has_Aspects (To));
178
   begin
179
      if Has_Aspects (From) then
180
         Set_Aspect_Specifications (To, Aspect_Specifications (From));
181
         Aspect_Specifications_Hash_Table.Remove (From);
182
         Set_Has_Aspects (From, False);
183
      end if;
184
   end Move_Aspects;
185
 
186
   -----------------------------------
187
   -- Permits_Aspect_Specifications --
188
   -----------------------------------
189
 
190
   Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
191
     (N_Abstract_Subprogram_Declaration        => True,
192
      N_Component_Declaration                  => True,
193
      N_Entry_Declaration                      => True,
194
      N_Exception_Declaration                  => True,
195
      N_Exception_Renaming_Declaration         => True,
196
      N_Expression_Function                    => True,
197
      N_Formal_Abstract_Subprogram_Declaration => True,
198
      N_Formal_Concrete_Subprogram_Declaration => True,
199
      N_Formal_Object_Declaration              => True,
200
      N_Formal_Package_Declaration             => True,
201
      N_Formal_Type_Declaration                => True,
202
      N_Full_Type_Declaration                  => True,
203
      N_Function_Instantiation                 => True,
204
      N_Generic_Package_Declaration            => True,
205
      N_Generic_Renaming_Declaration           => True,
206
      N_Generic_Subprogram_Declaration         => True,
207
      N_Object_Declaration                     => True,
208
      N_Object_Renaming_Declaration            => True,
209
      N_Package_Declaration                    => True,
210
      N_Package_Instantiation                  => True,
211
      N_Package_Specification                  => True,
212
      N_Package_Renaming_Declaration           => True,
213
      N_Private_Extension_Declaration          => True,
214
      N_Private_Type_Declaration               => True,
215
      N_Procedure_Instantiation                => True,
216
      N_Protected_Body                         => True,
217
      N_Protected_Type_Declaration             => True,
218
      N_Single_Protected_Declaration           => True,
219
      N_Single_Task_Declaration                => True,
220
      N_Subprogram_Body                        => True,
221
      N_Subprogram_Declaration                 => True,
222
      N_Subprogram_Renaming_Declaration        => True,
223
      N_Subtype_Declaration                    => True,
224
      N_Task_Body                              => True,
225
      N_Task_Type_Declaration                  => True,
226
      others                                   => False);
227
 
228
   function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
229
   begin
230
      return Has_Aspect_Specifications_Flag (Nkind (N));
231
   end Permits_Aspect_Specifications;
232
 
233
   -----------------
234
   -- Same_Aspect --
235
   -----------------
236
 
237
   --  Table used for Same_Aspect, maps aspect to canonical aspect
238
 
239
   Canonical_Aspect : constant array (Aspect_Id) of Aspect_Id :=
240
   (No_Aspect                           => No_Aspect,
241
    Aspect_Ada_2005                     => Aspect_Ada_2005,
242
    Aspect_Ada_2012                     => Aspect_Ada_2005,
243
    Aspect_Address                      => Aspect_Address,
244
    Aspect_Alignment                    => Aspect_Alignment,
245
    Aspect_Asynchronous                 => Aspect_Asynchronous,
246
    Aspect_Atomic                       => Aspect_Atomic,
247
    Aspect_Atomic_Components            => Aspect_Atomic_Components,
248
    Aspect_Attach_Handler               => Aspect_Attach_Handler,
249
    Aspect_Bit_Order                    => Aspect_Bit_Order,
250
    Aspect_Component_Size               => Aspect_Component_Size,
251
    Aspect_Constant_Indexing            => Aspect_Constant_Indexing,
252
    Aspect_CPU                          => Aspect_CPU,
253
    Aspect_Default_Component_Value      => Aspect_Default_Component_Value,
254
    Aspect_Default_Iterator             => Aspect_Default_Iterator,
255
    Aspect_Default_Value                => Aspect_Default_Value,
256
    Aspect_Dimension                    => Aspect_Dimension,
257
    Aspect_Dimension_System             => Aspect_Dimension_System,
258
    Aspect_Discard_Names                => Aspect_Discard_Names,
259
    Aspect_Dispatching_Domain           => Aspect_Dispatching_Domain,
260
    Aspect_Dynamic_Predicate            => Aspect_Predicate,
261
    Aspect_External_Tag                 => Aspect_External_Tag,
262
    Aspect_Favor_Top_Level              => Aspect_Favor_Top_Level,
263
    Aspect_Implicit_Dereference         => Aspect_Implicit_Dereference,
264
    Aspect_Independent                  => Aspect_Independent,
265
    Aspect_Independent_Components       => Aspect_Independent_Components,
266
    Aspect_Inline                       => Aspect_Inline,
267
    Aspect_Inline_Always                => Aspect_Inline,
268
    Aspect_Interrupt_Handler            => Aspect_Interrupt_Handler,
269
    Aspect_Interrupt_Priority           => Aspect_Interrupt_Priority,
270
    Aspect_Iterator_Element             => Aspect_Iterator_Element,
271
    Aspect_All_Calls_Remote             => Aspect_All_Calls_Remote,
272
    Aspect_Compiler_Unit                => Aspect_Compiler_Unit,
273
    Aspect_Elaborate_Body               => Aspect_Elaborate_Body,
274
    Aspect_Preelaborate                 => Aspect_Preelaborate,
275
    Aspect_Preelaborate_05              => Aspect_Preelaborate_05,
276
    Aspect_Pure                         => Aspect_Pure,
277
    Aspect_Pure_05                      => Aspect_Pure_05,
278
    Aspect_Pure_12                      => Aspect_Pure_12,
279
    Aspect_Remote_Call_Interface        => Aspect_Remote_Call_Interface,
280
    Aspect_Remote_Types                 => Aspect_Remote_Types,
281
    Aspect_Shared_Passive               => Aspect_Shared_Passive,
282
    Aspect_Universal_Data               => Aspect_Universal_Data,
283
    Aspect_Input                        => Aspect_Input,
284
    Aspect_Invariant                    => Aspect_Invariant,
285
    Aspect_Machine_Radix                => Aspect_Machine_Radix,
286
    Aspect_No_Return                    => Aspect_No_Return,
287
    Aspect_Object_Size                  => Aspect_Object_Size,
288
    Aspect_Output                       => Aspect_Output,
289
    Aspect_Pack                         => Aspect_Pack,
290
    Aspect_Persistent_BSS               => Aspect_Persistent_BSS,
291
    Aspect_Post                         => Aspect_Post,
292
    Aspect_Postcondition                => Aspect_Post,
293
    Aspect_Pre                          => Aspect_Pre,
294
    Aspect_Precondition                 => Aspect_Pre,
295
    Aspect_Predicate                    => Aspect_Predicate,
296
    Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
297
    Aspect_Priority                     => Aspect_Priority,
298
    Aspect_Pure_Function                => Aspect_Pure_Function,
299
    Aspect_Remote_Access_Type           => Aspect_Remote_Access_Type,
300
    Aspect_Read                         => Aspect_Read,
301
    Aspect_Shared                       => Aspect_Atomic,
302
    Aspect_Simple_Storage_Pool          => Aspect_Simple_Storage_Pool,
303
    Aspect_Simple_Storage_Pool_Type     => Aspect_Simple_Storage_Pool_Type,
304
    Aspect_Size                         => Aspect_Size,
305
    Aspect_Small                        => Aspect_Small,
306
    Aspect_Static_Predicate             => Aspect_Predicate,
307
    Aspect_Storage_Pool                 => Aspect_Storage_Pool,
308
    Aspect_Storage_Size                 => Aspect_Storage_Size,
309
    Aspect_Stream_Size                  => Aspect_Stream_Size,
310
    Aspect_Suppress                     => Aspect_Suppress,
311
    Aspect_Suppress_Debug_Info          => Aspect_Suppress_Debug_Info,
312
    Aspect_Synchronization              => Aspect_Synchronization,
313
    Aspect_Test_Case                    => Aspect_Test_Case,
314
    Aspect_Type_Invariant               => Aspect_Invariant,
315
    Aspect_Unchecked_Union              => Aspect_Unchecked_Union,
316
    Aspect_Universal_Aliasing           => Aspect_Universal_Aliasing,
317
    Aspect_Unmodified                   => Aspect_Unmodified,
318
    Aspect_Unreferenced                 => Aspect_Unreferenced,
319
    Aspect_Unreferenced_Objects         => Aspect_Unreferenced_Objects,
320
    Aspect_Unsuppress                   => Aspect_Unsuppress,
321
    Aspect_Variable_Indexing            => Aspect_Variable_Indexing,
322
    Aspect_Value_Size                   => Aspect_Value_Size,
323
    Aspect_Volatile                     => Aspect_Volatile,
324
    Aspect_Volatile_Components          => Aspect_Volatile_Components,
325
    Aspect_Warnings                     => Aspect_Warnings,
326
    Aspect_Write                        => Aspect_Write);
327
 
328
   function Same_Aspect (A1 : Aspect_Id; A2 : Aspect_Id) return Boolean is
329
   begin
330
      return Canonical_Aspect (A1) = Canonical_Aspect (A2);
331
   end Same_Aspect;
332
 
333
   -------------------------------
334
   -- Set_Aspect_Specifications --
335
   -------------------------------
336
 
337
   procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
338
   begin
339
      pragma Assert (Permits_Aspect_Specifications (N));
340
      pragma Assert (not Has_Aspects (N));
341
      pragma Assert (L /= No_List);
342
 
343
      Set_Has_Aspects (N);
344
      Set_Parent (L, N);
345
      Aspect_Specifications_Hash_Table.Set (N, L);
346
   end Set_Aspect_Specifications;
347
 
348
   ----------------------------------------
349
   -- Set_Aspect_Specifications_No_Check --
350
   ----------------------------------------
351
 
352
   procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id) is
353
   begin
354
      pragma Assert (Permits_Aspect_Specifications (N));
355
      pragma Assert (L /= No_List);
356
 
357
      Set_Has_Aspects (N);
358
      Set_Parent (L, N);
359
      Aspect_Specifications_Hash_Table.Set (N, L);
360
   end Set_Aspect_Specifications_No_Check;
361
 
362
   ---------------
363
   -- Tree_Read --
364
   ---------------
365
 
366
   procedure Tree_Read is
367
      Node : Node_Id;
368
      List : List_Id;
369
   begin
370
      loop
371
         Tree_Read_Int (Int (Node));
372
         Tree_Read_Int (Int (List));
373
         exit when List = No_List;
374
         Set_Aspect_Specifications_No_Check (Node, List);
375
      end loop;
376
   end Tree_Read;
377
 
378
   ----------------
379
   -- Tree_Write --
380
   ----------------
381
 
382
   procedure Tree_Write is
383
      Node : Node_Id := Empty;
384
      List : List_Id;
385
   begin
386
      Aspect_Specifications_Hash_Table.Get_First (Node, List);
387
      loop
388
         Tree_Write_Int (Int (Node));
389
         Tree_Write_Int (Int (List));
390
         exit when List = No_List;
391
         Aspect_Specifications_Hash_Table.Get_Next (Node, List);
392
      end loop;
393
   end Tree_Write;
394
 
395
--  Package initialization sets up Aspect Id hash table
396
 
397
begin
398
   for J in Aspect_Id loop
399
      Aspect_Id_Hash_Table.Set (Aspect_Names (J), J);
400
   end loop;
401
end Aspects;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.