]>
Commit | Line | Data |
---|---|---|
76f9c7f4 BD |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G E N _ I L . G E N -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
cccef051 | 9 | -- Copyright (C) 2020-2023, Free Software Foundation, Inc. -- |
76f9c7f4 BD |
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 | with Ada.Containers; use type Ada.Containers.Count_Type; | |
20922782 | 27 | with Ada.Text_IO; |
76f9c7f4 BD |
28 | |
29 | package body Gen_IL.Gen is | |
30 | ||
a6fe12b0 BD |
31 | Statistics_Enabled : constant Boolean := False; |
32 | -- Change to True or False to enable/disable statistics printed by | |
33 | -- Atree. Should normally be False, for efficiency. Also compile with | |
34 | -- -gnatd.A to get the statistics printed. Enabling these statistics | |
35 | -- makes the compiler about 20% slower. | |
36 | ||
99e30ba8 BD |
37 | Num_Header_Slots : constant := 3; |
38 | -- Number of header slots; the first Num_Header_Slots slots are stored in | |
39 | -- the header; the rest are dynamically allocated in the Slots table. We | |
40 | -- need to subtract this off when accessing dynamic slots. The constant | |
a6fe12b0 BD |
41 | -- Seinfo.N_Head will contain this value. Fields that are allocated in the |
42 | -- header slots are quicker to access. | |
99e30ba8 BD |
43 | -- |
44 | -- This number can be adjusted for efficiency. We choose 3 because the | |
45 | -- minimum node size is 3 slots, and because that causes the size of type | |
46 | -- Node_Header to be a power of 2. We can't make it zero, however, because | |
47 | -- C doesn't allow zero-length arrays. | |
48 | ||
49 | N_Head : constant String := Image (Field_Offset'(Num_Header_Slots)); | |
50 | -- String form of the above | |
51 | ||
76f9c7f4 BD |
52 | Enable_Assertions : constant Boolean := True; |
53 | -- True to enable predicates on the _Id types, and preconditions on getters | |
54 | -- and setters. | |
55 | ||
56 | Overlay_Fields : constant Boolean := True; | |
57 | -- False to allocate every field so it doesn't overlay any other fields, | |
58 | -- which results in enormous nodes. For experimenting and debugging. | |
59 | -- Should be True in normal operation, for efficiency. | |
60 | ||
99e30ba8 BD |
61 | SS : constant := 32; -- slot size in bits |
62 | SSS : constant String := Image (Bit_Offset'(SS)); | |
63 | ||
76f9c7f4 BD |
64 | Inline : constant String := "Inline"; |
65 | -- For experimenting with Inline_Always | |
66 | ||
a7cadd18 | 67 | Syntactic : Fields_Per_Node_Type := |
76f9c7f4 BD |
68 | (others => (others => False)); |
69 | ||
70 | Nodes_And_Entities : constant Type_Vector := Node_Kind & Entity_Kind; | |
71 | All_Entities : constant Type_Vector := To_Vector (Entity_Kind, Length => 1); | |
72 | ||
73 | procedure Create_Type | |
82a79441 BD |
74 | (T : Node_Or_Entity_Type; |
75 | Parent : Opt_Abstract_Type; | |
76 | Fields : Field_Sequence; | |
77 | Nmake_Assert : String); | |
76f9c7f4 BD |
78 | -- Called by the Create_..._Type procedures exported by this package to |
79 | -- create an entry in the Types_Table. | |
80 | ||
81 | procedure Create_Union_Type | |
82 | (Root : Root_Type; T : Abstract_Type; Children : Type_Array); | |
a7cadd18 BD |
83 | -- Called by Create_Node_Union_Type and Create_Entity_Union_Type to create |
84 | -- a union type. | |
76f9c7f4 BD |
85 | |
86 | function Create_Field | |
a7cadd18 BD |
87 | (Field : Field_Enum; |
88 | Field_Type : Type_Enum; | |
89 | Default_Value : Field_Default_Value; | |
90 | Type_Only : Type_Only_Enum; | |
91 | Pre, Pre_Get, Pre_Set : String; | |
92 | Is_Syntactic : Boolean) return Field_Desc; | |
76f9c7f4 BD |
93 | -- Called by the Create_..._Field functions exported by this package to |
94 | -- create an entry in the Field_Table. See Create_Syntactic_Field and | |
95 | -- Create_Semantic_Field for additional doc. | |
96 | ||
97 | procedure Check_Type (T : Node_Or_Entity_Type); | |
a7cadd18 BD |
98 | -- Check some "legality" rules for types in the Gen_IL little language |
99 | ||
100 | ---------------- | |
101 | -- Check_Type -- | |
102 | ---------------- | |
76f9c7f4 BD |
103 | |
104 | procedure Check_Type (T : Node_Or_Entity_Type) is | |
105 | Im : constant String := Node_Or_Entity_Type'Image (T); | |
106 | begin | |
107 | if Type_Table (T) /= null then | |
108 | raise Illegal with "duplicate creation of type " & Image (T); | |
109 | end if; | |
110 | ||
111 | if T not in Root_Type then | |
112 | case T is | |
113 | when Node_Type => | |
114 | if Im'Length < 2 or else Im (1 .. 2) /= "N_" then | |
115 | raise Illegal with "Node type names must start with ""N_"""; | |
116 | end if; | |
117 | ||
118 | when Concrete_Entity => | |
119 | if Im'Length < 2 or else Im (1 .. 2) /= "E_" then | |
120 | raise Illegal with | |
121 | "Concrete entity type names must start with ""E_"""; | |
122 | end if; | |
123 | ||
124 | when others => null; | |
125 | -- No special prefix for abstract entities | |
126 | end case; | |
127 | end if; | |
128 | end Check_Type; | |
129 | ||
a7cadd18 BD |
130 | ----------------- |
131 | -- Create_Type -- | |
132 | ----------------- | |
133 | ||
76f9c7f4 | 134 | procedure Create_Type |
82a79441 BD |
135 | (T : Node_Or_Entity_Type; |
136 | Parent : Opt_Abstract_Type; | |
137 | Fields : Field_Sequence; | |
138 | Nmake_Assert : String) | |
76f9c7f4 BD |
139 | is |
140 | begin | |
141 | Check_Type (T); | |
142 | ||
143 | if T not in Root_Type then | |
144 | if Type_Table (Parent) = null then | |
145 | raise Illegal with | |
146 | "undefined parent type for " & | |
147 | Image (T) & " (parent is " & Image (Parent) & ")"; | |
148 | end if; | |
149 | ||
150 | if Type_Table (Parent).Is_Union then | |
151 | raise Illegal with | |
152 | "parent type for " & | |
153 | Image (T) & " must not be union (" & Image (Parent) & ")"; | |
154 | end if; | |
155 | end if; | |
156 | ||
157 | Type_Table (T) := | |
158 | new Type_Info' | |
159 | (Is_Union => False, Parent => Parent, | |
160 | Children | Concrete_Descendants => Type_Vectors.Empty_Vector, | |
82a79441 BD |
161 | First | Last | Fields => <>, -- filled in later |
162 | Nmake_Assert => new String'(Nmake_Assert)); | |
76f9c7f4 BD |
163 | |
164 | if Parent /= No_Type then | |
165 | Append (Type_Table (Parent).Children, T); | |
166 | end if; | |
167 | ||
168 | -- Check that syntactic fields precede semantic fields. Note that this | |
169 | -- check is happening before we compute inherited fields. | |
a7cadd18 | 170 | -- Exempt Chars and Actions from this rule, for now. |
76f9c7f4 BD |
171 | |
172 | declare | |
173 | Semantic_Seen : Boolean := False; | |
174 | begin | |
175 | for J in Fields'Range loop | |
176 | if Fields (J).Is_Syntactic then | |
177 | if Semantic_Seen then | |
178 | raise Illegal with | |
179 | "syntactic fields must precede semantic ones " & Image (T); | |
180 | end if; | |
181 | ||
182 | else | |
183 | if Fields (J).F not in Chars | Actions then | |
184 | Semantic_Seen := True; | |
185 | end if; | |
186 | end if; | |
187 | end loop; | |
188 | end; | |
189 | ||
a7cadd18 BD |
190 | -- Check that node fields are in nodes, and entity fields are in |
191 | -- entities. | |
192 | ||
193 | for J in Fields'Range loop | |
194 | declare | |
195 | Field : constant Field_Enum := Fields (J).F; | |
196 | Error_Prefix : constant String := | |
197 | "Field " & Image (T) & "." & Image (Field) & " not in "; | |
198 | begin | |
199 | case T is | |
200 | when Node_Type => | |
201 | if Field not in Node_Field then | |
202 | raise Illegal with Error_Prefix & "Node_Field"; | |
203 | end if; | |
204 | ||
205 | when Entity_Type => | |
206 | if Field not in Entity_Field then | |
207 | raise Illegal with Error_Prefix & "Entity_Field"; | |
208 | end if; | |
209 | ||
210 | when Type_Boundaries => | |
211 | raise Program_Error; -- dummy types shouldn't have fields | |
212 | end case; | |
213 | end; | |
214 | end loop; | |
215 | ||
216 | -- Compute the Have_This_Field component of fields, the Fields component | |
217 | -- of the current type, and Syntactic table. | |
218 | ||
76f9c7f4 BD |
219 | for J in Fields'Range loop |
220 | declare | |
221 | Field : constant Field_Enum := Fields (J).F; | |
222 | Is_Syntactic : constant Boolean := Fields (J).Is_Syntactic; | |
223 | ||
224 | begin | |
225 | Append (Field_Table (Field).Have_This_Field, T); | |
226 | Append (Type_Table (T).Fields, Field); | |
227 | ||
a7cadd18 BD |
228 | pragma Assert (not Syntactic (T) (Field)); |
229 | Syntactic (T) (Field) := Is_Syntactic; | |
76f9c7f4 BD |
230 | end; |
231 | end loop; | |
232 | end Create_Type; | |
233 | ||
234 | -- Other than constraint checks on T at the call site, and the lack of a | |
235 | -- parent for root types, the following six all do the same thing. | |
236 | ||
a7cadd18 BD |
237 | --------------------------- |
238 | -- Create_Root_Node_Type -- | |
239 | --------------------------- | |
240 | ||
76f9c7f4 | 241 | procedure Create_Root_Node_Type |
a7cadd18 | 242 | (T : Abstract_Node; |
76f9c7f4 BD |
243 | Fields : Field_Sequence := No_Fields) is |
244 | begin | |
82a79441 | 245 | Create_Type (T, Parent => No_Type, Fields => Fields, Nmake_Assert => ""); |
76f9c7f4 BD |
246 | end Create_Root_Node_Type; |
247 | ||
a7cadd18 BD |
248 | ------------------------------- |
249 | -- Create_Abstract_Node_Type -- | |
250 | ------------------------------- | |
251 | ||
76f9c7f4 | 252 | procedure Create_Abstract_Node_Type |
a7cadd18 | 253 | (T : Abstract_Node; Parent : Abstract_Type; |
76f9c7f4 BD |
254 | Fields : Field_Sequence := No_Fields) |
255 | is | |
256 | begin | |
82a79441 | 257 | Create_Type (T, Parent, Fields, Nmake_Assert => ""); |
76f9c7f4 BD |
258 | end Create_Abstract_Node_Type; |
259 | ||
a7cadd18 BD |
260 | ------------------------------- |
261 | -- Create_Concrete_Node_Type -- | |
262 | ------------------------------- | |
263 | ||
76f9c7f4 | 264 | procedure Create_Concrete_Node_Type |
a7cadd18 | 265 | (T : Concrete_Node; Parent : Abstract_Type; |
82a79441 BD |
266 | Fields : Field_Sequence := No_Fields; |
267 | Nmake_Assert : String := "") | |
76f9c7f4 BD |
268 | is |
269 | begin | |
82a79441 | 270 | Create_Type (T, Parent, Fields, Nmake_Assert); |
76f9c7f4 BD |
271 | end Create_Concrete_Node_Type; |
272 | ||
a7cadd18 BD |
273 | ----------------------------- |
274 | -- Create_Root_Entity_Type -- | |
275 | ----------------------------- | |
276 | ||
76f9c7f4 | 277 | procedure Create_Root_Entity_Type |
a7cadd18 | 278 | (T : Abstract_Entity; |
76f9c7f4 BD |
279 | Fields : Field_Sequence := No_Fields) is |
280 | begin | |
82a79441 | 281 | Create_Type (T, Parent => No_Type, Fields => Fields, Nmake_Assert => ""); |
76f9c7f4 BD |
282 | end Create_Root_Entity_Type; |
283 | ||
a7cadd18 BD |
284 | --------------------------------- |
285 | -- Create_Abstract_Entity_Type -- | |
286 | --------------------------------- | |
287 | ||
76f9c7f4 | 288 | procedure Create_Abstract_Entity_Type |
a7cadd18 | 289 | (T : Abstract_Entity; Parent : Abstract_Type; |
76f9c7f4 BD |
290 | Fields : Field_Sequence := No_Fields) |
291 | is | |
292 | begin | |
82a79441 | 293 | Create_Type (T, Parent, Fields, Nmake_Assert => ""); |
76f9c7f4 BD |
294 | end Create_Abstract_Entity_Type; |
295 | ||
a7cadd18 BD |
296 | --------------------------------- |
297 | -- Create_Concrete_Entity_Type -- | |
298 | --------------------------------- | |
299 | ||
76f9c7f4 | 300 | procedure Create_Concrete_Entity_Type |
a7cadd18 | 301 | (T : Concrete_Entity; Parent : Abstract_Type; |
76f9c7f4 BD |
302 | Fields : Field_Sequence := No_Fields) |
303 | is | |
304 | begin | |
82a79441 | 305 | Create_Type (T, Parent, Fields, Nmake_Assert => ""); |
76f9c7f4 BD |
306 | end Create_Concrete_Entity_Type; |
307 | ||
a7cadd18 BD |
308 | ------------------ |
309 | -- Create_Field -- | |
310 | ------------------ | |
311 | ||
76f9c7f4 | 312 | function Create_Field |
a7cadd18 BD |
313 | (Field : Field_Enum; |
314 | Field_Type : Type_Enum; | |
315 | Default_Value : Field_Default_Value; | |
316 | Type_Only : Type_Only_Enum; | |
317 | Pre, Pre_Get, Pre_Set : String; | |
318 | Is_Syntactic : Boolean) return Field_Desc | |
76f9c7f4 BD |
319 | is |
320 | begin | |
a7cadd18 BD |
321 | -- Note that this function has the side effect of update the |
322 | -- Field_Table. | |
323 | ||
76f9c7f4 BD |
324 | pragma Assert (if Default_Value /= No_Default then Is_Syntactic); |
325 | pragma Assert (if Type_Only /= No_Type_Only then not Is_Syntactic); | |
326 | ||
a7cadd18 BD |
327 | -- First time this field has been seen; create an entry in the |
328 | -- Field_Table. | |
329 | ||
76f9c7f4 BD |
330 | if Field_Table (Field) = null then |
331 | Field_Table (Field) := new Field_Info' | |
332 | (Type_Vectors.Empty_Vector, Field_Type, Default_Value, Type_Only, | |
a7cadd18 BD |
333 | Pre => new String'(Pre), |
334 | Pre_Get => new String'(Pre_Get), | |
335 | Pre_Set => new String'(Pre_Set), | |
a6fe12b0 | 336 | Offset => Unknown_Offset); |
a7cadd18 BD |
337 | |
338 | -- The Field_Table entry has already been created by the 'then' part | |
339 | -- above. Now we're seeing the same field being "created" again in a | |
340 | -- different type. Here we check consistency of this new Create_Field | |
341 | -- call with the old one. | |
76f9c7f4 BD |
342 | |
343 | else | |
344 | if Field_Type /= Field_Table (Field).Field_Type then | |
345 | raise Illegal with | |
346 | "mismatched field types for " & Image (Field); | |
347 | end if; | |
348 | ||
349 | -- Check that default values for syntactic fields match. This check | |
350 | -- could be stricter; it currently allows a field to have No_Default | |
351 | -- in one type, but something else in another type. In that case, we | |
352 | -- use the "something else" for all types. | |
a7cadd18 BD |
353 | -- |
354 | -- Note that the order of calls does not matter; a default value | |
355 | -- always overrides a No_Default value. | |
76f9c7f4 BD |
356 | |
357 | if Is_Syntactic then | |
358 | if Default_Value /= Field_Table (Field).Default_Value then | |
359 | if Field_Table (Field).Default_Value = No_Default then | |
360 | Field_Table (Field).Default_Value := Default_Value; | |
361 | else | |
362 | raise Illegal with | |
363 | "mismatched default values for " & Image (Field); | |
364 | end if; | |
365 | end if; | |
366 | end if; | |
367 | ||
368 | if Type_Only /= Field_Table (Field).Type_Only then | |
369 | raise Illegal with "mismatched Type_Only for " & Image (Field); | |
370 | end if; | |
371 | ||
372 | if Pre /= Field_Table (Field).Pre.all then | |
373 | raise Illegal with | |
374 | "mismatched extra preconditions for " & Image (Field); | |
375 | end if; | |
a7cadd18 BD |
376 | |
377 | if Pre_Get /= Field_Table (Field).Pre_Get.all then | |
378 | raise Illegal with | |
379 | "mismatched extra getter-only preconditions for " & | |
380 | Image (Field); | |
381 | end if; | |
382 | ||
82a79441 | 383 | if Pre_Set /= Field_Table (Field).Pre_Set.all then |
a7cadd18 BD |
384 | raise Illegal with |
385 | "mismatched extra setter-only preconditions for " & | |
386 | Image (Field); | |
387 | end if; | |
76f9c7f4 BD |
388 | end if; |
389 | ||
390 | return (Field, Is_Syntactic); | |
391 | end Create_Field; | |
392 | ||
a7cadd18 BD |
393 | ---------------------------- |
394 | -- Create_Syntactic_Field -- | |
395 | ---------------------------- | |
396 | ||
76f9c7f4 BD |
397 | function Create_Syntactic_Field |
398 | (Field : Node_Field; | |
399 | Field_Type : Type_Enum; | |
400 | Default_Value : Field_Default_Value := No_Default; | |
a7cadd18 | 401 | Pre, Pre_Get, Pre_Set : String := "") return Field_Desc |
76f9c7f4 BD |
402 | is |
403 | begin | |
404 | return Create_Field | |
a7cadd18 BD |
405 | (Field, Field_Type, Default_Value, No_Type_Only, |
406 | Pre, Pre_Get, Pre_Set, | |
76f9c7f4 BD |
407 | Is_Syntactic => True); |
408 | end Create_Syntactic_Field; | |
409 | ||
a7cadd18 BD |
410 | --------------------------- |
411 | -- Create_Semantic_Field -- | |
412 | --------------------------- | |
413 | ||
76f9c7f4 BD |
414 | function Create_Semantic_Field |
415 | (Field : Field_Enum; | |
416 | Field_Type : Type_Enum; | |
417 | Type_Only : Type_Only_Enum := No_Type_Only; | |
a7cadd18 | 418 | Pre, Pre_Get, Pre_Set : String := "") return Field_Desc |
76f9c7f4 BD |
419 | is |
420 | begin | |
421 | return Create_Field | |
a7cadd18 BD |
422 | (Field, Field_Type, No_Default, Type_Only, |
423 | Pre, Pre_Get, Pre_Set, | |
424 | Is_Syntactic => False); | |
76f9c7f4 BD |
425 | end Create_Semantic_Field; |
426 | ||
a7cadd18 BD |
427 | ----------------------- |
428 | -- Create_Union_Type -- | |
429 | ----------------------- | |
430 | ||
76f9c7f4 BD |
431 | procedure Create_Union_Type |
432 | (Root : Root_Type; T : Abstract_Type; Children : Type_Array) | |
433 | is | |
434 | Children_Seen : Type_Set := (others => False); | |
435 | ||
436 | begin | |
437 | Check_Type (T); | |
438 | ||
439 | if Children'Length <= 1 then | |
440 | raise Illegal with Image (T) & " must have two or more children"; | |
441 | end if; | |
442 | ||
443 | for Child of Children loop | |
444 | if Children_Seen (Child) then | |
445 | raise Illegal with | |
446 | Image (T) & " has duplicate child " & Image (Child); | |
447 | end if; | |
448 | ||
449 | Children_Seen (Child) := True; | |
450 | ||
451 | if Type_Table (Child) = null then | |
452 | raise Illegal with | |
453 | "undefined child type for " & | |
454 | Image (T) & " (child is " & Image (Child) & ")"; | |
455 | end if; | |
456 | end loop; | |
457 | ||
458 | Type_Table (T) := | |
459 | new Type_Info' | |
460 | (Is_Union => True, Parent => Root, | |
461 | Children | Concrete_Descendants => Type_Vectors.Empty_Vector); | |
462 | ||
463 | for Child of Children loop | |
464 | Append (Type_Table (T).Children, Child); | |
465 | end loop; | |
466 | end Create_Union_Type; | |
467 | ||
a7cadd18 BD |
468 | ---------------------------- |
469 | -- Create_Node_Union_Type -- | |
470 | ---------------------------- | |
471 | ||
472 | procedure Create_Node_Union_Type | |
473 | (T : Abstract_Node; Children : Type_Array) is | |
76f9c7f4 BD |
474 | begin |
475 | Create_Union_Type (Node_Kind, T, Children); | |
a7cadd18 | 476 | end Create_Node_Union_Type; |
76f9c7f4 | 477 | |
a7cadd18 BD |
478 | ------------------------------ |
479 | -- Create_Entity_Union_Type -- | |
480 | ------------------------------ | |
481 | ||
482 | procedure Create_Entity_Union_Type | |
76f9c7f4 BD |
483 | (T : Abstract_Entity; Children : Type_Array) is |
484 | begin | |
485 | Create_Union_Type (Entity_Kind, T, Children); | |
a7cadd18 BD |
486 | end Create_Entity_Union_Type; |
487 | ||
488 | ------------- | |
489 | -- Compile -- | |
490 | ------------- | |
76f9c7f4 BD |
491 | |
492 | procedure Compile is | |
493 | Fields_Per_Node : Fields_Per_Node_Type := (others => (others => False)); | |
494 | ||
495 | Type_Bit_Size : array (Concrete_Type) of Bit_Offset := (others => 0); | |
496 | Min_Node_Bit_Size : Bit_Offset := Bit_Offset'Last; | |
497 | Max_Node_Bit_Size : Bit_Offset := 0; | |
498 | Min_Entity_Bit_Size : Bit_Offset := Bit_Offset'Last; | |
499 | Max_Entity_Bit_Size : Bit_Offset := 0; | |
500 | -- Above are in units of bits; following are in units of slots: | |
501 | Min_Node_Size : Field_Offset := Field_Offset'Last; | |
502 | Max_Node_Size : Field_Offset := 0; | |
503 | Min_Entity_Size : Field_Offset := Field_Offset'Last; | |
504 | Max_Entity_Size : Field_Offset := 0; | |
505 | ||
76f9c7f4 BD |
506 | Node_Field_Types_Used, Entity_Field_Types_Used : Type_Set; |
507 | ||
508 | Setter_Needs_Parent : Field_Set := | |
b2339160 BD |
509 | (Actions | Expression | Then_Actions | Else_Actions => True, |
510 | others => False); | |
76f9c7f4 BD |
511 | -- Set of fields where the setter should set the Parent. True for |
512 | -- syntactic fields of type Node_Id and List_Id, but with some | |
b2339160 BD |
513 | -- exceptions. Expression is syntactic AND semantic, and the Parent |
514 | -- is needed. Default_Expression is also both, but the Parent is not | |
515 | -- needed. Then_Actions and Else_Actions are not syntactic, but the | |
516 | -- Parent is needed. | |
76f9c7f4 BD |
517 | |
518 | procedure Check_Completeness; | |
519 | -- Check that every type and field has been declared | |
520 | ||
521 | procedure Compute_Ranges (Root : Root_Type); | |
522 | -- Compute the range of Node_Kind/Entity_Kind values for all the types | |
a7cadd18 BD |
523 | -- rooted at Root. The result is stored in the First and Last components |
524 | -- in the Type_Table. | |
76f9c7f4 BD |
525 | |
526 | procedure Compute_Fields_Per_Node; | |
527 | -- Compute which fields are in which nodes. Implements inheritance of | |
528 | -- fields. Set the Fields component of each Type_Info to include | |
a7cadd18 BD |
529 | -- inherited ones. Set the Is_Syntactic component in the Type_Table to |
530 | -- the set of fields that are syntactic in that node kind. Set the | |
531 | -- Fields_Per_Node table. | |
76f9c7f4 BD |
532 | |
533 | procedure Compute_Field_Offsets; | |
a7cadd18 BD |
534 | -- Compute the offsets of each field. The results are stored in the |
535 | -- Offset components in the Field_Table. | |
76f9c7f4 BD |
536 | |
537 | procedure Compute_Type_Sizes; | |
538 | -- Compute the size of each node and entity type, which is one more than | |
539 | -- the maximum bit offset of all fields of the type. Results are | |
540 | -- returned in the above Type_Bit_Size and Min_.../Max_... variables. | |
541 | ||
a7cadd18 | 542 | procedure Check_For_Syntactic_Field_Mismatch; |
76f9c7f4 | 543 | -- Check that fields are either all syntactic or all semantic in all |
a7cadd18 BD |
544 | -- nodes in which they exist, except for some fields that already |
545 | -- violate this rule. | |
76f9c7f4 BD |
546 | -- |
547 | -- Also sets Setter_Needs_Parent. | |
548 | ||
549 | function Field_Types_Used (First, Last : Field_Enum) return Type_Set; | |
550 | -- Returns the union of the types of all the fields in the range First | |
551 | -- .. Last. Only Special_Type; if the declared type of a field is a | |
552 | -- descendant of Node_Kind or Entity_Kind, then the low-level getter for | |
553 | -- Node_Id can be used. | |
554 | ||
555 | procedure Put_Seinfo; | |
556 | -- Print out the Seinfo package, which is with'ed by both Sinfo.Nodes | |
557 | -- and Einfo.Entities. | |
558 | ||
559 | procedure Put_Nodes; | |
560 | -- Print out the Sinfo.Nodes package spec and body | |
561 | ||
562 | procedure Put_Entities; | |
563 | -- Print out the Einfo.Entities package spec and body | |
564 | ||
565 | procedure Put_Type_And_Subtypes | |
20922782 | 566 | (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
567 | -- Called by Put_Nodes and Put_Entities to print out the main type |
568 | -- and subtype declarations in Sinfo.Nodes and Einfo.Entities. | |
569 | ||
20922782 | 570 | procedure Put_Subp_Decls (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
571 | -- Called by Put_Nodes and Put_Entities to print out the subprogram |
572 | -- declarations in Sinfo.Nodes and Einfo.Entities. | |
573 | ||
20922782 | 574 | procedure Put_Subp_Bodies (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
575 | -- Called by Put_Nodes and Put_Entities to print out the subprogram |
576 | -- bodies in Sinfo.Nodes and Einfo.Entities. | |
577 | ||
578 | function Node_To_Fetch_From (F : Field_Enum) return String; | |
a7cadd18 | 579 | -- Name of the Node from which a getter should fetch the value. |
76f9c7f4 BD |
580 | -- Normally, we fetch from the node or entity passed in (i.e. formal |
581 | -- parameter N). But if Type_Only was specified, we need to fetch the | |
582 | -- corresponding base (etc) type. | |
76f9c7f4 | 583 | |
20922782 SB |
584 | procedure Put_Getter_Spec (S : in out Sink; F : Field_Enum); |
585 | procedure Put_Setter_Spec (S : in out Sink; F : Field_Enum); | |
586 | procedure Put_Getter_Decl (S : in out Sink; F : Field_Enum); | |
587 | procedure Put_Setter_Decl (S : in out Sink; F : Field_Enum); | |
99e30ba8 BD |
588 | procedure Put_Getter_Setter_Locals |
589 | (S : in out Sink; F : Field_Enum; Get : Boolean); | |
20922782 SB |
590 | procedure Put_Getter_Body (S : in out Sink; F : Field_Enum); |
591 | procedure Put_Setter_Body (S : in out Sink; F : Field_Enum); | |
76f9c7f4 BD |
592 | -- Print out the specification, declaration, or body of a getter or |
593 | -- setter for the given field. | |
594 | ||
595 | procedure Put_Precondition | |
20922782 | 596 | (S : in out Sink; F : Field_Enum); |
76f9c7f4 BD |
597 | -- Print out the precondition, if any, for a getter or setter for the |
598 | -- given field. | |
599 | ||
99e30ba8 | 600 | procedure Put_Casts |
20922782 | 601 | (S : in out Sink; T : Type_Enum); |
99e30ba8 | 602 | -- Print out the Cast functions for a given type |
76f9c7f4 | 603 | |
20922782 | 604 | procedure Put_Traversed_Fields (S : in out Sink); |
76f9c7f4 BD |
605 | -- Called by Put_Nodes to print out the Traversed_Fields table in |
606 | -- Sinfo.Nodes. | |
607 | ||
20922782 | 608 | procedure Put_Tables (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
609 | -- Called by Put_Nodes and Put_Entities to print out the various tables |
610 | -- in Sinfo.Nodes and Einfo.Entities. | |
611 | ||
612 | procedure Put_Nmake; | |
613 | -- Print out the Nmake package spec and body, containing | |
614 | -- Make_... functions for each concrete node type. | |
615 | ||
20922782 | 616 | procedure Put_Make_Decls (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
617 | -- Called by Put_Nmake to print out the Make_... function declarations |
618 | ||
20922782 | 619 | procedure Put_Make_Bodies (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
620 | -- Called by Put_Nmake to print out the Make_... function bodies |
621 | ||
622 | procedure Put_Make_Spec | |
20922782 | 623 | (S : in out Sink; Root : Root_Type; T : Concrete_Type); |
76f9c7f4 BD |
624 | -- Called by Put_Make_Decls and Put_Make_Bodies to print out the spec of |
625 | -- a single Make_... function. | |
626 | ||
627 | procedure Put_Seinfo_Tables; | |
628 | -- This puts information about both sinfo and einfo. | |
629 | -- Not actually needed by the compiler. | |
630 | ||
631 | procedure Put_Sinfo_Dot_H; | |
632 | -- Print out the sinfo.h file | |
633 | ||
634 | procedure Put_Einfo_Dot_H; | |
635 | -- Print out the einfo.h file | |
636 | ||
637 | procedure Put_C_Type_And_Subtypes | |
20922782 | 638 | (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
639 | -- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out the C code |
640 | -- corresponding to the Ada Node_Kind, Entity_Kind, and subtypes | |
641 | -- thereof. | |
642 | ||
99e30ba8 | 643 | procedure Put_C_Getters |
20922782 | 644 | (S : in out Sink; Root : Root_Type); |
76f9c7f4 BD |
645 | -- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out high-level |
646 | -- getters. | |
647 | ||
99e30ba8 | 648 | procedure Put_C_Getter |
20922782 | 649 | (S : in out Sink; F : Field_Enum); |
99e30ba8 | 650 | -- Used by Put_C_Getters to print out one high-level getter. |
76f9c7f4 BD |
651 | |
652 | procedure Put_Union_Membership | |
698425f5 | 653 | (S : in out Sink; Root : Root_Type; Only_Prototypes : Boolean); |
76f9c7f4 BD |
654 | -- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out functions to |
655 | -- test membership in a union type. | |
656 | ||
a7cadd18 BD |
657 | ------------------------ |
658 | -- Check_Completeness -- | |
659 | ------------------------ | |
660 | ||
76f9c7f4 BD |
661 | procedure Check_Completeness is |
662 | begin | |
663 | for T in Node_Or_Entity_Type loop | |
a7cadd18 | 664 | if Type_Table (T) = null and then T not in Type_Boundaries then |
76f9c7f4 BD |
665 | raise Illegal with "Missing type declaration for " & Image (T); |
666 | end if; | |
667 | end loop; | |
668 | ||
669 | for F in Field_Enum loop | |
670 | if Field_Table (F) = null | |
671 | and then F /= Between_Node_And_Entity_Fields | |
672 | then | |
673 | raise Illegal with "Missing field declaration for " & Image (F); | |
674 | end if; | |
675 | end loop; | |
676 | end Check_Completeness; | |
677 | ||
a7cadd18 BD |
678 | -------------------- |
679 | -- Compute_Ranges -- | |
680 | -------------------- | |
681 | ||
76f9c7f4 BD |
682 | procedure Compute_Ranges (Root : Root_Type) is |
683 | ||
684 | procedure Do_One_Type (T : Node_Or_Entity_Type); | |
685 | -- Compute the range for one type. Passed to Iterate_Types to process | |
686 | -- all of them. | |
687 | ||
a7cadd18 | 688 | procedure Add_Concrete_Descendant_To_Ancestors |
76f9c7f4 BD |
689 | (Ancestor : Abstract_Type; Descendant : Concrete_Type); |
690 | -- Add Descendant to the Concrete_Descendants of each of its | |
691 | -- ancestors. | |
692 | ||
a7cadd18 | 693 | procedure Add_Concrete_Descendant_To_Ancestors |
76f9c7f4 BD |
694 | (Ancestor : Abstract_Type; Descendant : Concrete_Type) is |
695 | begin | |
696 | if Ancestor not in Root_Type then | |
a7cadd18 | 697 | Add_Concrete_Descendant_To_Ancestors |
76f9c7f4 BD |
698 | (Type_Table (Ancestor).Parent, Descendant); |
699 | end if; | |
700 | ||
701 | Append (Type_Table (Ancestor).Concrete_Descendants, Descendant); | |
a7cadd18 | 702 | end Add_Concrete_Descendant_To_Ancestors; |
76f9c7f4 BD |
703 | |
704 | procedure Do_One_Type (T : Node_Or_Entity_Type) is | |
705 | begin | |
706 | case T is | |
707 | when Concrete_Type => | |
708 | pragma Annotate (Codepeer, Modified, Type_Table); | |
709 | Type_Table (T).First := T; | |
710 | Type_Table (T).Last := T; | |
a7cadd18 BD |
711 | Add_Concrete_Descendant_To_Ancestors |
712 | (Type_Table (T).Parent, T); | |
c36774bc BD |
713 | -- Parent cannot be No_Type here, because T is a concrete |
714 | -- type, and therefore not a root type. | |
76f9c7f4 BD |
715 | |
716 | when Abstract_Type => | |
717 | declare | |
718 | Children : Type_Vector renames Type_Table (T).Children; | |
719 | begin | |
720 | -- Ensure that an abstract type is not a leaf in the type | |
721 | -- hierarchy. | |
722 | ||
723 | if Is_Empty (Children) then | |
724 | raise Illegal with Image (T) & " has no children"; | |
725 | end if; | |
726 | ||
727 | -- We could support abstract types with only one child, | |
728 | -- but what's the point of having such a type? | |
729 | ||
730 | if Last_Index (Children) = 1 then | |
731 | raise Illegal with Image (T) & " has only one child"; | |
732 | end if; | |
733 | ||
734 | Type_Table (T).First := Type_Table (Children (1)).First; | |
735 | Type_Table (T).Last := | |
736 | Type_Table (Children (Last_Index (Children))).Last; | |
737 | end; | |
738 | ||
739 | when Between_Abstract_Entity_And_Concrete_Node_Types => | |
740 | raise Program_Error; | |
741 | end case; | |
742 | end Do_One_Type; | |
743 | begin | |
744 | Iterate_Types (Root, Post => Do_One_Type'Access); | |
745 | end Compute_Ranges; | |
746 | ||
a7cadd18 BD |
747 | ----------------------------- |
748 | -- Compute_Fields_Per_Node -- | |
749 | ----------------------------- | |
750 | ||
76f9c7f4 BD |
751 | procedure Compute_Fields_Per_Node is |
752 | ||
753 | Duplicate_Fields_Found : Boolean := False; | |
754 | ||
755 | function Get_Fields (T : Node_Or_Entity_Type) return Field_Vector; | |
756 | -- Compute the fields of a given type. This is the fields inherited | |
757 | -- from ancestors, plus the fields declared for the type itself. | |
758 | ||
a7cadd18 BD |
759 | function Get_Syntactic_Fields |
760 | (T : Node_Or_Entity_Type) return Field_Set; | |
76f9c7f4 BD |
761 | -- Compute the set of fields that are syntactic for a given type. |
762 | -- Note that a field can be syntactic in some node types, but | |
763 | -- semantic in others. | |
764 | ||
765 | procedure Do_Concrete_Type (CT : Concrete_Type); | |
a7cadd18 | 766 | -- Do the Compute_Fields_Per_Node work for a concrete type |
76f9c7f4 BD |
767 | |
768 | function Get_Fields (T : Node_Or_Entity_Type) return Field_Vector is | |
769 | Parent_Fields : constant Field_Vector := | |
770 | (if T in Root_Type then Field_Vectors.Empty_Vector | |
771 | else Get_Fields (Type_Table (T).Parent)); | |
772 | begin | |
773 | return Parent_Fields & Type_Table (T).Fields; | |
774 | end Get_Fields; | |
775 | ||
a7cadd18 BD |
776 | function Get_Syntactic_Fields |
777 | (T : Node_Or_Entity_Type) return Field_Set | |
76f9c7f4 BD |
778 | is |
779 | Parent_Is_Syntactic : constant Field_Set := | |
780 | (if T in Root_Type then (Field_Enum => False) | |
a7cadd18 | 781 | else Get_Syntactic_Fields (Type_Table (T).Parent)); |
76f9c7f4 | 782 | begin |
a7cadd18 BD |
783 | return Parent_Is_Syntactic or Syntactic (T); |
784 | end Get_Syntactic_Fields; | |
76f9c7f4 BD |
785 | |
786 | procedure Do_Concrete_Type (CT : Concrete_Type) is | |
787 | begin | |
788 | Type_Table (CT).Fields := Get_Fields (CT); | |
a7cadd18 | 789 | Syntactic (CT) := Get_Syntactic_Fields (CT); |
76f9c7f4 BD |
790 | |
791 | for F of Type_Table (CT).Fields loop | |
792 | if Fields_Per_Node (CT) (F) then | |
20922782 SB |
793 | Ada.Text_IO.Put_Line |
794 | ("duplicate field" & Image (CT) & Image (F)); | |
76f9c7f4 BD |
795 | Duplicate_Fields_Found := True; |
796 | end if; | |
797 | ||
798 | Fields_Per_Node (CT) (F) := True; | |
799 | end loop; | |
800 | end Do_Concrete_Type; | |
801 | ||
802 | begin -- Compute_Fields_Per_Node | |
803 | for CT in Concrete_Node loop | |
804 | Do_Concrete_Type (CT); | |
805 | end loop; | |
806 | ||
807 | -- The node fields defined for all three N_Entity kinds should be the | |
808 | -- same: | |
809 | ||
810 | if Type_Table (N_Defining_Character_Literal).Fields /= | |
811 | Type_Table (N_Defining_Identifier).Fields | |
812 | then | |
813 | raise Illegal with | |
814 | "fields for N_Defining_Identifier and " & | |
815 | "N_Defining_Character_Literal must match"; | |
816 | end if; | |
817 | ||
818 | if Type_Table (N_Defining_Operator_Symbol).Fields /= | |
819 | Type_Table (N_Defining_Identifier).Fields | |
820 | then | |
821 | raise Illegal with | |
822 | "fields for N_Defining_Identifier and " & | |
823 | "N_Defining_Operator_Symbol must match"; | |
824 | end if; | |
825 | ||
826 | if Fields_Per_Node (N_Defining_Character_Literal) /= | |
827 | Fields_Per_Node (N_Defining_Identifier) | |
828 | then | |
829 | raise Illegal with | |
830 | "Fields of N_Defining_Character_Literal must match " & | |
831 | "N_Defining_Identifier"; | |
832 | end if; | |
833 | ||
834 | if Fields_Per_Node (N_Defining_Operator_Symbol) /= | |
835 | Fields_Per_Node (N_Defining_Identifier) | |
836 | then | |
837 | raise Illegal with | |
838 | "Fields of N_Defining_Operator_Symbol must match " & | |
839 | "N_Defining_Identifier"; | |
840 | end if; | |
841 | ||
842 | -- Copy node fields from N_Entity nodes to entities, so they have | |
843 | -- slots allocated (but the getters and setters are only in | |
844 | -- Sinfo.Nodes). | |
845 | ||
846 | Type_Table (Entity_Kind).Fields := | |
847 | Type_Table (N_Defining_Identifier).Fields & | |
848 | Type_Table (Entity_Kind).Fields; | |
849 | ||
850 | for CT in Concrete_Entity loop | |
851 | Do_Concrete_Type (CT); | |
852 | end loop; | |
853 | ||
854 | if Duplicate_Fields_Found then | |
855 | raise Illegal with "duplicate fields found"; | |
856 | end if; | |
857 | end Compute_Fields_Per_Node; | |
858 | ||
859 | function Field_Size (T : Type_Enum) return Bit_Offset is | |
860 | (case T is | |
9324e07d | 861 | when Flag => 1, |
a7cadd18 | 862 | |
76f9c7f4 | 863 | when Small_Paren_Count_Type | Component_Alignment_Kind => 2, |
a7cadd18 BD |
864 | |
865 | when Node_Kind_Type | Entity_Kind_Type | Convention_Id => 8, | |
866 | ||
161e2202 BD |
867 | when Mechanism_Type |
868 | | List_Id | |
869 | | Elist_Id | |
870 | | Name_Id | |
871 | | String_Id | |
872 | | Uint | |
0c8ff35e | 873 | | Uint_Subtype |
161e2202 BD |
874 | | Ureal |
875 | | Source_Ptr | |
876 | | Union_Id | |
877 | | Node_Id | |
878 | | Node_Or_Entity_Type => 32, | |
a7cadd18 | 879 | |
76f9c7f4 BD |
880 | when Between_Special_And_Abstract_Node_Types => -- can't happen |
881 | Bit_Offset'Last); | |
161e2202 BD |
882 | -- Size in bits of a a field of type T. It must be a power of 2, and |
883 | -- must match the size of the type in GNAT, which sometimes requires | |
884 | -- a Size clause in GNAT. | |
885 | -- | |
76f9c7f4 BD |
886 | -- Note that this is not the same as Type_Bit_Size of the field's |
887 | -- type. For one thing, Type_Bit_Size only covers concrete node and | |
888 | -- entity types, which does not include most of the above. For | |
889 | -- another thing, Type_Bit_Size includes the full size of all the | |
890 | -- fields, whereas a field of a node or entity type is just a 32-bit | |
891 | -- Node_Id or Entity_Id; i.e. it is indirect. | |
892 | ||
893 | function Field_Size (F : Field_Enum) return Bit_Offset is | |
894 | (Field_Size (Field_Table (F).Field_Type)); | |
895 | ||
5fdd694a BD |
896 | function To_Bit_Offset (F : Field_Enum; Offset : Field_Offset'Base) |
897 | return Bit_Offset'Base is | |
898 | (Bit_Offset'Base (Offset) * Field_Size (F)); | |
76f9c7f4 BD |
899 | function First_Bit (F : Field_Enum; Offset : Field_Offset) |
900 | return Bit_Offset is | |
901 | (To_Bit_Offset (F, Offset)); | |
902 | function Last_Bit (F : Field_Enum; Offset : Field_Offset) | |
903 | return Bit_Offset is | |
904 | (To_Bit_Offset (F, Offset + 1) - 1); | |
905 | ||
906 | function To_Size_In_Slots (Size_In_Bits : Bit_Offset) | |
907 | return Field_Offset is | |
99e30ba8 | 908 | ((Field_Offset (Size_In_Bits) + (SS - 1)) / SS); |
76f9c7f4 BD |
909 | |
910 | function Type_Size_In_Slots (T : Concrete_Type) return Field_Offset is | |
911 | (To_Size_In_Slots (Type_Bit_Size (T))); -- rounded up to slot boundary | |
912 | ||
913 | function Type_Bit_Size_Aligned (T : Concrete_Type) return Bit_Offset is | |
99e30ba8 | 914 | (Bit_Offset (Type_Size_In_Slots (T)) * SS); -- multiple of slot size |
76f9c7f4 | 915 | |
a7cadd18 BD |
916 | --------------------------- |
917 | -- Compute_Field_Offsets -- | |
918 | --------------------------- | |
919 | ||
76f9c7f4 BD |
920 | procedure Compute_Field_Offsets is |
921 | type Offset_Set_Unconstrained is array (Bit_Offset range <>) | |
922 | of Boolean with Pack; | |
923 | subtype Offset_Set is Offset_Set_Unconstrained (Bit_Offset); | |
924 | Offset_Sets : array (Concrete_Type) of Offset_Set := | |
925 | (others => (others => False)); | |
926 | ||
927 | function All_False | |
928 | (F : Field_Enum; Offset : Field_Offset) | |
929 | return Offset_Set_Unconstrained is | |
930 | (First_Bit (F, Offset) .. Last_Bit (F, Offset) => False); | |
931 | ||
932 | function All_True | |
933 | (F : Field_Enum; Offset : Field_Offset) | |
934 | return Offset_Set_Unconstrained is | |
935 | (First_Bit (F, Offset) .. Last_Bit (F, Offset) => True); | |
936 | ||
937 | function Offset_OK | |
938 | (F : Field_Enum; Offset : Field_Offset) return Boolean; | |
939 | -- True if it is OK to choose this offset; that is, if this offset is | |
940 | -- not in use for any type that has the field. If Overlay_Fields is | |
941 | -- False, then "any type that has the field" --> "any type, whether | |
942 | -- or not it has the field". | |
943 | ||
a7cadd18 | 944 | procedure Set_Offset_In_Use |
76f9c7f4 BD |
945 | (F : Field_Enum; Offset : Field_Offset); |
946 | -- Mark the offset as "in use" | |
947 | ||
a6fe12b0 | 948 | procedure Choose_Offset (F : Field_Enum); |
76f9c7f4 BD |
949 | -- Choose an offset for this field |
950 | ||
951 | function Offset_OK | |
952 | (F : Field_Enum; Offset : Field_Offset) return Boolean is | |
953 | begin | |
954 | for T in Concrete_Type loop | |
955 | if Fields_Per_Node (T) (F) or else not Overlay_Fields then | |
956 | declare | |
957 | Bits : Offset_Set_Unconstrained renames | |
958 | Offset_Sets (T) | |
959 | (First_Bit (F, Offset) .. Last_Bit (F, Offset)); | |
960 | begin | |
961 | if Bits /= All_False (F, Offset) then | |
962 | return False; | |
963 | end if; | |
964 | end; | |
965 | end if; | |
966 | end loop; | |
967 | ||
968 | return True; | |
969 | end Offset_OK; | |
970 | ||
a7cadd18 | 971 | procedure Set_Offset_In_Use |
76f9c7f4 BD |
972 | (F : Field_Enum; Offset : Field_Offset) is |
973 | begin | |
974 | for T in Concrete_Type loop | |
975 | if Fields_Per_Node (T) (F) then | |
976 | declare | |
977 | Bits : Offset_Set_Unconstrained renames | |
978 | Offset_Sets (T) | |
979 | (First_Bit (F, Offset) .. Last_Bit (F, Offset)); | |
980 | begin | |
981 | pragma Assert (Bits = All_False (F, Offset)); | |
982 | Bits := All_True (F, Offset); | |
983 | end; | |
984 | end if; | |
985 | end loop; | |
a7cadd18 | 986 | end Set_Offset_In_Use; |
76f9c7f4 | 987 | |
a6fe12b0 | 988 | procedure Choose_Offset (F : Field_Enum) is |
76f9c7f4 BD |
989 | begin |
990 | for Offset in Field_Offset loop | |
991 | if Offset_OK (F, Offset) then | |
a7cadd18 | 992 | Set_Offset_In_Use (F, Offset); |
76f9c7f4 | 993 | |
a6fe12b0 BD |
994 | Field_Table (F).Offset := Offset; |
995 | return; | |
76f9c7f4 BD |
996 | end if; |
997 | end loop; | |
998 | ||
5fdd694a BD |
999 | raise Illegal with "No available field offset for " & Image (F) & |
1000 | "; need to increase Gen_IL.Internals.Bit_Offset'Last (" & | |
1001 | Image (Gen_IL.Internals.Bit_Offset'Last) & " is too small)"; | |
76f9c7f4 BD |
1002 | end Choose_Offset; |
1003 | ||
3f561db7 | 1004 | Weighted_Node_Frequency : array (Field_Enum) of Type_Count := |
76f9c7f4 BD |
1005 | (others => 0); |
1006 | -- Number of concrete types that have each field | |
1007 | ||
1008 | function More_Types_Have_Field (F1, F2 : Field_Enum) return Boolean is | |
3f561db7 | 1009 | (Weighted_Node_Frequency (F1) > Weighted_Node_Frequency (F2)); |
76f9c7f4 BD |
1010 | -- True if F1 appears in more concrete types than F2 |
1011 | ||
1012 | function Sort_Less (F1, F2 : Field_Enum) return Boolean is | |
3f561db7 | 1013 | (if Weighted_Node_Frequency (F1) = Weighted_Node_Frequency (F2) then |
76f9c7f4 BD |
1014 | F1 < F2 |
1015 | else More_Types_Have_Field (F1, F2)); | |
1016 | ||
1017 | package Sorting is new Field_Vectors.Generic_Sorting | |
1018 | ("<" => Sort_Less); | |
1019 | ||
1020 | All_Fields : Field_Vector; | |
1021 | ||
3f561db7 BD |
1022 | -- Start of processing for Compute_Field_Offsets |
1023 | ||
76f9c7f4 BD |
1024 | begin |
1025 | ||
3f561db7 BD |
1026 | -- Compute the number of types that have each field, weighted by the |
1027 | -- frequency of such nodes. | |
76f9c7f4 BD |
1028 | |
1029 | for T in Concrete_Type loop | |
1030 | for F in Field_Enum loop | |
1031 | if Fields_Per_Node (T) (F) then | |
3f561db7 BD |
1032 | Weighted_Node_Frequency (F) := |
1033 | Weighted_Node_Frequency (F) + Type_Frequency (T); | |
76f9c7f4 BD |
1034 | end if; |
1035 | end loop; | |
1036 | end loop; | |
1037 | ||
1038 | -- Collect all the fields in All_Fields | |
1039 | ||
1040 | for F in Node_Field loop | |
1041 | Append (All_Fields, F); | |
1042 | end loop; | |
1043 | ||
1044 | for F in Entity_Field loop | |
1045 | Append (All_Fields, F); | |
1046 | end loop; | |
1047 | ||
1048 | -- Sort All_Fields based on how many concrete types have the field. | |
161e2202 BD |
1049 | -- This is for efficiency; we want to choose the offsets of the most |
1050 | -- common fields first, so they get low numbers. | |
76f9c7f4 BD |
1051 | |
1052 | Sorting.Sort (All_Fields); | |
1053 | ||
1054 | -- Go through all the fields, and choose the lowest offset that is | |
161e2202 BD |
1055 | -- free in all types that have the field. This is basically a |
1056 | -- graph-coloring algorithm on the interference graph. The | |
1057 | -- interference graph is an undirected graph with the fields being | |
1058 | -- nodes (not nodes in the compiler!) in the graph, and an edge | |
1059 | -- between a pair of fields if they appear in the same node in the | |
1060 | -- compiler. The "colors" are fields offsets, except that a | |
1061 | -- complication compared to standard graph coloring is that fields | |
1062 | -- are different sizes. | |
76f9c7f4 | 1063 | |
a6fe12b0 BD |
1064 | -- First choose offsets for some heavily-used fields, so they will |
1065 | -- get low offsets, so they will wind up in the node header for | |
1066 | -- faster access. | |
1067 | ||
3f561db7 BD |
1068 | Choose_Offset (Nkind); |
1069 | pragma Assert (Field_Table (Nkind).Offset = 0); | |
1070 | Choose_Offset (Ekind); | |
1071 | pragma Assert (Field_Table (Ekind).Offset = 1); | |
a6fe12b0 | 1072 | Choose_Offset (Homonym); |
3f561db7 BD |
1073 | pragma Assert (Field_Table (Homonym).Offset = 1); |
1074 | Choose_Offset (Is_Immediately_Visible); | |
1075 | pragma Assert (Field_Table (Is_Immediately_Visible).Offset = 16); | |
1076 | Choose_Offset (From_Limited_With); | |
1077 | pragma Assert (Field_Table (From_Limited_With).Offset = 17); | |
1078 | Choose_Offset (Is_Potentially_Use_Visible); | |
1079 | pragma Assert (Field_Table (Is_Potentially_Use_Visible).Offset = 18); | |
1080 | Choose_Offset (Is_Generic_Instance); | |
1081 | pragma Assert (Field_Table (Is_Generic_Instance).Offset = 19); | |
1082 | Choose_Offset (Scope); | |
1083 | pragma Assert (Field_Table (Scope).Offset = 2); | |
a6fe12b0 BD |
1084 | |
1085 | -- Then loop through them all, skipping the ones we did above | |
1086 | ||
76f9c7f4 | 1087 | for F of All_Fields loop |
a6fe12b0 BD |
1088 | if Field_Table (F).Offset = Unknown_Offset then |
1089 | Choose_Offset (F); | |
1090 | end if; | |
76f9c7f4 BD |
1091 | end loop; |
1092 | ||
1093 | end Compute_Field_Offsets; | |
1094 | ||
a7cadd18 BD |
1095 | ------------------------ |
1096 | -- Compute_Type_Sizes -- | |
1097 | ------------------------ | |
1098 | ||
76f9c7f4 | 1099 | procedure Compute_Type_Sizes is |
76f9c7f4 BD |
1100 | begin |
1101 | for T in Concrete_Type loop | |
1102 | declare | |
1103 | Max_Offset : Bit_Offset := 0; | |
1104 | ||
1105 | begin | |
1106 | for F in Field_Enum loop | |
1107 | if Fields_Per_Node (T) (F) then | |
1108 | Max_Offset := | |
1109 | Bit_Offset'Max | |
1110 | (Max_Offset, | |
1111 | To_Bit_Offset (F, Field_Table (F).Offset)); | |
1112 | end if; | |
1113 | end loop; | |
1114 | ||
99e30ba8 BD |
1115 | -- No type can be smaller than the header slots |
1116 | ||
1117 | Type_Bit_Size (T) := | |
1118 | Bit_Offset'Max (Max_Offset + 1, SS * Num_Header_Slots); | |
76f9c7f4 BD |
1119 | end; |
1120 | end loop; | |
1121 | ||
1122 | for T in Concrete_Node loop | |
1123 | Min_Node_Bit_Size := | |
1124 | Bit_Offset'Min (Min_Node_Bit_Size, Type_Bit_Size (T)); | |
1125 | Max_Node_Bit_Size := | |
1126 | Bit_Offset'Max (Max_Node_Bit_Size, Type_Bit_Size (T)); | |
1127 | end loop; | |
1128 | ||
1129 | for T in Concrete_Entity loop | |
1130 | Min_Entity_Bit_Size := | |
1131 | Bit_Offset'Min (Min_Entity_Bit_Size, Type_Bit_Size (T)); | |
1132 | Max_Entity_Bit_Size := | |
1133 | Bit_Offset'Max (Max_Entity_Bit_Size, Type_Bit_Size (T)); | |
1134 | end loop; | |
1135 | ||
1136 | Min_Node_Size := To_Size_In_Slots (Min_Node_Bit_Size); | |
1137 | Max_Node_Size := To_Size_In_Slots (Max_Node_Bit_Size); | |
1138 | Min_Entity_Size := To_Size_In_Slots (Min_Entity_Bit_Size); | |
1139 | Max_Entity_Size := To_Size_In_Slots (Max_Entity_Bit_Size); | |
76f9c7f4 BD |
1140 | end Compute_Type_Sizes; |
1141 | ||
a7cadd18 BD |
1142 | ---------------------------------------- |
1143 | -- Check_For_Syntactic_Field_Mismatch -- | |
1144 | ---------------------------------------- | |
1145 | ||
1146 | procedure Check_For_Syntactic_Field_Mismatch is | |
76f9c7f4 BD |
1147 | begin |
1148 | for F in Field_Enum loop | |
1149 | if F /= Between_Node_And_Entity_Fields then | |
1150 | declare | |
1151 | Syntactic_Seen, Semantic_Seen : Boolean := False; | |
1152 | Have_Field : Type_Vector renames | |
1153 | Field_Table (F).Have_This_Field; | |
1154 | ||
1155 | begin | |
1156 | for J in 1 .. Last_Index (Have_Field) loop | |
a7cadd18 | 1157 | if Syntactic (Have_Field (J)) (F) then |
76f9c7f4 BD |
1158 | Syntactic_Seen := True; |
1159 | else | |
1160 | Semantic_Seen := True; | |
1161 | end if; | |
1162 | end loop; | |
1163 | ||
1164 | -- The following fields violate this rule. We might want to | |
1165 | -- simplify by getting rid of these cases, but we allow them | |
1166 | -- for now. At least, we don't want to add any new cases of | |
1167 | -- syntactic/semantic mismatch. | |
1168 | ||
1169 | if F in Chars | Actions | Expression | Default_Expression | |
1170 | then | |
1171 | pragma Assert (Syntactic_Seen and Semantic_Seen); | |
1172 | ||
1173 | else | |
1174 | if Syntactic_Seen and Semantic_Seen then | |
1175 | raise Illegal with | |
1176 | "syntactic/semantic mismatch for " & Image (F); | |
1177 | end if; | |
1178 | ||
a7cadd18 | 1179 | if Field_Table (F).Field_Type in Traversed_Field_Type |
76f9c7f4 BD |
1180 | and then Syntactic_Seen |
1181 | then | |
1182 | Setter_Needs_Parent (F) := True; | |
1183 | end if; | |
1184 | end if; | |
1185 | end; | |
1186 | end if; | |
1187 | end loop; | |
a7cadd18 BD |
1188 | end Check_For_Syntactic_Field_Mismatch; |
1189 | ||
1190 | ---------------------- | |
1191 | -- Field_Types_Used -- | |
1192 | ---------------------- | |
76f9c7f4 BD |
1193 | |
1194 | function Field_Types_Used (First, Last : Field_Enum) return Type_Set is | |
1195 | Result : Type_Set := (others => False); | |
1196 | begin | |
1197 | for F in First .. Last loop | |
1198 | if Field_Table (F).Field_Type in Node_Or_Entity_Type then | |
1199 | Result (Node_Id) := True; | |
36e38022 BD |
1200 | |
1201 | -- Subtypes of Uint all use the same Cast for Uint | |
1202 | ||
1203 | elsif Field_Table (F).Field_Type in Uint_Subtype then | |
1204 | Result (Uint) := True; | |
1205 | ||
76f9c7f4 BD |
1206 | else |
1207 | Result (Field_Table (F).Field_Type) := True; | |
1208 | end if; | |
1209 | end loop; | |
1210 | ||
1211 | return Result; | |
1212 | end Field_Types_Used; | |
1213 | ||
1214 | pragma Style_Checks ("M120"); | |
1215 | -- Lines of the form Put (S, "..."); are more readable if we relax the | |
1216 | -- line length. We really just want the "..." to be short enough. | |
1217 | ||
a7cadd18 BD |
1218 | --------------------------- |
1219 | -- Put_Type_And_Subtypes -- | |
1220 | --------------------------- | |
1221 | ||
76f9c7f4 | 1222 | procedure Put_Type_And_Subtypes |
20922782 | 1223 | (S : in out Sink; Root : Root_Type) |
76f9c7f4 BD |
1224 | is |
1225 | ||
1226 | procedure Put_Enum_Type; | |
1227 | -- Print out the enumeration type declaration for a root type | |
1228 | -- (Node_Kind or Entity_Kind). | |
1229 | ||
1230 | procedure Put_Kind_Subtype (T : Node_Or_Entity_Type); | |
1231 | -- Print out a subrange (of type Node_Kind or Entity_Kind) for a | |
1232 | -- given nonroot abstract type. | |
1233 | ||
1234 | procedure Put_Id_Subtype (T : Node_Or_Entity_Type); | |
1235 | -- Print out a subtype (of type Node_Id or Entity_Id) for a given | |
1236 | -- nonroot abstract type. | |
1237 | ||
bd413702 BD |
1238 | procedure Put_Opt_Subtype (T : Node_Or_Entity_Type); |
1239 | -- Print out an "optional" subtype; that is, one that allows | |
1240 | -- Empty. Their names start with "Opt_". | |
1241 | ||
76f9c7f4 BD |
1242 | procedure Put_Enum_Type is |
1243 | procedure Put_Enum_Lit (T : Node_Or_Entity_Type); | |
1244 | -- Print out one enumeration literal in the declaration of | |
1245 | -- Node_Kind or Entity_Kind. | |
1246 | ||
1247 | First_Time : Boolean := True; | |
1248 | ||
1249 | procedure Put_Enum_Lit (T : Node_Or_Entity_Type) is | |
1250 | begin | |
1251 | if T in Concrete_Type then | |
1252 | if First_Time then | |
1253 | First_Time := False; | |
1254 | else | |
20922782 | 1255 | Put (S, "," & LF); |
76f9c7f4 BD |
1256 | end if; |
1257 | ||
20922782 | 1258 | Put (S, Image (T)); |
76f9c7f4 BD |
1259 | end if; |
1260 | end Put_Enum_Lit; | |
1261 | ||
1262 | type Dummy is array | |
1263 | (First_Concrete (Root) .. Last_Concrete (Root)) of Boolean; | |
1264 | Num_Types : constant Root_Int := Dummy'Length; | |
1265 | ||
1266 | begin | |
20922782 SB |
1267 | Put (S, "type " & Image (Root) & " is -- " & |
1268 | Image (Num_Types) & " " & Image (Root) & "s" & LF); | |
1269 | Increase_Indent (S, 2); | |
76f9c7f4 | 1270 | Put (S, "("); |
20922782 | 1271 | Increase_Indent (S, 1); |
76f9c7f4 | 1272 | Iterate_Types (Root, Pre => Put_Enum_Lit'Access); |
20922782 SB |
1273 | Decrease_Indent (S, 1); |
1274 | Put (S, LF & ") with Size => 8; -- " & Image (Root) & LF & LF); | |
1275 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
1276 | end Put_Enum_Type; |
1277 | ||
1278 | procedure Put_Kind_Subtype (T : Node_Or_Entity_Type) is | |
1279 | begin | |
1280 | if T in Abstract_Type then | |
1281 | if Type_Table (T).Is_Union then | |
1282 | pragma Assert (Type_Table (T).Parent = Root); | |
1283 | ||
20922782 SB |
1284 | Put (S, "subtype " & Image (T) & " is" & LF); |
1285 | Increase_Indent (S, 2); | |
1286 | Put (S, Image (Root) & " with Predicate =>" & LF); | |
1287 | Increase_Indent (S, 2); | |
1288 | Put (S, Image (T) & " in" & LF); | |
a7cadd18 | 1289 | Put_Types_With_Bars (S, Type_Table (T).Children); |
20922782 SB |
1290 | Decrease_Indent (S, 2); |
1291 | Put (S, ";" & LF); | |
1292 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
1293 | |
1294 | elsif Type_Table (T).Parent /= No_Type then | |
20922782 SB |
1295 | Put (S, "subtype " & Image (T) & " is " & |
1296 | Image (Type_Table (T).Parent) & " range" & LF); | |
1297 | Increase_Indent (S, 2); | |
1298 | Put (S, Image (Type_Table (T).First) & " .. " & | |
1299 | Image (Type_Table (T).Last) & ";" & LF); | |
1300 | Decrease_Indent (S, 2); | |
76f9c7f4 | 1301 | |
20922782 | 1302 | Increase_Indent (S, 3); |
76f9c7f4 BD |
1303 | |
1304 | for J in 1 .. Type_Table (T).Concrete_Descendants.Last_Index loop | |
20922782 SB |
1305 | Put (S, "-- " & |
1306 | Image (Type_Table (T).Concrete_Descendants (J)) & LF); | |
76f9c7f4 BD |
1307 | end loop; |
1308 | ||
20922782 | 1309 | Decrease_Indent (S, 3); |
76f9c7f4 BD |
1310 | end if; |
1311 | end if; | |
1312 | end Put_Kind_Subtype; | |
1313 | ||
1314 | procedure Put_Id_Subtype (T : Node_Or_Entity_Type) is | |
1315 | begin | |
76f9c7f4 | 1316 | if Type_Table (T).Parent /= No_Type then |
20922782 SB |
1317 | Put (S, "subtype " & Id_Image (T) & " is" & LF); |
1318 | Increase_Indent (S, 2); | |
1319 | Put (S, Id_Image (Type_Table (T).Parent)); | |
76f9c7f4 BD |
1320 | |
1321 | if Enable_Assertions then | |
20922782 SB |
1322 | Put (S, " with Predicate =>" & LF); |
1323 | Increase_Indent (S, 2); | |
1324 | Put (S, "K (" & Id_Image (T) & ") in " & Image (T)); | |
1325 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
1326 | end if; |
1327 | ||
20922782 SB |
1328 | Put (S, ";" & LF); |
1329 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
1330 | end if; |
1331 | end Put_Id_Subtype; | |
1332 | ||
bd413702 BD |
1333 | procedure Put_Opt_Subtype (T : Node_Or_Entity_Type) is |
1334 | begin | |
1335 | if Type_Table (T).Parent /= No_Type then | |
e8391687 | 1336 | Put (S, "subtype Opt_" & Id_Image (T) & " is" & LF); |
bd413702 BD |
1337 | Increase_Indent (S, 2); |
1338 | Put (S, Id_Image (Root)); | |
1339 | ||
1340 | -- Assert that the Opt_XXX subtype is empty or in the XXX | |
1341 | -- subtype. | |
1342 | ||
1343 | if Enable_Assertions then | |
1344 | Put (S, " with Predicate =>" & LF); | |
1345 | Increase_Indent (S, 2); | |
e8391687 YM |
1346 | Put (S, "Opt_" & Id_Image (T) & " = Empty or else" & LF); |
1347 | Put (S, "Opt_" & Id_Image (T) & " in " & Id_Image (T)); | |
bd413702 BD |
1348 | Decrease_Indent (S, 2); |
1349 | end if; | |
1350 | ||
1351 | Put (S, ";" & LF); | |
1352 | Decrease_Indent (S, 2); | |
1353 | end if; | |
1354 | end Put_Opt_Subtype; | |
1355 | ||
76f9c7f4 BD |
1356 | begin -- Put_Type_And_Subtypes |
1357 | Put_Enum_Type; | |
1358 | ||
1359 | -- Put the getter for Nkind and Ekind here, earlier than the other | |
1360 | -- getters, because it is needed in predicates of the following | |
1361 | -- subtypes. | |
1362 | ||
1363 | case Root is | |
1364 | when Node_Kind => | |
1365 | Put_Getter_Decl (S, Nkind); | |
3f561db7 | 1366 | Put (S, "function K (N : Node_Id) return Node_Kind renames " & Image (Nkind) & ";" & LF); |
20922782 SB |
1367 | Put (S, "-- Shorthand for use in predicates and preconditions below" & LF); |
1368 | Put (S, "-- There is no procedure Set_Nkind." & LF); | |
1369 | Put (S, "-- See Init_Nkind and Mutate_Nkind in Atree." & LF & LF); | |
76f9c7f4 BD |
1370 | |
1371 | when Entity_Kind => | |
1372 | Put_Getter_Decl (S, Ekind); | |
20922782 SB |
1373 | Put (S, "function K (N : Entity_Id) return Entity_Kind renames Ekind;" & LF); |
1374 | Put (S, "-- Shorthand for use in predicates and preconditions below" & LF); | |
1375 | Put (S, "-- There is no procedure Set_Ekind here." & LF); | |
1376 | Put (S, "-- See Mutate_Ekind in Atree." & LF & LF); | |
76f9c7f4 BD |
1377 | |
1378 | when others => raise Program_Error; | |
1379 | end case; | |
1380 | ||
20922782 | 1381 | Put (S, "-- Subtypes of " & Image (Root) & " for each abstract type:" & LF & LF); |
76f9c7f4 | 1382 | |
20922782 | 1383 | Put (S, "pragma Style_Checks (""M200"");" & LF); |
76f9c7f4 BD |
1384 | Iterate_Types (Root, Pre => Put_Kind_Subtype'Access); |
1385 | ||
20922782 SB |
1386 | Put (S, LF & "-- Subtypes of " & Id_Image (Root) & |
1387 | " with specified " & Image (Root) & "." & LF); | |
1388 | Put (S, "-- These may be used in place of " & Id_Image (Root) & | |
1389 | " for better documentation," & LF); | |
1390 | Put (S, "-- and if assertions are enabled, for run-time checking." & LF & LF); | |
76f9c7f4 BD |
1391 | |
1392 | Iterate_Types (Root, Pre => Put_Id_Subtype'Access); | |
76f9c7f4 | 1393 | |
20922782 SB |
1394 | Put (S, LF & "-- Union types (nonhierarchical subtypes of " & |
1395 | Id_Image (Root) & ")" & LF & LF); | |
76f9c7f4 BD |
1396 | |
1397 | for T in First_Abstract (Root) .. Last_Abstract (Root) loop | |
1398 | if Type_Table (T) /= null and then Type_Table (T).Is_Union then | |
1399 | Put_Kind_Subtype (T); | |
1400 | Put_Id_Subtype (T); | |
76f9c7f4 BD |
1401 | end if; |
1402 | end loop; | |
1403 | ||
bd413702 BD |
1404 | Put (S, LF & "-- Optional subtypes of " & Id_Image (Root) & "." & |
1405 | " These allow Empty." & LF & LF); | |
1406 | ||
1407 | Iterate_Types (Root, Pre => Put_Opt_Subtype'Access); | |
1408 | ||
1409 | Put (S, LF & "-- Optional union types:" & LF & LF); | |
1410 | ||
1411 | for T in First_Abstract (Root) .. Last_Abstract (Root) loop | |
1412 | if Type_Table (T) /= null and then Type_Table (T).Is_Union then | |
1413 | Put_Opt_Subtype (T); | |
1414 | end if; | |
1415 | end loop; | |
1416 | ||
1417 | Put (S, LF & "subtype Flag is Boolean;" & LF & LF); | |
76f9c7f4 BD |
1418 | end Put_Type_And_Subtypes; |
1419 | ||
a7cadd18 | 1420 | ------------------------------------------- |
99e30ba8 | 1421 | -- Put_Casts -- |
a7cadd18 BD |
1422 | ------------------------------------------- |
1423 | ||
99e30ba8 | 1424 | procedure Put_Casts |
20922782 | 1425 | (S : in out Sink; T : Type_Enum) |
76f9c7f4 | 1426 | is |
99e30ba8 | 1427 | Pre : constant String := |
83bacaa9 | 1428 | "function Cast is new Ada.Unchecked_Conversion ("; |
99e30ba8 BD |
1429 | Lo_Type : constant String := "Field_Size_" & Image (Field_Size (T)) & "_Bit"; |
1430 | Hi_Type : constant String := Get_Set_Id_Image (T); | |
76f9c7f4 | 1431 | begin |
99e30ba8 BD |
1432 | if T not in Uint_Subtype then |
1433 | if T not in Node_Kind_Type | Entity_Kind_Type then | |
1434 | Put (S, Pre & Hi_Type & ", " & Lo_Type & ");" & LF); | |
1435 | end if; | |
76f9c7f4 | 1436 | |
99e30ba8 | 1437 | Put (S, Pre & Lo_Type & ", " & Hi_Type & ");" & LF); |
76f9c7f4 | 1438 | end if; |
99e30ba8 | 1439 | end Put_Casts; |
a7cadd18 BD |
1440 | |
1441 | ---------------------- | |
1442 | -- Put_Precondition -- | |
1443 | ---------------------- | |
76f9c7f4 BD |
1444 | |
1445 | procedure Put_Precondition | |
20922782 | 1446 | (S : in out Sink; F : Field_Enum) |
76f9c7f4 BD |
1447 | is |
1448 | -- If the field is present in all entities, we want to assert that | |
1449 | -- N in N_Entity_Id. If the field is present in only some entities, | |
1450 | -- we don't need that, because we are fetching Ekind in that case, | |
1451 | -- which will assert N in N_Entity_Id. | |
1452 | ||
1453 | Is_Entity : constant String := | |
1454 | (if Field_Table (F).Have_This_Field = All_Entities then | |
1455 | "N in N_Entity_Id" | |
1456 | else ""); | |
1457 | begin | |
1458 | -- If this is an entity field, then we should assert that N is an | |
1459 | -- entity. We need "N in A | B | ..." unless this is embodied in a | |
1460 | -- subtype predicate. | |
1461 | -- | |
1462 | -- We can't put the extra "Pre => ..." specified on the call to | |
1463 | -- Create_..._Field as part of the precondition, because some of | |
1464 | -- them call things that are not visible here. | |
1465 | ||
1466 | if Enable_Assertions then | |
1467 | if Length (Field_Table (F).Have_This_Field) = 1 | |
1468 | or else Field_Table (F).Have_This_Field = Nodes_And_Entities | |
1469 | then | |
1470 | if Is_Entity /= "" then | |
20922782 SB |
1471 | Increase_Indent (S, 1); |
1472 | Put (S, ", Pre =>" & LF); | |
1473 | Put (S, Is_Entity); | |
1474 | Decrease_Indent (S, 1); | |
76f9c7f4 BD |
1475 | end if; |
1476 | ||
1477 | else | |
20922782 SB |
1478 | Put (S, ", Pre =>" & LF); |
1479 | Increase_Indent (S, 1); | |
76f9c7f4 | 1480 | Put (S, "N in "); |
a7cadd18 | 1481 | Put_Type_Ids_With_Bars (S, Field_Table (F).Have_This_Field); |
76f9c7f4 BD |
1482 | |
1483 | pragma Assert (Is_Entity = ""); | |
1484 | ||
20922782 | 1485 | Decrease_Indent (S, 1); |
76f9c7f4 BD |
1486 | end if; |
1487 | end if; | |
1488 | end Put_Precondition; | |
1489 | ||
1490 | function Root_Type_For_Field (F : Field_Enum) return Root_Type is | |
1491 | (case F is | |
1492 | when Node_Field => Node_Kind, | |
1493 | when Entity_Field => Entity_Kind, | |
1494 | when Between_Node_And_Entity_Fields => Node_Kind); -- can't happen | |
1495 | ||
1496 | function N_Type (F : Field_Enum) return String is | |
1497 | (if Length (Field_Table (F).Have_This_Field) = 1 then | |
1498 | Id_Image (Field_Table (F).Have_This_Field (1)) | |
1499 | else Id_Image (Root_Type_For_Field (F))); | |
1500 | -- Name of the parameter type of the N parameter of the getter and | |
1501 | -- setter for field F. If there's only one Have_This_Field, use that; | |
1502 | -- the predicate will check for the right Kind. Otherwise, we use | |
1503 | -- Node_Id or Entity_Id, and the getter and setter will have | |
1504 | -- preconditions. | |
1505 | ||
a6fe12b0 BD |
1506 | procedure Put_Get_Set_Incr |
1507 | (S : in out Sink; F : Field_Enum; Get_Or_Set : String) | |
1508 | with Pre => Get_Or_Set in "Get" | "Set"; | |
1509 | -- If statistics are enabled, put the appropriate increment statement | |
1510 | ||
1511 | ---------------------- | |
1512 | -- Put_Get_Set_Incr -- | |
1513 | ---------------------- | |
1514 | ||
1515 | procedure Put_Get_Set_Incr | |
1516 | (S : in out Sink; F : Field_Enum; Get_Or_Set : String) is | |
1517 | begin | |
1518 | if Statistics_Enabled then | |
1519 | Put (S, "Atree." & Get_Or_Set & "_Count (" & F_Image (F) & | |
1520 | ") := Atree." & Get_Or_Set & "_Count (" & | |
1521 | F_Image (F) & ") + 1;" & LF); | |
1522 | end if; | |
1523 | end Put_Get_Set_Incr; | |
1524 | ||
a7cadd18 BD |
1525 | ------------------------ |
1526 | -- Node_To_Fetch_From -- | |
1527 | ------------------------ | |
1528 | ||
76f9c7f4 BD |
1529 | function Node_To_Fetch_From (F : Field_Enum) return String is |
1530 | begin | |
1531 | return | |
1532 | (case Field_Table (F).Type_Only is | |
1533 | when No_Type_Only => "N", | |
1534 | when Base_Type_Only => "Base_Type (N)", | |
1535 | when Impl_Base_Type_Only => "Implementation_Base_Type (N)", | |
1536 | when Root_Type_Only => "Root_Type (N)"); | |
1537 | end Node_To_Fetch_From; | |
1538 | ||
a7cadd18 BD |
1539 | --------------------- |
1540 | -- Put_Getter_Spec -- | |
1541 | --------------------- | |
1542 | ||
20922782 | 1543 | procedure Put_Getter_Spec (S : in out Sink; F : Field_Enum) is |
76f9c7f4 | 1544 | begin |
0c8ff35e BD |
1545 | Put (S, "function " & Image (F)); |
1546 | Put (S, " (N : " & N_Type (F) & ") return " & | |
20922782 | 1547 | Get_Set_Id_Image (Field_Table (F).Field_Type)); |
76f9c7f4 BD |
1548 | end Put_Getter_Spec; |
1549 | ||
a7cadd18 BD |
1550 | --------------------- |
1551 | -- Put_Getter_Decl -- | |
1552 | --------------------- | |
1553 | ||
20922782 | 1554 | procedure Put_Getter_Decl (S : in out Sink; F : Field_Enum) is |
76f9c7f4 BD |
1555 | begin |
1556 | Put_Getter_Spec (S, F); | |
20922782 SB |
1557 | Put (S, " with " & Inline); |
1558 | Increase_Indent (S, 2); | |
76f9c7f4 | 1559 | Put_Precondition (S, F); |
20922782 SB |
1560 | Decrease_Indent (S, 2); |
1561 | Put (S, ";" & LF); | |
76f9c7f4 BD |
1562 | end Put_Getter_Decl; |
1563 | ||
99e30ba8 BD |
1564 | ------------------------------ |
1565 | -- Put_Getter_Setter_Locals -- | |
1566 | ------------------------------ | |
1567 | ||
1568 | procedure Put_Getter_Setter_Locals | |
1569 | (S : in out Sink; F : Field_Enum; Get : Boolean) | |
1570 | is | |
1571 | Rec : Field_Info renames Field_Table (F).all; | |
1572 | ||
99e30ba8 | 1573 | F_Size : constant Bit_Offset := Field_Size (Rec.Field_Type); |
3f561db7 | 1574 | Off : constant Field_Offset := Rec.Offset; |
99e30ba8 BD |
1575 | F_Per_Slot : constant Field_Offset := |
1576 | SS / Field_Offset (Field_Size (Rec.Field_Type)); | |
1577 | Slot_Off : constant Field_Offset := Off / F_Per_Slot; | |
1578 | In_NH : constant Boolean := Slot_Off < Num_Header_Slots; | |
1579 | ||
1580 | N : constant String := | |
1581 | (if Get then Node_To_Fetch_From (F) else "N"); | |
1582 | ||
1583 | begin | |
1584 | Put (S, " is" & LF); | |
1585 | Increase_Indent (S, 3); | |
1586 | Put (S, "-- " & Image (F_Per_Slot) & " " & Image (F_Size) & | |
1587 | "-bit fields per " & SSS & "-bit slot." & LF); | |
1588 | Put (S, "-- Offset " & Image (Off) & " = " & | |
1589 | Image (Slot_Off) & " slots + " & Image (Off mod F_Per_Slot) & | |
1590 | " fields in slot." & LF & LF); | |
1591 | ||
1592 | Put (S, "Off : constant := " & Image (Off) & ";" & LF); | |
1593 | Put (S, "F_Size : constant := " & Image (F_Size) & ";" & LF); | |
1594 | ||
1595 | if Field_Size (Rec.Field_Type) /= SS then | |
1596 | Put (S, "Mask : constant := 2**F_Size - 1;" & LF); | |
1597 | end if; | |
1598 | ||
1599 | Put (S, "F_Per_Slot : constant Field_Offset := Slot_Size / F_Size;" & LF); | |
1600 | Put (S, "Slot_Off : constant Field_Offset := Off / F_Per_Slot;" & LF); | |
1601 | ||
1602 | if In_NH then | |
1603 | Put (S, "S : Slot renames Node_Offsets.Table (" & N & ").Slots (Slot_Off);" & LF); | |
1604 | else | |
1605 | Put (S, "S : Slot renames Slots.Table (Node_Offsets.Table (" & N & ").Offset + Slot_Off);" & LF); | |
1606 | end if; | |
1607 | ||
1608 | if Field_Size (Rec.Field_Type) /= SS then | |
1609 | Put (S, "V : constant Natural := Natural ((Off mod F_Per_Slot) * F_Size);" & LF); | |
1610 | Put (S, LF); | |
1611 | end if; | |
1612 | end Put_Getter_Setter_Locals; | |
1613 | ||
a7cadd18 BD |
1614 | --------------------- |
1615 | -- Put_Getter_Body -- | |
1616 | --------------------- | |
1617 | ||
20922782 | 1618 | procedure Put_Getter_Body (S : in out Sink; F : Field_Enum) is |
a5db70e7 | 1619 | Rec : Field_Info renames Field_Table (F).all; |
99e30ba8 BD |
1620 | F_Size : constant Bit_Offset := Field_Size (Rec.Field_Type); |
1621 | T : constant String := Get_Set_Id_Image (Rec.Field_Type); | |
76f9c7f4 | 1622 | begin |
a5db70e7 BD |
1623 | -- Note that we store the result in a local constant below, so that |
1624 | -- the "Pre => ..." can refer to it. The constant is called Val so | |
1625 | -- that it has the same name as the formal of the setter, so the | |
1626 | -- "Pre => ..." can refer to it by the same name in both getter | |
1627 | -- and setter. | |
1628 | ||
76f9c7f4 | 1629 | Put_Getter_Spec (S, F); |
99e30ba8 BD |
1630 | Put_Getter_Setter_Locals (S, F, Get => True); |
1631 | ||
1632 | Put (S, "Raw : constant Field_Size_" & Image (F_Size) & "_Bit :=" & LF); | |
1633 | Increase_Indent (S, 2); | |
1634 | Put (S, "Field_Size_" & Image (F_Size) & "_Bit ("); | |
1635 | ||
1636 | if Field_Size (Rec.Field_Type) /= SS then | |
1637 | Put (S, "Shift_Right (S, V) and Mask);" & LF); | |
1638 | else | |
1639 | Put (S, "S);" & LF); | |
1640 | end if; | |
1641 | ||
1642 | Decrease_Indent (S, 2); | |
1643 | ||
1644 | Put (S, "Val : constant " & T & " :="); | |
1645 | ||
1646 | if Field_Has_Special_Default (Rec.Field_Type) then | |
1647 | pragma Assert (Field_Size (Rec.Field_Type) = 32); | |
1648 | Put (S, LF); | |
1649 | Increase_Indent (S, 2); | |
a6fe12b0 BD |
1650 | Put (S, "(if Raw = 0 then " & Special_Default (Rec.Field_Type) & |
1651 | " else " & "Cast (Raw));"); | |
99e30ba8 BD |
1652 | Decrease_Indent (S, 2); |
1653 | ||
1654 | else | |
1655 | Put (S, " Cast (Raw);"); | |
1656 | end if; | |
1657 | ||
1658 | Put (S, LF); | |
1659 | ||
20922782 SB |
1660 | Decrease_Indent (S, 3); |
1661 | Put (S, "begin" & LF); | |
1662 | Increase_Indent (S, 3); | |
76f9c7f4 | 1663 | |
99e30ba8 BD |
1664 | Put (S, "-- pragma Debug (Validate_Node_And_Offset (NN, Slot_Off));" & LF); |
1665 | -- Comment out the validation, because it's too slow, and because the | |
1666 | -- relevant routines in Atree are not visible. | |
1667 | ||
a5db70e7 | 1668 | if Rec.Pre.all /= "" then |
20922782 | 1669 | Put (S, "pragma Assert (" & Rec.Pre.all & ");" & LF); |
76f9c7f4 BD |
1670 | end if; |
1671 | ||
a7cadd18 | 1672 | if Rec.Pre_Get.all /= "" then |
20922782 | 1673 | Put (S, "pragma Assert (" & Rec.Pre_Get.all & ");" & LF); |
a7cadd18 BD |
1674 | end if; |
1675 | ||
a6fe12b0 | 1676 | Put_Get_Set_Incr (S, F, "Get"); |
20922782 SB |
1677 | Put (S, "return Val;" & LF); |
1678 | Decrease_Indent (S, 3); | |
1679 | Put (S, "end " & Image (F) & ";" & LF & LF); | |
76f9c7f4 BD |
1680 | end Put_Getter_Body; |
1681 | ||
a7cadd18 BD |
1682 | --------------------- |
1683 | -- Put_Setter_Spec -- | |
1684 | --------------------- | |
1685 | ||
20922782 | 1686 | procedure Put_Setter_Spec (S : in out Sink; F : Field_Enum) is |
76f9c7f4 BD |
1687 | Rec : Field_Info renames Field_Table (F).all; |
1688 | Default : constant String := | |
a5db70e7 | 1689 | (if Rec.Field_Type = Flag then " := True" else ""); |
76f9c7f4 | 1690 | begin |
0c8ff35e BD |
1691 | Put (S, "procedure Set_" & Image (F)); |
1692 | Put (S, " (N : " & N_Type (F) & "; Val : " & | |
20922782 | 1693 | Get_Set_Id_Image (Rec.Field_Type) & Default & ")"); |
76f9c7f4 BD |
1694 | end Put_Setter_Spec; |
1695 | ||
a7cadd18 BD |
1696 | --------------------- |
1697 | -- Put_Setter_Decl -- | |
1698 | --------------------- | |
1699 | ||
20922782 | 1700 | procedure Put_Setter_Decl (S : in out Sink; F : Field_Enum) is |
76f9c7f4 BD |
1701 | begin |
1702 | Put_Setter_Spec (S, F); | |
20922782 SB |
1703 | Put (S, " with " & Inline); |
1704 | Increase_Indent (S, 2); | |
76f9c7f4 | 1705 | Put_Precondition (S, F); |
20922782 SB |
1706 | Decrease_Indent (S, 2); |
1707 | Put (S, ";" & LF); | |
76f9c7f4 BD |
1708 | end Put_Setter_Decl; |
1709 | ||
a7cadd18 BD |
1710 | --------------------- |
1711 | -- Put_Setter_Body -- | |
1712 | --------------------- | |
1713 | ||
20922782 | 1714 | procedure Put_Setter_Body (S : in out Sink; F : Field_Enum) is |
a5db70e7 | 1715 | Rec : Field_Info renames Field_Table (F).all; |
99e30ba8 | 1716 | F_Size : constant Bit_Offset := Field_Size (Rec.Field_Type); |
a5db70e7 | 1717 | |
76f9c7f4 | 1718 | -- If Type_Only was specified in the call to Create_Semantic_Field, |
a7cadd18 BD |
1719 | -- then we assert that the node is a base type. We cannot assert that |
1720 | -- it is an implementation base type or a root type. | |
76f9c7f4 BD |
1721 | |
1722 | Type_Only_Assertion : constant String := | |
a5db70e7 | 1723 | (case Rec.Type_Only is |
76f9c7f4 | 1724 | when No_Type_Only => "", |
a7cadd18 BD |
1725 | when Base_Type_Only | Impl_Base_Type_Only | Root_Type_Only => |
1726 | "Is_Base_Type (N)"); | |
76f9c7f4 BD |
1727 | begin |
1728 | Put_Setter_Spec (S, F); | |
99e30ba8 BD |
1729 | Put_Getter_Setter_Locals (S, F, Get => False); |
1730 | ||
1731 | Put (S, "Raw : constant Field_Size_" & Image (F_Size) & "_Bit := Cast (Val);" & LF); | |
1732 | ||
1733 | Decrease_Indent (S, 3); | |
20922782 SB |
1734 | Put (S, "begin" & LF); |
1735 | Increase_Indent (S, 3); | |
76f9c7f4 | 1736 | |
99e30ba8 BD |
1737 | Put (S, "-- pragma Debug (Validate_Node_And_Offset_Write (N, Slot_Off));" & LF); |
1738 | -- Comment out the validation, because it's too slow, and because the | |
1739 | -- relevant routines in Atree are not visible. | |
1740 | ||
a5db70e7 | 1741 | if Rec.Pre.all /= "" then |
20922782 | 1742 | Put (S, "pragma Assert (" & Rec.Pre.all & ");" & LF); |
76f9c7f4 BD |
1743 | end if; |
1744 | ||
a7cadd18 | 1745 | if Rec.Pre_Set.all /= "" then |
20922782 | 1746 | Put (S, "pragma Assert (" & Rec.Pre_Set.all & ");" & LF); |
a7cadd18 BD |
1747 | end if; |
1748 | ||
76f9c7f4 | 1749 | if Type_Only_Assertion /= "" then |
20922782 | 1750 | Put (S, "pragma Assert (" & Type_Only_Assertion & ");" & LF); |
76f9c7f4 BD |
1751 | end if; |
1752 | ||
99e30ba8 BD |
1753 | if Setter_Needs_Parent (F) then |
1754 | declare | |
1755 | Err : constant String := | |
1756 | (if Rec.Field_Type = List_Id then "Error_List" else "Error"); | |
1757 | begin | |
1758 | Put (S, "if Present (Val) and then Val /= " & Err & " then" & LF); | |
1759 | Increase_Indent (S, 3); | |
1760 | Put (S, "pragma Warnings (Off, ""actuals for this call may be in wrong order"");" & LF); | |
1761 | Put (S, "Set_Parent (Val, N);" & LF); | |
1762 | Put (S, "pragma Warnings (On, ""actuals for this call may be in wrong order"");" & LF); | |
1763 | Decrease_Indent (S, 3); | |
1764 | Put (S, "end if;" & LF & LF); | |
1765 | end; | |
1766 | end if; | |
1767 | ||
1768 | if Field_Size (Rec.Field_Type) /= SS then | |
1769 | Put (S, "S := (S and not Shift_Left (Mask, V)) or Shift_Left (Slot (Raw), V);" & LF); | |
1770 | ||
1771 | else | |
1772 | Put (S, "S := Slot (Raw);" & LF); | |
1773 | end if; | |
1774 | ||
a6fe12b0 | 1775 | Put_Get_Set_Incr (S, F, "Set"); |
36e38022 | 1776 | |
20922782 SB |
1777 | Decrease_Indent (S, 3); |
1778 | Put (S, "end Set_" & Image (F) & ";" & LF & LF); | |
76f9c7f4 BD |
1779 | end Put_Setter_Body; |
1780 | ||
a7cadd18 BD |
1781 | -------------------- |
1782 | -- Put_Subp_Decls -- | |
1783 | -------------------- | |
1784 | ||
20922782 | 1785 | procedure Put_Subp_Decls (S : in out Sink; Root : Root_Type) is |
76f9c7f4 BD |
1786 | -- Note that there are several fields that are defined for both nodes |
1787 | -- and entities, such as Nkind. These are allocated slots in both, | |
1788 | -- but here we only put out getters and setters in Sinfo.Nodes, not | |
1789 | -- Einfo.Entities. | |
1790 | ||
1791 | begin | |
20922782 | 1792 | Put (S, "-- Getters and setters for fields" & LF); |
76f9c7f4 BD |
1793 | |
1794 | for F in First_Field (Root) .. Last_Field (Root) loop | |
1795 | -- Nkind/Ekind getter is already done (see Put_Type_And_Subtypes), | |
1796 | -- and there is no setter for these. | |
1797 | ||
1798 | if F = Nkind then | |
20922782 | 1799 | Put (S, LF & "-- Nkind getter is above" & LF); |
76f9c7f4 BD |
1800 | |
1801 | elsif F = Ekind then | |
20922782 | 1802 | Put (S, LF & "-- Ekind getter is above" & LF); |
76f9c7f4 BD |
1803 | |
1804 | else | |
1805 | Put_Getter_Decl (S, F); | |
1806 | Put_Setter_Decl (S, F); | |
1807 | end if; | |
1808 | ||
20922782 | 1809 | Put (S, LF); |
76f9c7f4 BD |
1810 | end loop; |
1811 | end Put_Subp_Decls; | |
1812 | ||
a7cadd18 BD |
1813 | --------------------- |
1814 | -- Put_Subp_Bodies -- | |
1815 | --------------------- | |
1816 | ||
20922782 | 1817 | procedure Put_Subp_Bodies (S : in out Sink; Root : Root_Type) is |
76f9c7f4 | 1818 | begin |
20922782 | 1819 | Put (S, LF & "-- Getters and setters for fields" & LF & LF); |
76f9c7f4 BD |
1820 | |
1821 | for F in First_Field (Root) .. Last_Field (Root) loop | |
1822 | Put_Getter_Body (S, F); | |
1823 | ||
1824 | if F not in Nkind | Ekind then | |
1825 | Put_Setter_Body (S, F); | |
1826 | end if; | |
1827 | end loop; | |
1828 | end Put_Subp_Bodies; | |
1829 | ||
a7cadd18 BD |
1830 | -------------------------- |
1831 | -- Put_Traversed_Fields -- | |
1832 | -------------------------- | |
1833 | ||
20922782 | 1834 | procedure Put_Traversed_Fields (S : in out Sink) is |
76f9c7f4 BD |
1835 | |
1836 | function Is_Traversed_Field | |
1837 | (T : Concrete_Node; F : Field_Enum) return Boolean; | |
1838 | -- True if F is a field that should be traversed by Traverse_Func. In | |
1839 | -- particular, True if F is a syntactic field of T, and is of a | |
1840 | -- Node_Id or List_Id type. | |
1841 | ||
1842 | function Init_Max_Traversed_Fields return Field_Offset; | |
1843 | -- Compute the maximum number of syntactic fields that are of type | |
1844 | -- Node_Id or List_Id over all node types. | |
1845 | ||
a7cadd18 | 1846 | procedure Put_Aggregate (T : Node_Or_Entity_Type); |
76f9c7f4 BD |
1847 | -- Print out the subaggregate for one type |
1848 | ||
1849 | function Is_Traversed_Field | |
1850 | (T : Concrete_Node; F : Field_Enum) return Boolean is | |
1851 | begin | |
a7cadd18 BD |
1852 | return Syntactic (T) (F) |
1853 | and then Field_Table (F).Field_Type in Traversed_Field_Type; | |
76f9c7f4 BD |
1854 | end Is_Traversed_Field; |
1855 | ||
1856 | First_Time : Boolean := True; | |
1857 | ||
a7cadd18 | 1858 | procedure Put_Aggregate (T : Node_Or_Entity_Type) is |
76f9c7f4 BD |
1859 | Left_Opnd_Skipped : Boolean := False; |
1860 | begin | |
1861 | if T in Concrete_Node then | |
1862 | if First_Time then | |
1863 | First_Time := False; | |
1864 | else | |
20922782 | 1865 | Put (S, "," & LF); |
76f9c7f4 BD |
1866 | end if; |
1867 | ||
20922782 SB |
1868 | Put (S, Image (T) & " => ("); |
1869 | Increase_Indent (S, 2); | |
76f9c7f4 BD |
1870 | |
1871 | for FI in 1 .. Last_Index (Type_Table (T).Fields) loop | |
1872 | declare | |
1873 | F : constant Field_Enum := Type_Table (T).Fields (FI); | |
1874 | ||
1875 | begin | |
1876 | if Is_Traversed_Field (T, F) then | |
1877 | if F = Left_Opnd then | |
1878 | Left_Opnd_Skipped := True; -- see comment below | |
1879 | ||
1880 | else | |
20922782 | 1881 | Put (S, Image (Field_Table (F).Offset) & ", "); |
76f9c7f4 BD |
1882 | end if; |
1883 | end if; | |
1884 | end; | |
1885 | end loop; | |
1886 | ||
1887 | -- We always put the Left_Opnd field of N_Op_Concat last. See | |
1888 | -- comments in Atree.Traverse_Func for the reason. We might as | |
1889 | -- well do that for all Left_Opnd fields; the old version did | |
1890 | -- that. | |
1891 | ||
1892 | if Left_Opnd_Skipped then | |
20922782 | 1893 | Put (S, Image (Field_Table (Left_Opnd).Offset) & ", "); |
76f9c7f4 BD |
1894 | end if; |
1895 | ||
1896 | Put (S, "others => No_Field_Offset"); | |
1897 | ||
20922782 | 1898 | Decrease_Indent (S, 2); |
76f9c7f4 BD |
1899 | Put (S, ")"); |
1900 | end if; | |
a7cadd18 | 1901 | end Put_Aggregate; |
76f9c7f4 BD |
1902 | |
1903 | function Init_Max_Traversed_Fields return Field_Offset is | |
1904 | Result : Field_Offset := 0; | |
1905 | begin | |
1906 | for T in Concrete_Node loop | |
1907 | declare | |
1908 | Num_Traversed_Fields : Field_Offset := 0; -- in type T | |
1909 | ||
1910 | begin | |
1911 | for FI in 1 .. Last_Index (Type_Table (T).Fields) loop | |
1912 | declare | |
1913 | F : constant Field_Enum := Type_Table (T).Fields (FI); | |
1914 | ||
1915 | begin | |
1916 | if Is_Traversed_Field (T, F) then | |
1917 | Num_Traversed_Fields := Num_Traversed_Fields + 1; | |
1918 | end if; | |
1919 | end; | |
1920 | end loop; | |
1921 | ||
1922 | if Num_Traversed_Fields > Result then | |
1923 | Result := Num_Traversed_Fields; | |
1924 | end if; | |
1925 | end; | |
1926 | end loop; | |
1927 | ||
1928 | return Result; | |
1929 | end Init_Max_Traversed_Fields; | |
1930 | ||
1931 | Max_Traversed_Fields : constant Field_Offset := | |
1932 | Init_Max_Traversed_Fields; | |
1933 | ||
1934 | begin | |
20922782 SB |
1935 | Put (S, "-- Table of fields that should be traversed by Traverse subprograms." & LF); |
1936 | Put (S, "-- Each entry is an array of offsets in slots of fields to be" & LF); | |
1937 | Put (S, "-- traversed, terminated by a sentinel equal to No_Field_Offset." & LF & LF); | |
76f9c7f4 | 1938 | |
20922782 SB |
1939 | Put (S, "subtype Traversed_Offset_Array is Offset_Array (0 .. " & |
1940 | Image (Max_Traversed_Fields - 1) & " + 1);" & LF); | |
1941 | Put (S, "Traversed_Fields : constant array (Node_Kind) of Traversed_Offset_Array :=" & LF); | |
76f9c7f4 BD |
1942 | -- One extra for the sentinel |
1943 | ||
20922782 | 1944 | Increase_Indent (S, 2); |
76f9c7f4 | 1945 | Put (S, "("); |
20922782 | 1946 | Increase_Indent (S, 1); |
a7cadd18 | 1947 | Iterate_Types (Node_Kind, Pre => Put_Aggregate'Access); |
20922782 SB |
1948 | Decrease_Indent (S, 1); |
1949 | Put (S, ");" & LF & LF); | |
1950 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
1951 | end Put_Traversed_Fields; |
1952 | ||
a7cadd18 BD |
1953 | ---------------- |
1954 | -- Put_Tables -- | |
1955 | ---------------- | |
1956 | ||
20922782 | 1957 | procedure Put_Tables (S : in out Sink; Root : Root_Type) is |
76f9c7f4 BD |
1958 | |
1959 | First_Time : Boolean := True; | |
1960 | ||
1961 | procedure Put_Size (T : Node_Or_Entity_Type); | |
1962 | procedure Put_Size (T : Node_Or_Entity_Type) is | |
1963 | begin | |
1964 | if T in Concrete_Type then | |
1965 | if First_Time then | |
1966 | First_Time := False; | |
1967 | else | |
20922782 | 1968 | Put (S, "," & LF); |
76f9c7f4 BD |
1969 | end if; |
1970 | ||
20922782 | 1971 | Put (S, Image (T) & " => " & Image (Type_Size_In_Slots (T))); |
76f9c7f4 BD |
1972 | end if; |
1973 | end Put_Size; | |
1974 | ||
1975 | procedure Put_Field_Array (T : Concrete_Type); | |
1976 | ||
1977 | procedure Put_Field_Array (T : Concrete_Type) is | |
1978 | First_Time : Boolean := True; | |
1979 | begin | |
1980 | for F in First_Field (Root) .. Last_Field (Root) loop | |
1981 | if Fields_Per_Node (T) (F) then | |
1982 | if First_Time then | |
1983 | First_Time := False; | |
1984 | else | |
20922782 | 1985 | Put (S, "," & LF); |
76f9c7f4 BD |
1986 | end if; |
1987 | ||
20922782 | 1988 | Put (S, F_Image (F)); |
76f9c7f4 BD |
1989 | end if; |
1990 | end loop; | |
1991 | end Put_Field_Array; | |
1992 | ||
1993 | Field_Enum_Type_Name : constant String := | |
1994 | (case Root is | |
1995 | when Node_Kind => "Node_Field", | |
1996 | when others => "Entity_Field"); -- Entity_Kind | |
1997 | ||
1998 | begin | |
99e30ba8 | 1999 | Put (S, "-- Table of sizes in " & SSS & "-bit slots for given " & |
20922782 | 2000 | Image (Root) & ", for use by Atree:" & LF); |
76f9c7f4 BD |
2001 | |
2002 | case Root is | |
2003 | when Node_Kind => | |
20922782 SB |
2004 | Put (S, LF & "Min_Node_Size : constant Field_Offset := " & |
2005 | Image (Min_Node_Size) & ";" & LF); | |
2006 | Put (S, "Max_Node_Size : constant Field_Offset := " & | |
2007 | Image (Max_Node_Size) & ";" & LF & LF); | |
3f561db7 | 2008 | |
76f9c7f4 | 2009 | when Entity_Kind => |
20922782 SB |
2010 | Put (S, LF & "Min_Entity_Size : constant Field_Offset := " & |
2011 | Image (Min_Entity_Size) & ";" & LF); | |
2012 | Put (S, "Max_Entity_Size : constant Field_Offset := " & | |
2013 | Image (Max_Entity_Size) & ";" & LF & LF); | |
76f9c7f4 BD |
2014 | when others => raise Program_Error; |
2015 | end case; | |
2016 | ||
20922782 SB |
2017 | Put (S, "Size : constant array (" & Image (Root) & |
2018 | ") of Field_Offset :=" & LF); | |
2019 | Increase_Indent (S, 2); | |
76f9c7f4 | 2020 | Put (S, "("); |
20922782 | 2021 | Increase_Indent (S, 1); |
76f9c7f4 BD |
2022 | |
2023 | Iterate_Types (Root, Pre => Put_Size'Access); | |
2024 | ||
20922782 SB |
2025 | Decrease_Indent (S, 1); |
2026 | Put (S, "); -- Size" & LF); | |
2027 | Decrease_Indent (S, 2); | |
76f9c7f4 | 2028 | |
99e30ba8 BD |
2029 | if Root = Node_Kind then |
2030 | declare | |
2031 | type Node_Dummy is array (Node_Field) of Boolean; | |
2032 | type Entity_Dummy is array (Entity_Field) of Boolean; | |
2033 | Num_Fields : constant Root_Int := | |
2034 | Node_Dummy'Length + Entity_Dummy'Length; | |
2035 | First_Time : Boolean := True; | |
2036 | begin | |
2037 | Put (S, LF & "-- Enumeration of all " & Image (Num_Fields) | |
2038 | & " fields:" & LF & LF); | |
76f9c7f4 | 2039 | |
99e30ba8 BD |
2040 | Put (S, "type Node_Or_Entity_Field is" & LF); |
2041 | Increase_Indent (S, 2); | |
2042 | Put (S, "("); | |
2043 | Increase_Indent (S, 1); | |
76f9c7f4 | 2044 | |
99e30ba8 BD |
2045 | for F in Node_Field loop |
2046 | if First_Time then | |
2047 | First_Time := False; | |
2048 | else | |
2049 | Put (S, "," & LF); | |
2050 | end if; | |
2051 | ||
2052 | Put (S, F_Image (F)); | |
2053 | end loop; | |
2054 | ||
2055 | for F in Entity_Field loop | |
20922782 | 2056 | Put (S, "," & LF); |
99e30ba8 BD |
2057 | Put (S, F_Image (F)); |
2058 | end loop; | |
76f9c7f4 | 2059 | |
99e30ba8 BD |
2060 | Decrease_Indent (S, 1); |
2061 | Put (S, "); -- Node_Or_Entity_Field" & LF); | |
2062 | Decrease_Indent (S, 2); | |
2063 | end; | |
2064 | end if; | |
76f9c7f4 | 2065 | |
99e30ba8 BD |
2066 | Put (S, LF & "subtype " & Field_Enum_Type_Name & " is" & LF); |
2067 | Increase_Indent (S, 2); | |
2068 | Put (S, "Node_Or_Entity_Field range " & F_Image (First_Field (Root)) & | |
2069 | " .. " & F_Image (Last_Field (Root)) & ";" & LF); | |
2070 | Decrease_Indent (S, 2); | |
76f9c7f4 | 2071 | |
20922782 SB |
2072 | Put (S, LF & "type " & Field_Enum_Type_Name & "_Index is new Pos;" & LF); |
2073 | Put (S, "type " & Field_Enum_Type_Name & "_Array is array (" & | |
2074 | Field_Enum_Type_Name & "_Index range <>) of " & | |
2075 | Field_Enum_Type_Name & ";" & LF); | |
2076 | Put (S, "type " & Field_Enum_Type_Name & | |
2077 | "_Array_Ref is access constant " & Field_Enum_Type_Name & | |
2078 | "_Array;" & LF); | |
2079 | Put (S, "subtype A is " & Field_Enum_Type_Name & "_Array;" & LF); | |
76f9c7f4 BD |
2080 | -- Short name to make allocators below more readable |
2081 | ||
2082 | declare | |
2083 | First_Time : Boolean := True; | |
2084 | ||
2085 | procedure Do_One_Type (T : Node_Or_Entity_Type); | |
2086 | procedure Do_One_Type (T : Node_Or_Entity_Type) is | |
2087 | begin | |
2088 | if T in Concrete_Type then | |
2089 | if First_Time then | |
2090 | First_Time := False; | |
2091 | else | |
20922782 | 2092 | Put (S, "," & LF); |
76f9c7f4 BD |
2093 | end if; |
2094 | ||
20922782 SB |
2095 | Put (S, Image (T) & " =>" & LF); |
2096 | Increase_Indent (S, 2); | |
76f9c7f4 | 2097 | Put (S, "new A'("); |
20922782 SB |
2098 | Increase_Indent (S, 6); |
2099 | Increase_Indent (S, 1); | |
76f9c7f4 BD |
2100 | |
2101 | Put_Field_Array (T); | |
2102 | ||
20922782 | 2103 | Decrease_Indent (S, 1); |
76f9c7f4 | 2104 | Put (S, ")"); |
20922782 SB |
2105 | Decrease_Indent (S, 6); |
2106 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
2107 | end if; |
2108 | end Do_One_Type; | |
2109 | begin | |
20922782 SB |
2110 | Put (S, LF & "-- Table mapping " & Image (Root) & |
2111 | "s to the sequence of fields that exist in that " & | |
2112 | Image (Root) & ":" & LF & LF); | |
76f9c7f4 | 2113 | |
20922782 SB |
2114 | Put (S, Field_Enum_Type_Name & "_Table : constant array (" & |
2115 | Image (Root) & ") of " & Field_Enum_Type_Name & | |
2116 | "_Array_Ref :=" & LF); | |
76f9c7f4 | 2117 | |
20922782 | 2118 | Increase_Indent (S, 2); |
76f9c7f4 | 2119 | Put (S, "("); |
20922782 | 2120 | Increase_Indent (S, 1); |
76f9c7f4 BD |
2121 | |
2122 | Iterate_Types (Root, Pre => Do_One_Type'Access); | |
2123 | ||
20922782 SB |
2124 | Decrease_Indent (S, 1); |
2125 | Put (S, "); -- " & Field_Enum_Type_Name & "_Table" & LF); | |
2126 | Decrease_Indent (S, 2); | |
76f9c7f4 BD |
2127 | end; |
2128 | ||
99e30ba8 BD |
2129 | if Root = Node_Kind then |
2130 | declare | |
2131 | First_Time : Boolean := True; | |
a6fe12b0 BD |
2132 | FS, FB, LB : Bit_Offset; |
2133 | -- Field size in bits, first bit, and last bit for the previous | |
2134 | -- time around the loop. Used to print a comment after ",". | |
2135 | ||
2136 | procedure One_Comp (F : Field_Enum); | |
2137 | ||
d43fbe01 PT |
2138 | -------------- |
2139 | -- One_Comp -- | |
2140 | -------------- | |
2141 | ||
a6fe12b0 | 2142 | procedure One_Comp (F : Field_Enum) is |
3323aa7e | 2143 | pragma Annotate (Codepeer, Modified, Field_Table); |
d43fbe01 | 2144 | Offset : constant Field_Offset := Field_Table (F).Offset; |
a6fe12b0 BD |
2145 | begin |
2146 | if First_Time then | |
2147 | First_Time := False; | |
2148 | else | |
2149 | Put (S, ","); | |
2150 | ||
2151 | -- Print comment showing field's bits, except for 1-bit | |
2152 | -- fields. | |
2153 | ||
2154 | if FS /= 1 then | |
2155 | Put (S, " -- *" & Image (FS) & " = bits " & | |
2156 | Image (FB) & ".." & Image (LB)); | |
2157 | end if; | |
2158 | ||
2159 | Put (S, LF); | |
2160 | end if; | |
2161 | ||
2162 | Put (S, F_Image (F) & " => (" & | |
2163 | Image (Field_Table (F).Field_Type) & "_Field, " & | |
034c3117 BD |
2164 | Image (Offset) & ", " & |
2165 | Image (Field_Table (F).Type_Only) & ")"); | |
a6fe12b0 BD |
2166 | |
2167 | FS := Field_Size (F); | |
2168 | FB := First_Bit (F, Offset); | |
2169 | LB := Last_Bit (F, Offset); | |
2170 | end One_Comp; | |
2171 | ||
99e30ba8 BD |
2172 | begin |
2173 | Put (S, LF & "-- Table mapping fields to kind and offset:" & LF & LF); | |
76f9c7f4 | 2174 | |
99e30ba8 BD |
2175 | Put (S, "Field_Descriptors : constant array (" & |
2176 | "Node_Or_Entity_Field) of Field_Descriptor :=" & LF); | |
76f9c7f4 | 2177 | |
99e30ba8 BD |
2178 | Increase_Indent (S, 2); |
2179 | Put (S, "("); | |
2180 | Increase_Indent (S, 1); | |
76f9c7f4 | 2181 | |
99e30ba8 | 2182 | for F in Node_Field loop |
a6fe12b0 | 2183 | One_Comp (F); |
99e30ba8 | 2184 | end loop; |
76f9c7f4 | 2185 | |
99e30ba8 | 2186 | for F in Entity_Field loop |
a6fe12b0 | 2187 | One_Comp (F); |
99e30ba8 BD |
2188 | end loop; |
2189 | ||
2190 | Decrease_Indent (S, 1); | |
2191 | Put (S, "); -- Field_Descriptors" & LF); | |
2192 | Decrease_Indent (S, 2); | |
2193 | end; | |
2194 | end if; | |
76f9c7f4 BD |
2195 | |
2196 | end Put_Tables; | |
2197 | ||
a7cadd18 BD |
2198 | ---------------- |
2199 | -- Put_Seinfo -- | |
2200 | ---------------- | |
2201 | ||
76f9c7f4 | 2202 | procedure Put_Seinfo is |
20922782 | 2203 | S : Sink; |
76f9c7f4 | 2204 | begin |
20922782 SB |
2205 | Create_File (S, "seinfo.ads"); |
2206 | Put (S, "with Types; use Types;" & LF); | |
2207 | Put (S, LF & "package Seinfo is" & LF & LF); | |
2208 | Increase_Indent (S, 3); | |
76f9c7f4 | 2209 | |
20922782 | 2210 | Put (S, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 | 2211 | |
20922782 | 2212 | Put (S, "-- Common declarations visible in both Sinfo.Nodes and Einfo.Entities." & LF); |
76f9c7f4 | 2213 | |
20922782 SB |
2214 | Put (S, LF & "type Field_Kind is" & LF); |
2215 | Increase_Indent (S, 2); | |
76f9c7f4 | 2216 | Put (S, "("); |
20922782 | 2217 | Increase_Indent (S, 1); |
76f9c7f4 BD |
2218 | |
2219 | declare | |
2220 | First_Time : Boolean := True; | |
2221 | begin | |
2222 | for T in Special_Type loop | |
2223 | if First_Time then | |
2224 | First_Time := False; | |
2225 | else | |
20922782 | 2226 | Put (S, "," & LF); |
76f9c7f4 BD |
2227 | end if; |
2228 | ||
20922782 | 2229 | Put (S, Image (T) & "_Field"); |
76f9c7f4 BD |
2230 | end loop; |
2231 | end; | |
2232 | ||
20922782 SB |
2233 | Decrease_Indent (S, 1); |
2234 | Decrease_Indent (S, 2); | |
2235 | Put (S, ");" & LF); | |
76f9c7f4 | 2236 | |
20922782 SB |
2237 | Put (S, LF & "Field_Size : constant array (Field_Kind) of Field_Size_In_Bits :=" & LF); |
2238 | Increase_Indent (S, 2); | |
76f9c7f4 | 2239 | Put (S, "("); |
20922782 | 2240 | Increase_Indent (S, 1); |
76f9c7f4 BD |
2241 | |
2242 | declare | |
2243 | First_Time : Boolean := True; | |
2244 | begin | |
2245 | for T in Special_Type loop | |
2246 | if First_Time then | |
2247 | First_Time := False; | |
2248 | else | |
20922782 | 2249 | Put (S, "," & LF); |
76f9c7f4 BD |
2250 | end if; |
2251 | ||
20922782 | 2252 | Put (S, Image (T) & "_Field => " & Image (Field_Size (T))); |
76f9c7f4 BD |
2253 | end loop; |
2254 | end; | |
2255 | ||
20922782 SB |
2256 | Decrease_Indent (S, 1); |
2257 | Decrease_Indent (S, 2); | |
2258 | Put (S, ");" & LF & LF); | |
76f9c7f4 | 2259 | |
034c3117 BD |
2260 | Put (S, "type Type_Only_Enum is" & LF); |
2261 | Increase_Indent (S, 2); | |
2262 | Put (S, "("); | |
2263 | ||
2264 | declare | |
2265 | First_Time : Boolean := True; | |
2266 | begin | |
2267 | for TO in Type_Only_Enum loop | |
2268 | if First_Time then | |
2269 | First_Time := False; | |
2270 | else | |
2271 | Put (S, ", "); | |
2272 | end if; | |
2273 | ||
2274 | Put (S, Image (TO)); | |
2275 | end loop; | |
2276 | end; | |
2277 | ||
2278 | Decrease_Indent (S, 2); | |
2279 | Put (S, ");" & LF & LF); | |
2280 | ||
20922782 SB |
2281 | Put (S, "type Field_Descriptor is record" & LF); |
2282 | Increase_Indent (S, 3); | |
2283 | Put (S, "Kind : Field_Kind;" & LF); | |
2284 | Put (S, "Offset : Field_Offset;" & LF); | |
034c3117 | 2285 | Put (S, "Type_Only : Type_Only_Enum;" & LF); |
20922782 | 2286 | Decrease_Indent (S, 3); |
3f561db7 | 2287 | Put (S, "end record;" & LF & LF); |
76f9c7f4 | 2288 | |
99e30ba8 BD |
2289 | -- Print out the node header types. Note that the Offset field is of |
2290 | -- the base type, because we are using zero-origin addressing in | |
2291 | -- Atree. | |
2292 | ||
3f561db7 BD |
2293 | Put (S, "N_Head : constant Field_Offset := " & N_Head & ";" & LF & LF); |
2294 | ||
2295 | Put (S, "Atree_Statistics_Enabled : constant Boolean := " & | |
2296 | Capitalize (Boolean'Image (Statistics_Enabled)) & ";" & LF); | |
99e30ba8 | 2297 | |
20922782 SB |
2298 | Decrease_Indent (S, 3); |
2299 | Put (S, LF & "end Seinfo;" & LF); | |
76f9c7f4 BD |
2300 | end Put_Seinfo; |
2301 | ||
a7cadd18 BD |
2302 | --------------- |
2303 | -- Put_Nodes -- | |
2304 | --------------- | |
2305 | ||
76f9c7f4 | 2306 | procedure Put_Nodes is |
20922782 SB |
2307 | S : Sink; |
2308 | B : Sink; | |
76f9c7f4 | 2309 | |
76f9c7f4 | 2310 | begin |
20922782 SB |
2311 | Create_File (S, "sinfo-nodes.ads"); |
2312 | Create_File (B, "sinfo-nodes.adb"); | |
2313 | Put (S, "with Seinfo; use Seinfo;" & LF); | |
2314 | Put (S, "pragma Warnings (Off);" & LF); | |
a5db70e7 BD |
2315 | -- With's included in case they are needed; so we don't have to keep |
2316 | -- switching back and forth. | |
20922782 SB |
2317 | Put (S, "with Output; use Output;" & LF); |
2318 | Put (S, "pragma Warnings (On);" & LF); | |
76f9c7f4 | 2319 | |
20922782 SB |
2320 | Put (S, LF & "package Sinfo.Nodes is" & LF & LF); |
2321 | Increase_Indent (S, 3); | |
76f9c7f4 | 2322 | |
20922782 | 2323 | Put (S, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 BD |
2324 | |
2325 | Put_Type_Hierarchy (S, Node_Kind); | |
2326 | ||
2327 | Put_Type_And_Subtypes (S, Node_Kind); | |
2328 | ||
20922782 SB |
2329 | Put (S, "pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0);" & LF & LF); |
2330 | Put (S, "pragma Assert (Node_Kind'Last = N_Unused_At_End);" & LF & LF); | |
76f9c7f4 BD |
2331 | |
2332 | Put_Subp_Decls (S, Node_Kind); | |
2333 | ||
2334 | Put_Traversed_Fields (S); | |
2335 | ||
2336 | Put_Tables (S, Node_Kind); | |
2337 | ||
20922782 SB |
2338 | Decrease_Indent (S, 3); |
2339 | Put (S, LF & "end Sinfo.Nodes;" & LF); | |
76f9c7f4 | 2340 | |
83bacaa9 | 2341 | Put (B, "with Ada.Unchecked_Conversion;" & LF); |
20922782 SB |
2342 | Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;" & LF); |
2343 | Put (B, "with Nlists; use Nlists;" & LF); | |
2344 | Put (B, "pragma Warnings (Off);" & LF); | |
2345 | Put (B, "with Einfo.Utils; use Einfo.Utils;" & LF); | |
898edf75 | 2346 | Put (B, "with Sinfo.Utils; use Sinfo.Utils;" & LF); |
20922782 | 2347 | Put (B, "pragma Warnings (On);" & LF); |
76f9c7f4 | 2348 | |
20922782 SB |
2349 | Put (B, LF & "package body Sinfo.Nodes is" & LF & LF); |
2350 | Increase_Indent (B, 3); | |
76f9c7f4 | 2351 | |
20922782 | 2352 | Put (B, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 | 2353 | |
20922782 | 2354 | Put (B, "pragma Style_Checks (""M200"");" & LF); |
99e30ba8 | 2355 | |
76f9c7f4 BD |
2356 | for T in Special_Type loop |
2357 | if Node_Field_Types_Used (T) then | |
99e30ba8 | 2358 | Put_Casts (B, T); |
76f9c7f4 BD |
2359 | end if; |
2360 | end loop; | |
2361 | ||
76f9c7f4 BD |
2362 | Put_Subp_Bodies (B, Node_Kind); |
2363 | ||
20922782 SB |
2364 | Decrease_Indent (B, 3); |
2365 | Put (B, "end Sinfo.Nodes;" & LF); | |
76f9c7f4 BD |
2366 | |
2367 | end Put_Nodes; | |
2368 | ||
a7cadd18 BD |
2369 | ------------------ |
2370 | -- Put_Entities -- | |
2371 | ------------------ | |
2372 | ||
76f9c7f4 | 2373 | procedure Put_Entities is |
20922782 SB |
2374 | S : Sink; |
2375 | B : Sink; | |
76f9c7f4 | 2376 | begin |
20922782 SB |
2377 | Create_File (S, "einfo-entities.ads"); |
2378 | Create_File (B, "einfo-entities.adb"); | |
20922782 | 2379 | Put (S, "with Sinfo.Nodes; use Sinfo.Nodes;" & LF); |
76f9c7f4 | 2380 | |
20922782 SB |
2381 | Put (S, LF & "package Einfo.Entities is" & LF & LF); |
2382 | Increase_Indent (S, 3); | |
76f9c7f4 | 2383 | |
20922782 | 2384 | Put (S, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 BD |
2385 | |
2386 | Put_Type_Hierarchy (S, Entity_Kind); | |
2387 | ||
2388 | Put_Type_And_Subtypes (S, Entity_Kind); | |
2389 | ||
2390 | Put_Subp_Decls (S, Entity_Kind); | |
2391 | ||
2392 | Put_Tables (S, Entity_Kind); | |
2393 | ||
20922782 SB |
2394 | Decrease_Indent (S, 3); |
2395 | Put (S, LF & "end Einfo.Entities;" & LF); | |
76f9c7f4 | 2396 | |
83bacaa9 | 2397 | Put (B, "with Ada.Unchecked_Conversion;" & LF); |
20922782 SB |
2398 | Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;" & LF); |
2399 | Put (B, "with Einfo.Utils; use Einfo.Utils;" & LF); | |
76f9c7f4 BD |
2400 | -- This forms a cycle between packages (via bodies, which is OK) |
2401 | ||
20922782 SB |
2402 | Put (B, LF & "package body Einfo.Entities is" & LF & LF); |
2403 | Increase_Indent (B, 3); | |
76f9c7f4 | 2404 | |
20922782 | 2405 | Put (B, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 | 2406 | |
20922782 | 2407 | Put (B, "pragma Style_Checks (""M200"");" & LF); |
99e30ba8 | 2408 | |
76f9c7f4 BD |
2409 | for T in Special_Type loop |
2410 | if Entity_Field_Types_Used (T) then | |
99e30ba8 | 2411 | Put_Casts (B, T); |
76f9c7f4 BD |
2412 | end if; |
2413 | end loop; | |
2414 | ||
2415 | Put_Subp_Bodies (B, Entity_Kind); | |
2416 | ||
20922782 SB |
2417 | Decrease_Indent (B, 3); |
2418 | Put (B, "end Einfo.Entities;" & LF); | |
76f9c7f4 BD |
2419 | |
2420 | end Put_Entities; | |
2421 | ||
a7cadd18 BD |
2422 | ------------------- |
2423 | -- Put_Make_Spec -- | |
2424 | ------------------- | |
2425 | ||
76f9c7f4 | 2426 | procedure Put_Make_Spec |
20922782 | 2427 | (S : in out Sink; Root : Root_Type; T : Concrete_Type) |
76f9c7f4 BD |
2428 | is |
2429 | begin | |
20922782 SB |
2430 | Put (S, "function Make_" & Image_Sans_N (T) & "" & LF); |
2431 | Increase_Indent (S, 2); | |
a7cadd18 | 2432 | Put (S, "(Sloc : Source_Ptr"); |
20922782 | 2433 | Increase_Indent (S, 1); |
76f9c7f4 BD |
2434 | |
2435 | for F of Type_Table (T).Fields loop | |
2436 | pragma Assert (Fields_Per_Node (T) (F)); | |
2437 | ||
a7cadd18 | 2438 | if Syntactic (T) (F) then |
76f9c7f4 BD |
2439 | declare |
2440 | Typ : constant String := | |
2441 | (if Field_Table (F).Field_Type = Flag then "Boolean" | |
2442 | else Image (Field_Table (F).Field_Type)); | |
2443 | ||
2444 | -- All Flag fields have a default, which is False by | |
2445 | -- default. | |
2446 | ||
2447 | Default : constant String := | |
2448 | (if Field_Table (F).Default_Value = No_Default then | |
2449 | (if Field_Table (F).Field_Type = Flag then " := False" else "") | |
2450 | else " := " & Value_Image (Field_Table (F).Default_Value)); | |
2451 | ||
76f9c7f4 | 2452 | begin |
20922782 SB |
2453 | Put (S, ";" & LF); |
2454 | Put (S, Image (F)); | |
2455 | Put (S, " : " & Typ & Default); | |
76f9c7f4 BD |
2456 | end; |
2457 | end if; | |
2458 | end loop; | |
2459 | ||
861dc87d PT |
2460 | Put (S, ")" & LF); |
2461 | Put (S, "return " & Node_Or_Entity (Root) & "_Id"); | |
20922782 SB |
2462 | Decrease_Indent (S, 2); |
2463 | Decrease_Indent (S, 1); | |
76f9c7f4 BD |
2464 | end Put_Make_Spec; |
2465 | ||
a7cadd18 BD |
2466 | -------------------- |
2467 | -- Put_Make_Decls -- | |
2468 | -------------------- | |
2469 | ||
20922782 | 2470 | procedure Put_Make_Decls (S : in out Sink; Root : Root_Type) is |
76f9c7f4 | 2471 | begin |
a7cadd18 BD |
2472 | for T in First_Concrete (Root) .. Last_Concrete (Root) loop |
2473 | if T not in N_Unused_At_Start | N_Unused_At_End then | |
2474 | Put_Make_Spec (S, Root, T); | |
22a69380 PT |
2475 | Put (S, ";" & LF); |
2476 | Put (S, "pragma " & Inline & " (Make_" & | |
20922782 | 2477 | Image_Sans_N (T) & ");" & LF & LF); |
a7cadd18 | 2478 | end if; |
76f9c7f4 BD |
2479 | end loop; |
2480 | end Put_Make_Decls; | |
2481 | ||
a7cadd18 BD |
2482 | --------------------- |
2483 | -- Put_Make_Bodies -- | |
2484 | --------------------- | |
2485 | ||
20922782 | 2486 | procedure Put_Make_Bodies (S : in out Sink; Root : Root_Type) is |
76f9c7f4 | 2487 | begin |
a7cadd18 BD |
2488 | for T in First_Concrete (Root) .. Last_Concrete (Root) loop |
2489 | if T not in N_Unused_At_Start | N_Unused_At_End then | |
2490 | Put_Make_Spec (S, Root, T); | |
20922782 | 2491 | Put (S, LF & "is" & LF); |
76f9c7f4 | 2492 | |
20922782 SB |
2493 | Increase_Indent (S, 3); |
2494 | Put (S, "N : constant Node_Id :=" & LF); | |
76f9c7f4 | 2495 | |
a7cadd18 | 2496 | if T in Entity_Node then |
20922782 | 2497 | Put (S, " New_Entity (" & Image (T) & ", Sloc);" & LF); |
76f9c7f4 | 2498 | |
a7cadd18 | 2499 | else |
20922782 | 2500 | Put (S, " New_Node (" & Image (T) & ", Sloc);" & LF); |
a7cadd18 | 2501 | end if; |
76f9c7f4 | 2502 | |
20922782 | 2503 | Decrease_Indent (S, 3); |
76f9c7f4 | 2504 | |
20922782 | 2505 | Put (S, "begin" & LF); |
76f9c7f4 | 2506 | |
20922782 | 2507 | Increase_Indent (S, 3); |
a7cadd18 BD |
2508 | for F of Type_Table (T).Fields loop |
2509 | pragma Assert (Fields_Per_Node (T) (F)); | |
76f9c7f4 | 2510 | |
a7cadd18 BD |
2511 | if Syntactic (T) (F) then |
2512 | declare | |
2513 | NWidth : constant := 28; | |
2514 | -- This constant comes from the old Xnmake, which wraps | |
2515 | -- the Set_... call if the field name is that long or | |
2516 | -- longer. | |
76f9c7f4 | 2517 | |
a7cadd18 | 2518 | F_Name : constant String := Image (F); |
76f9c7f4 | 2519 | |
a7cadd18 BD |
2520 | begin |
2521 | if F_Name'Length < NWidth then | |
20922782 | 2522 | Put (S, "Set_" & F_Name & " (N, " & F_Name & ");" & LF); |
76f9c7f4 | 2523 | |
a7cadd18 | 2524 | -- Wrap the line |
76f9c7f4 | 2525 | |
a7cadd18 | 2526 | else |
20922782 SB |
2527 | Put (S, "Set_" & F_Name & "" & LF); |
2528 | Increase_Indent (S, 2); | |
2529 | Put (S, "(N, " & F_Name & ");" & LF); | |
2530 | Decrease_Indent (S, 2); | |
a7cadd18 BD |
2531 | end if; |
2532 | end; | |
2533 | end if; | |
2534 | end loop; | |
76f9c7f4 | 2535 | |
a7cadd18 BD |
2536 | if Is_Descendant (N_Op, T) then |
2537 | -- Special cases for N_Op nodes: fill in the Chars and Entity | |
2538 | -- fields even though they were not passed in. | |
76f9c7f4 | 2539 | |
a7cadd18 BD |
2540 | declare |
2541 | Op : constant String := Image_Sans_N (T); | |
2542 | -- This will be something like "Op_And" or "Op_Add" | |
2543 | ||
2544 | Op_Name_With_Op : constant String := | |
2545 | (if T = N_Op_Plus then "Op_Add" | |
2546 | elsif T = N_Op_Minus then "Op_Subtract" | |
2547 | else Op); | |
2548 | -- Special cases for unary operators that have the same name | |
2549 | -- as a binary operator; we use the binary operator name in | |
2550 | -- that case. | |
2551 | ||
2552 | Slid : constant String (1 .. Op_Name_With_Op'Length) := | |
2553 | Op_Name_With_Op; | |
2554 | pragma Assert (Slid (1 .. 3) = "Op_"); | |
2555 | ||
2556 | Op_Name : constant String := | |
2557 | (if T in N_Op_Rotate_Left | | |
2558 | N_Op_Rotate_Right | | |
2559 | N_Op_Shift_Left | | |
2560 | N_Op_Shift_Right | | |
2561 | N_Op_Shift_Right_Arithmetic | |
2562 | then Slid (4 .. Slid'Last) | |
2563 | else Slid); | |
2564 | -- Special cases for shifts and rotates; the node kind has | |
2565 | -- "Op_", but the Name_Id constant does not. | |
76f9c7f4 | 2566 | |
a7cadd18 | 2567 | begin |
20922782 SB |
2568 | Put (S, "Set_Chars (N, Name_" & Op_Name & ");" & LF); |
2569 | Put (S, "Set_Entity (N, Standard_" & Op & ");" & LF); | |
a7cadd18 BD |
2570 | end; |
2571 | end if; | |
76f9c7f4 | 2572 | |
82a79441 BD |
2573 | if Type_Table (T).Nmake_Assert.all /= "" then |
2574 | Put (S, "pragma Assert (" & | |
2575 | Type_Table (T).Nmake_Assert.all & ");" & LF); | |
2576 | end if; | |
2577 | ||
20922782 SB |
2578 | Put (S, "return N;" & LF); |
2579 | Decrease_Indent (S, 3); | |
76f9c7f4 | 2580 | |
20922782 | 2581 | Put (S, "end Make_" & Image_Sans_N (T) & ";" & LF & LF); |
a7cadd18 | 2582 | end if; |
76f9c7f4 BD |
2583 | end loop; |
2584 | end Put_Make_Bodies; | |
2585 | ||
a7cadd18 BD |
2586 | --------------- |
2587 | -- Put_Nmake -- | |
2588 | --------------- | |
2589 | ||
76f9c7f4 BD |
2590 | -- Documentation for the Nmake package, generated by Put_Nmake below. |
2591 | ||
2592 | -- The Nmake package contains a set of routines used to construct tree | |
2593 | -- nodes using a functional style. There is one routine for each node | |
2594 | -- type defined in Gen_IL.Gen.Gen_Nodes with the general interface: | |
2595 | ||
2596 | -- function Make_xxx (Sloc : Source_Ptr, | |
2597 | -- Field_Name_1 : Field_Name_1_Type [:= default] | |
2598 | -- Field_Name_2 : Field_Name_2_Type [:= default] | |
2599 | -- ...) | |
2600 | -- return Node_Id | |
2601 | ||
2602 | -- Only syntactic fields are included. | |
2603 | ||
2604 | -- Default values are provided as specified in Gen_Nodes, except that if | |
2605 | -- no default is specified for a flag field, it has a default of False. | |
2606 | ||
2607 | -- Warning: since calls to Make_xxx routines are normal function calls, the | |
2608 | -- arguments can be evaluated in any order. This means that at most one such | |
2609 | -- argument can have side effects (e.g. be a call to a parse routine). | |
2610 | ||
2611 | procedure Put_Nmake is | |
20922782 SB |
2612 | S : Sink; |
2613 | B : Sink; | |
76f9c7f4 BD |
2614 | |
2615 | begin | |
20922782 SB |
2616 | Create_File (S, "nmake.ads"); |
2617 | Create_File (B, "nmake.adb"); | |
2618 | Put (S, "with Namet; use Namet;" & LF); | |
2619 | Put (S, "with Nlists; use Nlists;" & LF); | |
2620 | Put (S, "with Types; use Types;" & LF); | |
2621 | Put (S, "with Uintp; use Uintp;" & LF); | |
2622 | Put (S, "with Urealp; use Urealp;" & LF); | |
76f9c7f4 | 2623 | |
20922782 SB |
2624 | Put (S, LF & "package Nmake is" & LF & LF); |
2625 | Increase_Indent (S, 3); | |
76f9c7f4 | 2626 | |
20922782 SB |
2627 | Put (S, "-- This package is automatically generated." & LF & LF); |
2628 | Put (S, "-- See Put_Nmake in gen_il-gen.adb for documentation." & LF & LF); | |
76f9c7f4 BD |
2629 | |
2630 | Put_Make_Decls (S, Node_Kind); | |
2631 | ||
20922782 SB |
2632 | Decrease_Indent (S, 3); |
2633 | Put (S, "end Nmake;" & LF); | |
76f9c7f4 | 2634 | |
20922782 SB |
2635 | Put (B, "with Atree; use Atree;" & LF); |
2636 | Put (B, "with Sinfo.Nodes; use Sinfo.Nodes;" & LF); | |
2637 | Put (B, "with Sinfo.Utils; use Sinfo.Utils;" & LF); | |
2638 | Put (B, "with Snames; use Snames;" & LF); | |
2639 | Put (B, "with Stand; use Stand;" & LF); | |
76f9c7f4 | 2640 | |
20922782 SB |
2641 | Put (B, LF & "package body Nmake is" & LF & LF); |
2642 | Increase_Indent (B, 3); | |
76f9c7f4 | 2643 | |
20922782 | 2644 | Put (B, "-- This package is automatically generated." & LF & LF); |
82a79441 | 2645 | Put (B, "pragma Style_Checks (""M200"");" & LF); |
76f9c7f4 BD |
2646 | |
2647 | Put_Make_Bodies (B, Node_Kind); | |
2648 | ||
20922782 SB |
2649 | Decrease_Indent (B, 3); |
2650 | Put (B, "end Nmake;" & LF); | |
76f9c7f4 BD |
2651 | end Put_Nmake; |
2652 | ||
a7cadd18 BD |
2653 | ----------------------- |
2654 | -- Put_Seinfo_Tables -- | |
2655 | ----------------------- | |
2656 | ||
76f9c7f4 | 2657 | procedure Put_Seinfo_Tables is |
20922782 SB |
2658 | S : Sink; |
2659 | B : Sink; | |
76f9c7f4 | 2660 | |
a7cadd18 | 2661 | Type_Layout : Concrete_Type_Layout_Array; |
76f9c7f4 BD |
2662 | |
2663 | function Get_Last_Bit | |
2664 | (T : Concrete_Type; F : Opt_Field_Enum; First_Bit : Bit_Offset) | |
2665 | return Bit_Offset; | |
2666 | function First_Bit_Image (First_Bit : Bit_Offset) return String; | |
2667 | function Last_Bit_Image (Last_Bit : Bit_Offset) return String; | |
2668 | ||
2669 | procedure Put_Field_List (Bit : Bit_Offset); | |
2670 | -- Print out the list of fields that are allocated (in part, for | |
2671 | -- fields bigger than one bit) at the given bit offset. This allows | |
2672 | -- us to see which fields are overlaid with each other, which should | |
2673 | -- only happen if the sets of types with those fields are disjoint. | |
2674 | ||
2675 | function Get_Last_Bit | |
2676 | (T : Concrete_Type; F : Opt_Field_Enum; First_Bit : Bit_Offset) | |
2677 | return Bit_Offset is | |
2678 | begin | |
2679 | return Result : Bit_Offset do | |
2680 | if F = No_Field then | |
2681 | -- We don't have a field size for No_Field, so just look at | |
99e30ba8 | 2682 | -- the bits up to the next slot boundary. |
76f9c7f4 BD |
2683 | |
2684 | Result := First_Bit; | |
2685 | ||
99e30ba8 | 2686 | while (Result + 1) mod SS /= 0 |
76f9c7f4 BD |
2687 | and then Type_Layout (T) (Result + 1) = No_Field |
2688 | loop | |
2689 | Result := Result + 1; | |
2690 | end loop; | |
2691 | ||
2692 | else | |
2693 | Result := First_Bit + Field_Size (F) - 1; | |
2694 | end if; | |
2695 | end return; | |
2696 | end Get_Last_Bit; | |
2697 | ||
2698 | function First_Bit_Image (First_Bit : Bit_Offset) return String is | |
99e30ba8 BD |
2699 | W : constant Bit_Offset := First_Bit / SS; |
2700 | B : constant Bit_Offset := First_Bit mod SS; | |
2701 | pragma Assert (W * SS + B = First_Bit); | |
76f9c7f4 BD |
2702 | begin |
2703 | return | |
99e30ba8 | 2704 | Image (W) & "*" & SSS & (if B = 0 then "" else " + " & Image (B)); |
76f9c7f4 BD |
2705 | end First_Bit_Image; |
2706 | ||
2707 | function Last_Bit_Image (Last_Bit : Bit_Offset) return String is | |
99e30ba8 | 2708 | W : constant Bit_Offset := (Last_Bit + 1) / SS; |
76f9c7f4 | 2709 | begin |
99e30ba8 BD |
2710 | if W * SS - 1 = Last_Bit then |
2711 | return Image (W) & "*" & SSS & " - 1"; | |
76f9c7f4 BD |
2712 | else |
2713 | return First_Bit_Image (Last_Bit); | |
2714 | end if; | |
2715 | end Last_Bit_Image; | |
2716 | ||
2717 | function Image_Or_Waste (F : Opt_Field_Enum) return String is | |
2718 | (if F = No_Field then "Wasted_Bits" else Image (F)); | |
2719 | ||
2720 | Num_Wasted_Bits : Bit_Offset'Base := 0; | |
2721 | ||
2722 | Type_Layout_Size : Bit_Offset'Base := Type_Layout'Size; | |
2723 | -- Total size of Type_Layout, including the Field_Arrays its | |
2724 | -- components point to. | |
2725 | ||
2726 | procedure Put_Field_List (Bit : Bit_Offset) is | |
2727 | First_Time : Boolean := True; | |
2728 | begin | |
2729 | for F in Field_Enum loop | |
2730 | if F /= Between_Node_And_Entity_Fields | |
2731 | and then Bit in First_Bit (F, Field_Table (F).Offset) | |
2732 | .. Last_Bit (F, Field_Table (F).Offset) | |
2733 | then | |
2734 | if First_Time then | |
2735 | First_Time := False; | |
2736 | else | |
20922782 | 2737 | Put (B, "," & LF); |
76f9c7f4 BD |
2738 | end if; |
2739 | ||
20922782 | 2740 | Put (B, Image (F)); |
76f9c7f4 BD |
2741 | end if; |
2742 | end loop; | |
2743 | end Put_Field_List; | |
2744 | ||
2745 | begin -- Put_Seinfo_Tables | |
20922782 SB |
2746 | Create_File (S, "seinfo_tables.ads"); |
2747 | Create_File (B, "seinfo_tables.adb"); | |
76f9c7f4 BD |
2748 | |
2749 | for T in Concrete_Type loop | |
2750 | Type_Layout (T) := new Field_Array' | |
2751 | (0 .. Type_Bit_Size_Aligned (T) - 1 => No_Field); | |
2752 | Type_Layout_Size := Type_Layout_Size + Type_Layout (T).all'Size; | |
2753 | ||
2754 | for F in Field_Enum loop | |
2755 | if Fields_Per_Node (T) (F) then | |
2756 | declare | |
2757 | Off : constant Field_Offset := Field_Table (F).Offset; | |
2758 | subtype Bit_Range is Bit_Offset | |
2759 | range First_Bit (F, Off) .. Last_Bit (F, Off); | |
2760 | begin | |
2761 | pragma Assert | |
2762 | (Type_Layout (T) (Bit_Range) = (Bit_Range => No_Field)); | |
2763 | Type_Layout (T) (Bit_Range) := (others => F); | |
2764 | end; | |
2765 | end if; | |
2766 | end loop; | |
2767 | end loop; | |
2768 | ||
2769 | for T in Concrete_Type loop | |
2770 | for B in 0 .. Type_Bit_Size_Aligned (T) - 1 loop | |
2771 | if Type_Layout (T) (B) = No_Field then | |
2772 | Num_Wasted_Bits := Num_Wasted_Bits + 1; | |
2773 | end if; | |
2774 | end loop; | |
2775 | end loop; | |
2776 | ||
20922782 SB |
2777 | Put (S, LF & "package Seinfo_Tables is" & LF & LF); |
2778 | Increase_Indent (S, 3); | |
76f9c7f4 | 2779 | |
20922782 | 2780 | Put (S, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 | 2781 | |
20922782 SB |
2782 | Put (S, "-- This package is not used by the compiler." & LF); |
2783 | Put (S, "-- The body contains tables that are intended to be used by humans to" & LF); | |
0c8ff35e BD |
2784 | Put (S, "-- help understand the layout of various data structures." & LF); |
2785 | Put (S, "-- Search for ""--"" to find major sections of code." & LF & LF); | |
76f9c7f4 | 2786 | |
20922782 | 2787 | Put (S, "pragma Elaborate_Body;" & LF); |
76f9c7f4 | 2788 | |
20922782 SB |
2789 | Decrease_Indent (S, 3); |
2790 | Put (S, LF & "end Seinfo_Tables;" & LF); | |
76f9c7f4 | 2791 | |
20922782 SB |
2792 | Put (B, "with Gen_IL.Types; use Gen_IL.Types;" & LF); |
2793 | Put (B, "with Gen_IL.Fields; use Gen_IL.Fields;" & LF); | |
2794 | Put (B, "with Gen_IL.Internals; use Gen_IL.Internals;" & LF); | |
76f9c7f4 | 2795 | |
20922782 SB |
2796 | Put (B, LF & "package body Seinfo_Tables is" & LF & LF); |
2797 | Increase_Indent (B, 3); | |
76f9c7f4 | 2798 | |
20922782 | 2799 | Put (B, "-- This package is automatically generated." & LF & LF); |
76f9c7f4 | 2800 | |
20922782 SB |
2801 | Put (B, "Num_Wasted_Bits : Bit_Offset'Base := " & Image (Num_Wasted_Bits) & |
2802 | " with Unreferenced;" & LF); | |
76f9c7f4 | 2803 | |
20922782 | 2804 | Put (B, LF & "Wasted_Bits : constant Opt_Field_Enum := No_Field;" & LF); |
76f9c7f4 | 2805 | |
20922782 SB |
2806 | Put (B, LF & "-- Table showing the layout of each Node_Or_Entity_Type. For each" & LF); |
2807 | Put (B, "-- concrete type, we show the bits used by each field. Each field" & LF); | |
2808 | Put (B, "-- uses the same bit range in all types. This table is not used by" & LF); | |
2809 | Put (B, "-- the compiler; it is for information only." & LF & LF); | |
76f9c7f4 | 2810 | |
20922782 SB |
2811 | Put (B, "-- Wasted_Bits are unused bits between fields, and padding at the end" & LF); |
2812 | Put (B, "-- to round up to a multiple of the slot size." & LF); | |
76f9c7f4 | 2813 | |
20922782 | 2814 | Put (B, LF & "-- Type_Layout is " & Image (Type_Layout_Size / 8) & " bytes." & LF); |
76f9c7f4 | 2815 | |
20922782 SB |
2816 | Put (B, LF & "pragma Style_Checks (Off);" & LF); |
2817 | Put (B, "Type_Layout : constant Concrete_Type_Layout_Array := " & LF); | |
2818 | Increase_Indent (B, 2); | |
2819 | Put (B, "-- Concrete node types:" & LF); | |
76f9c7f4 | 2820 | Put (B, "("); |
20922782 | 2821 | Increase_Indent (B, 1); |
76f9c7f4 BD |
2822 | |
2823 | declare | |
2824 | First_Time : Boolean := True; | |
a6fe12b0 | 2825 | |
76f9c7f4 BD |
2826 | begin |
2827 | for T in Concrete_Type loop | |
2828 | if First_Time then | |
2829 | First_Time := False; | |
2830 | else | |
20922782 | 2831 | Put (B, "," & LF & LF); |
76f9c7f4 BD |
2832 | end if; |
2833 | ||
2834 | if T = Concrete_Entity'First then | |
20922782 | 2835 | Put (B, "-- Concrete entity types:" & LF & LF); |
76f9c7f4 BD |
2836 | end if; |
2837 | ||
20922782 | 2838 | Put (B, Image (T) & " => new Field_Array'" & LF); |
76f9c7f4 | 2839 | |
20922782 | 2840 | Increase_Indent (B, 2); |
76f9c7f4 | 2841 | Put (B, "("); |
20922782 | 2842 | Increase_Indent (B, 1); |
76f9c7f4 BD |
2843 | |
2844 | declare | |
2845 | First_Time : Boolean := True; | |
2846 | First_Bit : Bit_Offset := 0; | |
a6fe12b0 BD |
2847 | F : Opt_Field_Enum; |
2848 | ||
2849 | function Node_Field_Of_Entity return String is | |
2850 | (if T in Entity_Type and then F in Node_Field then | |
2851 | " -- N" else ""); | |
2852 | -- A comment to put out for fields of entities that are | |
2853 | -- shared with nodes, such as Chars. | |
2854 | ||
76f9c7f4 BD |
2855 | begin |
2856 | while First_Bit < Type_Bit_Size_Aligned (T) loop | |
2857 | if First_Time then | |
2858 | First_Time := False; | |
2859 | else | |
a6fe12b0 | 2860 | Put (B, "," & Node_Field_Of_Entity & LF); |
76f9c7f4 BD |
2861 | end if; |
2862 | ||
a6fe12b0 BD |
2863 | F := Type_Layout (T) (First_Bit); |
2864 | ||
76f9c7f4 | 2865 | declare |
a6fe12b0 BD |
2866 | Last_Bit : constant Bit_Offset := |
2867 | Get_Last_Bit (T, F, First_Bit); | |
76f9c7f4 | 2868 | begin |
a6fe12b0 BD |
2869 | pragma Assert |
2870 | (Type_Layout (T) (First_Bit .. Last_Bit) = | |
2871 | (First_Bit .. Last_Bit => F)); | |
2872 | ||
2873 | if Last_Bit = First_Bit then | |
2874 | Put (B, First_Bit_Image (First_Bit) & " => " & | |
2875 | Image_Or_Waste (F)); | |
2876 | else | |
76f9c7f4 | 2877 | pragma Assert |
a6fe12b0 BD |
2878 | (if F /= No_Field then |
2879 | First_Bit mod Field_Size (F) = 0); | |
2880 | Put (B, First_Bit_Image (First_Bit) & " .. " & | |
2881 | Last_Bit_Image (Last_Bit) & " => " & | |
2882 | Image_Or_Waste (F)); | |
2883 | end if; | |
2884 | ||
2885 | First_Bit := Last_Bit + 1; | |
76f9c7f4 BD |
2886 | end; |
2887 | end loop; | |
2888 | end; | |
2889 | ||
20922782 | 2890 | Decrease_Indent (B, 1); |
76f9c7f4 | 2891 | Put (B, ")"); |
20922782 | 2892 | Decrease_Indent (B, 2); |
76f9c7f4 BD |
2893 | end loop; |
2894 | end; | |
2895 | ||
20922782 SB |
2896 | Decrease_Indent (B, 1); |
2897 | Put (B, ") -- Type_Layout" & LF); | |
2898 | Increase_Indent (B, 6); | |
2899 | Put (B, "with Export, Convention => Ada;" & LF); | |
2900 | Decrease_Indent (B, 6); | |
2901 | Decrease_Indent (B, 2); | |
76f9c7f4 | 2902 | |
20922782 SB |
2903 | Put (B, LF & "-- Table mapping bit offsets to the set of fields at that offset" & LF & LF); |
2904 | Put (B, "Bit_Used : constant Offset_To_Fields_Mapping :=" & LF); | |
76f9c7f4 | 2905 | |
20922782 | 2906 | Increase_Indent (B, 2); |
76f9c7f4 | 2907 | Put (B, "("); |
20922782 | 2908 | Increase_Indent (B, 1); |
76f9c7f4 BD |
2909 | |
2910 | declare | |
2911 | First_Time : Boolean := True; | |
2912 | begin | |
2913 | for Bit in 0 .. Bit_Offset'Max | |
2914 | (Max_Node_Bit_Size, Max_Entity_Bit_Size) | |
2915 | loop | |
2916 | if First_Time then | |
2917 | First_Time := False; | |
2918 | else | |
20922782 | 2919 | Put (B, "," & LF & LF); |
76f9c7f4 BD |
2920 | end if; |
2921 | ||
20922782 | 2922 | Put (B, First_Bit_Image (Bit) & " => new Field_Array'" & LF); |
76f9c7f4 BD |
2923 | |
2924 | -- Use [...] notation here, to get around annoying Ada | |
2925 | -- limitations on empty and singleton aggregates. This code is | |
2926 | -- not used in the compiler, so there are no bootstrap issues. | |
2927 | ||
20922782 | 2928 | Increase_Indent (B, 2); |
76f9c7f4 | 2929 | Put (B, "["); |
20922782 | 2930 | Increase_Indent (B, 1); |
76f9c7f4 BD |
2931 | |
2932 | Put_Field_List (Bit); | |
2933 | ||
20922782 | 2934 | Decrease_Indent (B, 1); |
76f9c7f4 | 2935 | Put (B, "]"); |
20922782 | 2936 | Decrease_Indent (B, 2); |
76f9c7f4 BD |
2937 | end loop; |
2938 | end; | |
2939 | ||
20922782 SB |
2940 | Decrease_Indent (B, 1); |
2941 | Put (B, "); -- Bit_Used" & LF); | |
2942 | Decrease_Indent (B, 2); | |
76f9c7f4 | 2943 | |
20922782 SB |
2944 | Decrease_Indent (B, 3); |
2945 | Put (B, LF & "end Seinfo_Tables;" & LF); | |
76f9c7f4 BD |
2946 | |
2947 | end Put_Seinfo_Tables; | |
2948 | ||
a7cadd18 BD |
2949 | ----------------------------- |
2950 | -- Put_C_Type_And_Subtypes -- | |
2951 | ----------------------------- | |
2952 | ||
76f9c7f4 | 2953 | procedure Put_C_Type_And_Subtypes |
20922782 | 2954 | (S : in out Sink; Root : Root_Type) is |
76f9c7f4 | 2955 | |
997d3894 BD |
2956 | Cur_Pos : Root_Nat := 0; |
2957 | -- Current Node_Kind'Pos or Entity_Kind'Pos to be printed | |
2958 | ||
76f9c7f4 | 2959 | procedure Put_Enum_Lit (T : Node_Or_Entity_Type); |
5d8fc020 | 2960 | -- Print out the enumerator corresponding to the Ada enumeration literal |
76f9c7f4 | 2961 | -- for T in Node_Kind and Entity_Kind (i.e. concrete types). |
5d8fc020 | 2962 | -- This looks like "Some_Kind = <pos>", where Some_Kind |
997d3894 BD |
2963 | -- is the Node_Kind or Entity_Kind enumeration literal, and |
2964 | -- <pos> is Node_Kind'Pos or Entity_Kind'Pos of that literal. | |
76f9c7f4 BD |
2965 | |
2966 | procedure Put_Kind_Subtype (T : Node_Or_Entity_Type); | |
2967 | -- Print out the SUBTYPE macro call corresponding to an abstract | |
2968 | -- type. | |
2969 | ||
2970 | procedure Put_Enum_Lit (T : Node_Or_Entity_Type) is | |
2971 | begin | |
2972 | if T in Concrete_Type then | |
5d8fc020 | 2973 | Put (S, " " & Image (T) & " = " & Image (Cur_Pos) & "," & LF); |
997d3894 | 2974 | Cur_Pos := Cur_Pos + 1; |
76f9c7f4 BD |
2975 | end if; |
2976 | end Put_Enum_Lit; | |
2977 | ||
2978 | procedure Put_Kind_Subtype (T : Node_Or_Entity_Type) is | |
2979 | begin | |
2980 | if T in Abstract_Type and then Type_Table (T).Parent /= No_Type then | |
20922782 SB |
2981 | Put (S, "SUBTYPE (" & Image (T) & ", " & |
2982 | Image (Type_Table (T).Parent) & "," & LF); | |
2983 | Increase_Indent (S, 3); | |
2984 | Put (S, Image (Type_Table (T).First) & "," & LF); | |
2985 | Put (S, Image (Type_Table (T).Last) & ")" & LF); | |
2986 | Decrease_Indent (S, 3); | |
76f9c7f4 BD |
2987 | end if; |
2988 | end Put_Kind_Subtype; | |
2989 | ||
2990 | begin | |
698425f5 RK |
2991 | Put_Union_Membership (S, Root, Only_Prototypes => True); |
2992 | ||
5d8fc020 | 2993 | Put (S, "enum " & Node_Or_Entity (Root) & "_Kind : unsigned int {" & LF); |
76f9c7f4 | 2994 | Iterate_Types (Root, Pre => Put_Enum_Lit'Access); |
5d8fc020 | 2995 | Put (S, "};" & LF); |
76f9c7f4 | 2996 | |
20922782 | 2997 | Put (S, "#define Number_" & Node_Or_Entity (Root) & "_Kinds " & |
997d3894 | 2998 | Image (Cur_Pos) & "" & LF & LF); |
76f9c7f4 | 2999 | |
76f9c7f4 | 3000 | Iterate_Types (Root, Pre => Put_Kind_Subtype'Access); |
76f9c7f4 | 3001 | |
698425f5 | 3002 | Put_Union_Membership (S, Root, Only_Prototypes => False); |
76f9c7f4 BD |
3003 | end Put_C_Type_And_Subtypes; |
3004 | ||
99e30ba8 BD |
3005 | ------------------ |
3006 | -- Put_C_Getter -- | |
3007 | ------------------ | |
a7cadd18 | 3008 | |
99e30ba8 BD |
3009 | procedure Put_C_Getter |
3010 | (S : in out Sink; F : Field_Enum) | |
76f9c7f4 | 3011 | is |
99e30ba8 BD |
3012 | Rec : Field_Info renames Field_Table (F).all; |
3013 | ||
3014 | Off : constant Field_Offset := Rec.Offset; | |
3015 | F_Size : constant Bit_Offset := Field_Size (Rec.Field_Type); | |
3016 | F_Per_Slot : constant Field_Offset := | |
3017 | SS / Field_Offset (Field_Size (Rec.Field_Type)); | |
3018 | Slot_Off : constant Field_Offset := Off / F_Per_Slot; | |
3019 | In_NH : constant Boolean := Slot_Off < Num_Header_Slots; | |
76f9c7f4 | 3020 | |
99e30ba8 | 3021 | N : constant String := Node_To_Fetch_From (F); |
76f9c7f4 | 3022 | begin |
99e30ba8 BD |
3023 | Put (S, "INLINE " & Get_Set_Id_Image (Rec.Field_Type) & |
3024 | " " & Image (F) & " (Node_Id N)" & LF); | |
76f9c7f4 | 3025 | |
99e30ba8 | 3026 | Put (S, "{" & LF); |
20922782 | 3027 | Increase_Indent (S, 3); |
99e30ba8 BD |
3028 | Put (S, "const Field_Offset Off = " & Image (Rec.Offset) & ";" & LF); |
3029 | Put (S, "const Field_Offset F_Size = " & Image (F_Size) & ";" & LF); | |
76f9c7f4 | 3030 | |
99e30ba8 BD |
3031 | if Field_Size (Rec.Field_Type) /= SS then |
3032 | Put (S, "const any_slot Mask = (1 << F_Size) - 1;" & LF); | |
3033 | end if; | |
76f9c7f4 | 3034 | |
99e30ba8 BD |
3035 | Put (S, "const Field_Offset F_Per_Slot = Slot_Size / F_Size;" & LF); |
3036 | Put (S, "const Field_Offset Slot_Off = Off / F_Per_Slot;" & LF); | |
3037 | Put (S, LF); | |
3038 | if In_NH then | |
3039 | Put (S, "any_slot slot = Node_Offsets_Ptr[" & N & "].Slots[Slot_Off];" & LF); | |
3040 | else | |
3041 | Put (S, "any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[" & N & | |
3042 | "].Offset + Slot_Off);" & LF); | |
3043 | end if; | |
76f9c7f4 | 3044 | |
99e30ba8 BD |
3045 | if Field_Size (Rec.Field_Type) /= SS then |
3046 | Put (S, "unsigned int Raw = (slot >> (Off % F_Per_Slot) * F_Size) & Mask;" & LF); | |
76f9c7f4 | 3047 | else |
99e30ba8 | 3048 | Put (S, "unsigned int Raw = slot;" & LF); |
76f9c7f4 BD |
3049 | end if; |
3050 | ||
5d8fc020 TT |
3051 | Put (S, Get_Set_Id_Image (Rec.Field_Type) & " val = (" & |
3052 | Get_Set_Id_Image (Rec.Field_Type) & ") "); | |
76f9c7f4 | 3053 | |
99e30ba8 BD |
3054 | if Field_Has_Special_Default (Rec.Field_Type) then |
3055 | Increase_Indent (S, 2); | |
3056 | Put (S, "(Raw? Raw : " & Special_Default (Rec.Field_Type) & ")"); | |
3057 | Decrease_Indent (S, 2); | |
a7cadd18 | 3058 | |
99e30ba8 BD |
3059 | else |
3060 | Put (S, "Raw"); | |
3061 | end if; | |
20922782 | 3062 | |
99e30ba8 BD |
3063 | Put (S, ";" & LF); |
3064 | ||
3065 | Put (S, "return val;" & LF); | |
20922782 | 3066 | Decrease_Indent (S, 3); |
99e30ba8 BD |
3067 | Put (S, "}" & LF & LF); |
3068 | end Put_C_Getter; | |
76f9c7f4 | 3069 | |
99e30ba8 BD |
3070 | ------------------- |
3071 | -- Put_C_Getters -- | |
3072 | ------------------- | |
a7cadd18 | 3073 | |
99e30ba8 | 3074 | procedure Put_C_Getters |
20922782 | 3075 | (S : in out Sink; Root : Root_Type) |
76f9c7f4 BD |
3076 | is |
3077 | begin | |
20922782 | 3078 | Put (S, "// Getters for fields" & LF & LF); |
76f9c7f4 BD |
3079 | |
3080 | for F in First_Field (Root) .. Last_Field (Root) loop | |
99e30ba8 | 3081 | Put_C_Getter (S, F); |
76f9c7f4 | 3082 | end loop; |
99e30ba8 | 3083 | end Put_C_Getters; |
76f9c7f4 | 3084 | |
a7cadd18 BD |
3085 | -------------------------- |
3086 | -- Put_Union_Membership -- | |
3087 | -------------------------- | |
3088 | ||
76f9c7f4 | 3089 | procedure Put_Union_Membership |
698425f5 | 3090 | (S : in out Sink; Root : Root_Type; Only_Prototypes : Boolean) is |
76f9c7f4 BD |
3091 | |
3092 | procedure Put_Ors (T : Abstract_Type); | |
3093 | -- Print the "or" (i.e. "||") of tests whether kind is in each child | |
3094 | -- type. | |
3095 | ||
3096 | procedure Put_Ors (T : Abstract_Type) is | |
3097 | First_Time : Boolean := True; | |
3098 | begin | |
3099 | for Child of Type_Table (T).Children loop | |
3100 | if First_Time then | |
3101 | First_Time := False; | |
3102 | else | |
20922782 | 3103 | Put (S, " ||" & LF); |
76f9c7f4 BD |
3104 | end if; |
3105 | ||
3106 | -- Unions, other abstract types, and concrete types each have | |
3107 | -- their own way of testing membership in the C++ code. | |
3108 | ||
3109 | if Child in Abstract_Type then | |
3110 | if Type_Table (Child).Is_Union then | |
20922782 | 3111 | Put (S, "Is_In_" & Image (Child) & " (kind)"); |
76f9c7f4 BD |
3112 | |
3113 | else | |
20922782 | 3114 | Put (S, "IN (kind, " & Image (Child) & ")"); |
76f9c7f4 BD |
3115 | end if; |
3116 | ||
3117 | else | |
20922782 | 3118 | Put (S, "kind == " & Image (Child)); |
76f9c7f4 BD |
3119 | end if; |
3120 | end loop; | |
3121 | end Put_Ors; | |
3122 | ||
3123 | begin | |
698425f5 RK |
3124 | if not Only_Prototypes then |
3125 | Put (S, LF & "// Membership tests for union types" & LF & LF); | |
3126 | end if; | |
76f9c7f4 BD |
3127 | |
3128 | for T in First_Abstract (Root) .. Last_Abstract (Root) loop | |
3129 | if Type_Table (T) /= null and then Type_Table (T).Is_Union then | |
20922782 SB |
3130 | Put (S, "INLINE Boolean" & LF); |
3131 | Put (S, "Is_In_" & Image (T) & " (" & | |
698425f5 RK |
3132 | Node_Or_Entity (Root) & "_Kind kind)" & |
3133 | (if Only_Prototypes then ";" else "") & LF); | |
20922782 | 3134 | |
698425f5 RK |
3135 | if not Only_Prototypes then |
3136 | Put (S, "{" & LF); | |
3137 | Increase_Indent (S, 3); | |
3138 | Put (S, "return" & LF); | |
3139 | Increase_Indent (S, 3); | |
3140 | Put_Ors (T); | |
3141 | Decrease_Indent (S, 3); | |
3142 | Decrease_Indent (S, 3); | |
3143 | Put (S, ";" & LF & "}" & LF); | |
3144 | end if; | |
76f9c7f4 | 3145 | |
20922782 | 3146 | Put (S, "" & LF); |
76f9c7f4 BD |
3147 | end if; |
3148 | end loop; | |
3149 | end Put_Union_Membership; | |
3150 | ||
a7cadd18 BD |
3151 | --------------------- |
3152 | -- Put_Sinfo_Dot_H -- | |
3153 | --------------------- | |
3154 | ||
76f9c7f4 | 3155 | procedure Put_Sinfo_Dot_H is |
20922782 | 3156 | S : Sink; |
76f9c7f4 BD |
3157 | |
3158 | begin | |
20922782 SB |
3159 | Create_File (S, "sinfo.h"); |
3160 | Put (S, "#ifdef __cplusplus" & LF); | |
3161 | Put (S, "extern ""C"" {" & LF); | |
3162 | Put (S, "#endif" & LF & LF); | |
76f9c7f4 | 3163 | |
20922782 | 3164 | Put (S, "typedef Boolean Flag;" & LF & LF); |
76f9c7f4 | 3165 | |
99e30ba8 BD |
3166 | Put (S, "#define N_Head " & N_Head & LF); |
3167 | Put (S, "" & LF); | |
3168 | Put (S, "typedef struct Node_Header {" & LF); | |
3169 | Increase_Indent (S, 2); | |
3170 | Put (S, "any_slot Slots[N_Head];" & LF); | |
3171 | Put (S, "Field_Offset Offset;" & LF); | |
3172 | Decrease_Indent (S, 2); | |
3173 | Put (S, "} Node_Header;" & LF & LF); | |
3174 | ||
3175 | Put (S, "extern Node_Header *Node_Offsets_Ptr;" & LF); | |
3176 | Put (S, "extern any_slot *Slots_Ptr;" & LF & LF); | |
3177 | ||
76f9c7f4 BD |
3178 | Put_C_Type_And_Subtypes (S, Node_Kind); |
3179 | ||
20922782 SB |
3180 | Put (S, "// Getters corresponding to instantiations of Atree.Get_n_Bit_Field" |
3181 | & LF & LF); | |
76f9c7f4 | 3182 | |
99e30ba8 | 3183 | Put_C_Getters (S, Node_Kind); |
76f9c7f4 | 3184 | |
20922782 SB |
3185 | Put (S, "#ifdef __cplusplus" & LF); |
3186 | Put (S, "}" & LF); | |
3187 | Put (S, "#endif" & LF); | |
76f9c7f4 BD |
3188 | end Put_Sinfo_Dot_H; |
3189 | ||
a7cadd18 BD |
3190 | --------------------- |
3191 | -- Put_Einfo_Dot_H -- | |
3192 | --------------------- | |
3193 | ||
76f9c7f4 | 3194 | procedure Put_Einfo_Dot_H is |
20922782 | 3195 | S : Sink; |
76f9c7f4 BD |
3196 | |
3197 | procedure Put_Membership_Query_Spec (T : Node_Or_Entity_Type); | |
76f9c7f4 BD |
3198 | procedure Put_Membership_Query_Defn (T : Node_Or_Entity_Type); |
3199 | -- Print out the Is_... function for T that calls the IN macro on the | |
3200 | -- SUBTYPE. | |
3201 | ||
3202 | procedure Put_Membership_Query_Spec (T : Node_Or_Entity_Type) is | |
3203 | Im : constant String := Image (T); | |
3204 | pragma Assert (Im (Im'Last - 4 .. Im'Last) = "_Kind"); | |
3205 | Im2 : constant String := Im (Im'First .. Im'Last - 5); | |
3206 | Typ : constant String := | |
3207 | (if Is_Descendant (Type_Kind, T) | |
3208 | and then T /= Type_Kind | |
3209 | then "_Type" | |
3210 | else ""); | |
3211 | begin | |
3212 | pragma Assert (not Type_Table (T).Is_Union); | |
3213 | ||
20922782 | 3214 | Put (S, "INLINE B Is_" & Im2 & Typ & " (E Id)"); |
76f9c7f4 BD |
3215 | end Put_Membership_Query_Spec; |
3216 | ||
76f9c7f4 BD |
3217 | procedure Put_Membership_Query_Defn (T : Node_Or_Entity_Type) is |
3218 | begin | |
3219 | if T in Abstract_Type and T not in Root_Type then | |
3220 | Put_Membership_Query_Spec (T); | |
20922782 SB |
3221 | Put (S, "" & LF); |
3222 | Increase_Indent (S, 3); | |
3223 | Put (S, "{ return IN (Ekind (Id), " & Image (T) & "); }" & LF); | |
3224 | Decrease_Indent (S, 3); | |
76f9c7f4 BD |
3225 | end if; |
3226 | end Put_Membership_Query_Defn; | |
3227 | ||
3228 | begin | |
20922782 SB |
3229 | Create_File (S, "einfo.h"); |
3230 | Put (S, "#ifdef __cplusplus" & LF); | |
3231 | Put (S, "extern ""C"" {" & LF); | |
3232 | Put (S, "#endif" & LF & LF); | |
76f9c7f4 | 3233 | |
20922782 | 3234 | Put (S, "typedef Boolean Flag;" & LF & LF); |
76f9c7f4 BD |
3235 | |
3236 | Put_C_Type_And_Subtypes (S, Entity_Kind); | |
3237 | ||
99e30ba8 | 3238 | Put_C_Getters (S, Entity_Kind); |
76f9c7f4 | 3239 | |
20922782 | 3240 | Put (S, "// Abstract type queries" & LF & LF); |
76f9c7f4 | 3241 | |
76f9c7f4 | 3242 | Iterate_Types (Entity_Kind, Pre => Put_Membership_Query_Defn'Access); |
76f9c7f4 | 3243 | |
20922782 SB |
3244 | Put (S, LF & "#ifdef __cplusplus" & LF); |
3245 | Put (S, "}" & LF); | |
3246 | Put (S, "#endif" & LF); | |
76f9c7f4 BD |
3247 | end Put_Einfo_Dot_H; |
3248 | ||
3249 | begin -- Compile | |
3250 | ||
3251 | Check_Completeness; | |
3252 | ||
3253 | Compute_Ranges (Node_Kind); | |
3254 | Compute_Ranges (Entity_Kind); | |
3255 | Compute_Fields_Per_Node; | |
3256 | Compute_Field_Offsets; | |
3257 | Compute_Type_Sizes; | |
a7cadd18 | 3258 | Check_For_Syntactic_Field_Mismatch; |
76f9c7f4 BD |
3259 | |
3260 | Verify_Type_Table; | |
3261 | ||
3262 | Node_Field_Types_Used := | |
3263 | Field_Types_Used (Node_Field'First, Node_Field'Last); | |
3264 | Entity_Field_Types_Used := | |
3265 | Field_Types_Used (Entity_Field'First, Entity_Field'Last); | |
3266 | ||
3267 | Put_Seinfo; | |
3268 | ||
3269 | Put_Nodes; | |
3270 | ||
3271 | Put_Entities; | |
3272 | ||
3273 | Put_Nmake; | |
3274 | ||
3275 | Put_Seinfo_Tables; | |
3276 | ||
3277 | Put_Sinfo_Dot_H; | |
3278 | Put_Einfo_Dot_H; | |
3279 | ||
3280 | end Compile; | |
3281 | ||
a7cadd18 BD |
3282 | -------- |
3283 | -- Sy -- | |
3284 | -------- | |
3285 | ||
76f9c7f4 BD |
3286 | function Sy |
3287 | (Field : Node_Field; | |
3288 | Field_Type : Type_Enum; | |
3289 | Default_Value : Field_Default_Value := No_Default; | |
a7cadd18 | 3290 | Pre, Pre_Get, Pre_Set : String := "") return Field_Sequence is |
76f9c7f4 BD |
3291 | begin |
3292 | return | |
a7cadd18 BD |
3293 | (1 => Create_Syntactic_Field |
3294 | (Field, Field_Type, Default_Value, Pre, Pre_Get, Pre_Set)); | |
76f9c7f4 BD |
3295 | end Sy; |
3296 | ||
a7cadd18 BD |
3297 | -------- |
3298 | -- Sm -- | |
3299 | -------- | |
3300 | ||
76f9c7f4 BD |
3301 | function Sm |
3302 | (Field : Field_Enum; | |
3303 | Field_Type : Type_Enum; | |
3304 | Type_Only : Type_Only_Enum := No_Type_Only; | |
a7cadd18 | 3305 | Pre, Pre_Get, Pre_Set : String := "") return Field_Sequence is |
76f9c7f4 | 3306 | begin |
a7cadd18 BD |
3307 | return (1 => Create_Semantic_Field |
3308 | (Field, Field_Type, Type_Only, Pre, Pre_Get, Pre_Set)); | |
76f9c7f4 BD |
3309 | end Sm; |
3310 | ||
3311 | end Gen_IL.Gen; |