1--  Iir to ortho translator.
2--  Copyright (C) 2002 - 2014 Tristan Gingold
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16with Ada.Unchecked_Deallocation;
17with Interfaces; use Interfaces;
18with Ortho_Nodes; use Ortho_Nodes;
19with Ortho_Ident; use Ortho_Ident;
20with Vhdl.Nodes; use Vhdl.Nodes;
21with Types; use Types;
22
23package Trans is
24
25   --  Ortho type node for STD.BOOLEAN.
26   Std_Boolean_Type_Node         : O_Tnode;
27   Std_Boolean_True_Node         : O_Cnode;
28   Std_Boolean_False_Node        : O_Cnode;
29   --  Array of STD.BOOLEAN.
30   Std_Boolean_Array_Type        : O_Tnode;
31   --  Std_ulogic indexed array of STD.Boolean.
32   Std_Ulogic_Boolean_Array_Type : O_Tnode;
33   --  Ortho type node for string template pointer.
34   Std_String_Ptr_Node           : O_Tnode;
35   Std_String_Node               : O_Tnode;
36
37   --  Ortho type for std.standard.integer.
38   Std_Integer_Otype : O_Tnode;
39
40   --  Ortho type for std.standard.real.
41   Std_Real_Otype : O_Tnode;
42
43   --  Ortho type node for std.standard.time.
44   Std_Time_Otype : O_Tnode;
45
46   --  Node for the variable containing the current filename.
47   Current_Filename_Node : O_Dnode := O_Dnode_Null;
48   Current_Library_Unit  : Iir := Null_Iir;
49
50   --  Global declarations.
51   Ghdl_Ptr_Type           : O_Tnode;
52   Sizetype                : O_Tnode;
53   Ghdl_I32_Type           : O_Tnode;
54   Ghdl_I64_Type           : O_Tnode;
55   Ghdl_Real_Type          : O_Tnode;
56   --  Constant character.
57   Char_Type_Node          : O_Tnode;
58   --  Array of char.
59   Chararray_Type          : O_Tnode;
60   --  Pointer to array of char.
61   Char_Ptr_Type           : O_Tnode;
62   --  Array of char ptr.
63   Char_Ptr_Array_Type     : O_Tnode;
64   Char_Ptr_Array_Ptr_Type : O_Tnode;
65
66   Ghdl_Index_Type : O_Tnode;
67   Ghdl_Index_0    : O_Cnode;
68   Ghdl_Index_1    : O_Cnode;
69   Ghdl_Index_2    : O_Cnode;
70   Ghdl_Index_4    : O_Cnode;
71   Ghdl_Index_8    : O_Cnode;
72   Ghdl_Index_Ptr_Align  : O_Cnode;  --  Alignment of a pointer
73
74   --  Type for a file (this is in fact a index in a private table).
75   Ghdl_File_Index_Type     : O_Tnode;
76   Ghdl_File_Index_Ptr_Type : O_Tnode;
77
78   --  Record containing a len and string fields.
79   Ghdl_Str_Len_Type_Node       : O_Tnode;
80   Ghdl_Str_Len_Type_Len_Field  : O_Fnode;
81   Ghdl_Str_Len_Type_Str_Field  : O_Fnode;
82   Ghdl_Str_Len_Ptr_Node        : O_Tnode;
83   Ghdl_Str_Len_Array_Type_Node : O_Tnode;
84
85   --  Location.
86   Ghdl_Location_Type_Node     : O_Tnode;
87   Ghdl_Location_Filename_Node : O_Fnode;
88   Ghdl_Location_Line_Node     : O_Fnode;
89   Ghdl_Location_Col_Node      : O_Fnode;
90   Ghdl_Location_Ptr_Node      : O_Tnode;
91
92   --  Allocate memory for a block.
93   Ghdl_Alloc_Ptr : O_Dnode;
94
95   --  bool type.
96   Ghdl_Bool_Type : O_Tnode;
97   type Enode_Boolean_Array is array (Boolean) of O_Cnode;
98   Ghdl_Bool_Nodes : Enode_Boolean_Array;
99   Ghdl_Bool_False_Node : O_Cnode renames Ghdl_Bool_Nodes (False);
100   Ghdl_Bool_True_Node : O_Cnode renames Ghdl_Bool_Nodes (True);
101
102   Ghdl_Bool_Array_Type : O_Tnode;
103   Ghdl_Bool_Array_Ptr  : O_Tnode;
104
105   --  Size record
106   Ghdl_Sizes_Type : O_Tnode;
107   Ghdl_Sizes_Val : O_Fnode;
108   Ghdl_Sizes_Sig : O_Fnode;
109
110   --  Access to size.
111   Ghdl_Sizes_Ptr : O_Tnode;
112
113   --  Comparaison type.
114   Ghdl_Compare_Type : O_Tnode;
115   Ghdl_Compare_Lt   : O_Cnode;
116   Ghdl_Compare_Eq   : O_Cnode;
117   Ghdl_Compare_Gt   : O_Cnode;
118
119   --  Dir type.
120   Ghdl_Dir_Type_Node   : O_Tnode;
121   Ghdl_Dir_To_Node     : O_Cnode;
122   Ghdl_Dir_Downto_Node : O_Cnode;
123
124   --  Signals.
125   Ghdl_Scalar_Bytes               : O_Tnode;
126   Ghdl_Signal_Type                : O_Tnode;
127   Ghdl_Signal_Driving_Value_Field : O_Fnode;
128   Ghdl_Signal_Last_Value_Field    : O_Fnode;
129   Ghdl_Signal_Last_Event_Field    : O_Fnode;
130   Ghdl_Signal_Last_Active_Field   : O_Fnode;
131   Ghdl_Signal_Value_Field         : O_Fnode;
132   Ghdl_Signal_Event_Field         : O_Fnode;
133   Ghdl_Signal_Active_Field        : O_Fnode;
134   Ghdl_Signal_Has_Active_Field    : O_Fnode;
135
136   Ghdl_Signal_Ptr     : O_Tnode;
137   Ghdl_Signal_Ptr_Ptr : O_Tnode;
138
139   Check_Stack_Allocation_Threshold : O_Cnode;
140
141   type Object_Kind_Type is (Mode_Value, Mode_Signal);
142
143   --  Well known identifiers.
144   Wki_This          : O_Ident;
145   Wki_Size          : O_Ident;
146   Wki_Res           : O_Ident;
147   Wki_Dir_To        : O_Ident;
148   Wki_Dir_Downto    : O_Ident;
149   Wki_Left          : O_Ident;
150   Wki_Right         : O_Ident;
151   Wki_Dir           : O_Ident;
152   Wki_Length        : O_Ident;
153   Wki_I             : O_Ident;
154   Wki_Instance      : O_Ident;
155   Wki_Arch_Instance : O_Ident;
156   Wki_Name          : O_Ident;
157   Wki_Sig           : O_Ident;
158   Wki_Obj           : O_Ident;
159   Wki_Rti           : O_Ident;
160   Wki_Parent        : O_Ident;
161   Wki_Filename      : O_Ident;
162   Wki_Line          : O_Ident;
163   Wki_Lo            : O_Ident;
164   Wki_Hi            : O_Ident;
165   Wki_Mid           : O_Ident;
166   Wki_Cmp           : O_Ident;
167   Wki_Upframe       : O_Ident;
168   Wki_Frame         : O_Ident;
169   Wki_Val           : O_Ident;
170   Wki_L_Len         : O_Ident;
171   Wki_R_Len         : O_Ident;
172   Wki_Base          : O_Ident;
173   Wki_Bounds        : O_Ident;
174   Wki_Locvars       : O_Ident;
175
176   --  ALLOCATION_KIND defines the type of memory storage.
177   --  ALLOC_STACK means the object is allocated on the local stack and
178   --    deallocated at the end of the function.
179   --  ALLOC_SYSTEM for object created during design elaboration and whose
180   --    life is infinite.
181   --  ALLOC_RETURN for unconstrained object returns by function.
182   --  ALLOC_HEAP for object created by new.
183   type Allocation_Kind is
184     (Alloc_Stack, Alloc_Return, Alloc_Heap, Alloc_System);
185
186   --  Sometimes useful to factorize code.  Defines what has to be translated.
187   type Subprg_Translate_Kind is
188     (Subprg_Translate_Only_Spec,
189      Subprg_Translate_Spec_And_Body,
190      Subprg_Translate_Only_Body);
191   subtype Subprg_Translate_Spec is Subprg_Translate_Kind range
192     Subprg_Translate_Only_Spec .. Subprg_Translate_Spec_And_Body;
193   subtype Subprg_Translate_Body is Subprg_Translate_Kind range
194     Subprg_Translate_Spec_And_Body .. Subprg_Translate_Only_Body;
195
196   --  Return the value of field FIELD of lnode L that is contains
197   --   a pointer to a record.
198   --  This is equivalent to:
199   --  new_value (new_selected_element (new_access_element (new_value (l)),
200   --                                   field))
201   function New_Value_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
202                                          return O_Enode;
203   function New_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
204                                    return O_Lnode;
205
206   function New_Indexed_Acc_Value (L : O_Lnode; I : O_Enode) return O_Lnode;
207
208   --  Equivalent to new_access_element (new_value (l))
209   function New_Acc_Value (L : O_Lnode) return O_Lnode;
210
211   --  Return PTR + OFFSET as a RES_PTR value.  The offset is the number of
212   --  bytes.  RES_PTR must be an access type and the type of PTR must be an
213   --  access.
214   function Add_Pointer
215     (Ptr : O_Enode; Offset : O_Enode; Res_Ptr : O_Tnode) return O_Enode;
216
217   type Elab_Kind is (Elab_Decls, Elab_Stmts);
218   type O_Dnode_Elab is array (Elab_Kind) of O_Dnode;
219
220   package Chap10 is
221      --  There are three data storage kind: global, local or instance.
222      --  For example, a constant can have:
223      --  * a global storage when declared inside a package.  This storage
224      --    can be accessed from any point.
225      --  * a local storage when declared in a subprogram.  This storage
226      --    can be accessed from the subprogram, is created when the subprogram
227      --    is called and destroy when the subprogram exit.
228      --  * an instance storage when declared inside a process.  This storage
229      --    can be accessed from the process via an instance pointer, is
230      --    created during elaboration.
231      --procedure Push_Global_Factory (Storage : O_Storage);
232      --procedure Pop_Global_Factory;
233      procedure Set_Global_Storage (Storage : O_Storage);
234
235      --  Set the global scope handling.
236      Global_Storage : O_Storage;
237
238      --  Scope for variables.  This is used both to build instances (so it
239      --  contains the record type that contains objects declared in that
240      --  scope) and to use instances (it contains the path to access to these
241      --  objects).
242      type Var_Scope_Type is private;
243
244      type Var_Scope_Acc is access all Var_Scope_Type;
245      for Var_Scope_Acc'Storage_Size use 0;
246
247      Null_Var_Scope : constant Var_Scope_Type;
248
249      type Var_Type is private;
250      Null_Var : constant Var_Type;
251
252      --  Return the record type for SCOPE.
253      function Get_Scope_Type (Scope : Var_Scope_Type) return O_Tnode;
254
255      --  Return the size for instances of SCOPE.
256      function Get_Scope_Size (Scope : Var_Scope_Type) return O_Cnode;
257
258      --  Return True iff SCOPE is defined.
259      function Has_Scope_Type (Scope : Var_Scope_Type) return Boolean;
260
261      --  Create an empty and incomplete scope type for SCOPE using NAME.
262      procedure Predeclare_Scope_Type
263        (Scope : in out Var_Scope_Type; Name : O_Ident);
264
265      --  Declare a pointer PTR_TYPE with NAME to scope type SCOPE.
266      procedure Declare_Scope_Acc
267        (Scope : Var_Scope_Type; Name : O_Ident; Ptr_Type : out O_Tnode);
268
269      --  Start to build an instance.
270      --  If INSTANCE_TYPE is not O_TNODE_NULL, it must be an uncompleted
271      --  record type, that will be completed.
272      procedure Push_Instance_Factory (Scope : Var_Scope_Acc);
273
274      --  Likewise but for a frame.
275      procedure Push_Frame_Factory (Scope : Var_Scope_Acc;
276                                    Persistant : Boolean);
277
278      --  Manually add a field to the current instance being built.
279      function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
280                                           return O_Fnode;
281
282      --  In the scope being built, add a field NAME that contain sub-scope
283      --  CHILD.  CHILD is modified so that accesses to CHILD objects is done
284      --  via SCOPE.
285      procedure Add_Scope_Field
286        (Name : O_Ident; Child : in out Var_Scope_Type);
287
288      --  Return the offset of field for CHILD in its parent scope.
289      function Get_Scope_Offset (Child : Var_Scope_Type; Otype : O_Tnode)
290                                 return O_Cnode;
291
292      --  Finish the building of the current instance and return the type
293      --  built.
294      procedure Pop_Instance_Factory (Scope : Var_Scope_Acc);
295      procedure Pop_Frame_Factory (Scope : Var_Scope_Acc);
296
297      --  Create a new scope, in which variable are created locally
298      --  (ie, on the stack).  Always created unlocked.
299      procedure Push_Local_Factory;
300
301      --  Destroy a local scope.
302      procedure Pop_Local_Factory;
303
304      --  Create a special scope for declarations in statements.  The scope
305      --  structure is opaque (typically a union).
306      procedure Create_Union_Scope
307        (Scope : out Var_Scope_Type; Stype : O_Tnode);
308
309      --  Set_Scope defines how to access to variables of SCOPE.
310      --  Variables defined in SCOPE can be accessed via field SCOPE_FIELD
311      --  of scope SCOPE_PARENT.
312      procedure Set_Scope_Via_Field
313        (Scope       : in out Var_Scope_Type;
314         Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc);
315
316      --  Variables defined in SCOPE can be accessed by dereferencing
317      --  field SCOPE_FIELD defined in SCOPE_PARENT.
318      procedure Set_Scope_Via_Field_Ptr
319        (Scope       : in out Var_Scope_Type;
320         Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc);
321
322      --  Variables/scopes defined in SCOPE can be accessed via
323      --  dereference of parameter SCOPE_PARAM.
324      procedure Set_Scope_Via_Param_Ptr
325        (Scope : in out Var_Scope_Type; Scope_Param : O_Dnode);
326
327      --  Variables/scopes defined in SCOPE can be accessed via DECL.
328      procedure Set_Scope_Via_Decl
329        (Scope : in out Var_Scope_Type; Decl : O_Dnode);
330
331      --  Variables/scopes defined in SCOPE can be accessed by derefencing
332      --  VAR.
333      procedure Set_Scope_Via_Var_Ptr
334        (Scope : in out Var_Scope_Type; Var : Var_Type);
335
336      --  Variables/scopes defined in SCOPE can be accesses through VAR.
337      procedure Set_Scope_Via_Var
338        (Scope : in out Var_Scope_Type; Var : Var_Type);
339
340      --  No more accesses to SCOPE_TYPE are allowed.  Scopes must be cleared
341      --  before being set.
342      procedure Clear_Scope (Scope : in out Var_Scope_Type);
343
344      --  True if SCOPE is a null-scope (eg. was cleared).
345      function Is_Null (Scope : Var_Scope_Type) return Boolean;
346
347      --  Reset the identifier.
348      type Id_Mark_Type is limited private;
349      type Local_Identifier_Type is private;
350
351      procedure Reset_Identifier_Prefix;
352      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
353                                        Name : String;
354                                        Val  : Iir_Int32 := 0);
355      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
356                                        Name : Name_Id;
357                                        Val  : Iir_Int32 := 0);
358      procedure Push_Identifier_Prefix_Uniq (Mark : out Id_Mark_Type);
359      procedure Pop_Identifier_Prefix (Mark : in Id_Mark_Type);
360
361      --  Save/restore the local identifier number; this is used by package
362      --  body, which has the same prefix as the package declaration, so it
363      --  must continue local identifiers numbers.
364      --  This is used by subprogram bodies too.
365      procedure Save_Local_Identifier (Id : out Local_Identifier_Type);
366      procedure Restore_Local_Identifier (Id : Local_Identifier_Type);
367
368      --  Create an identifier from IIR node ID without the prefix.
369      function Create_Identifier_Without_Prefix (Id : Iir) return O_Ident;
370      function Create_Identifier_Without_Prefix
371        (Id : Iir; Str : String) return O_Ident;
372      function Create_Identifier_Without_Prefix
373        (Id : Name_Id; Str : String) return O_Ident;
374
375      --  Create an identifier from the current prefix.
376      function Create_Identifier return O_Ident;
377
378      --  Create an identifier from IIR node ID with prefix.
379      function Create_Identifier (Id : Iir; Str : String := "")
380                                  return O_Ident;
381      function Create_Identifier
382        (Id : Iir; Val : Iir_Int32; Str : String := "")
383         return O_Ident;
384      function Create_Identifier (Id : Name_Id; Str : String := "")
385                                  return O_Ident;
386      --  Create a prefixed identifier from a string.
387      function Create_Identifier (Str : String) return O_Ident;
388
389      --  Create an identifier for an elaboration procedure.
390      function Create_Elab_Identifier (Kind : Elab_Kind) return O_Ident;
391
392      --  Create an identifier for a variable.
393      --  IE, if the variable is global, prepend the prefix,
394      --   if the variable belong to an instance, no prefix is added.
395      type Var_Ident_Type is private;
396      function Create_Var_Identifier (Id : Iir) return Var_Ident_Type;
397      function Create_Var_Identifier (Id : String) return Var_Ident_Type;
398      function Create_Var_Identifier (Id : Iir; Str : String; Val : Natural)
399                                      return Var_Ident_Type;
400      function Create_Uniq_Identifier return Var_Ident_Type;
401
402      --  Create variable NAME of type VTYPE in the current scope.
403      --  If the current scope is the global scope, then a variable is
404      --   created at the top level (using decl_global_storage).
405      --  If the current scope is not the global scope, then a field is added
406      --   to the current scope.
407      function Create_Var
408        (Name    : Var_Ident_Type;
409         Vtype   : O_Tnode;
410         Storage : O_Storage := Global_Storage)
411         return Var_Type;
412
413      --  Create a global variable.
414      function Create_Global_Var
415        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
416         return Var_Type;
417
418      --  Create a global constant and initialize it to INITIAL_VALUE.
419      function Create_Global_Const
420        (Name          : O_Ident;
421         Vtype         : O_Tnode;
422         Storage       : O_Storage;
423         Initial_Value : O_Cnode)
424         return Var_Type;
425      procedure Define_Global_Const (Const : in out Var_Type; Val : O_Cnode);
426
427      --  Return the (real) reference to a variable created by Create_Var.
428      function Get_Var (Var : Var_Type) return O_Lnode;
429
430      --  Return a reference to the instance of type ITYPE.
431      function Get_Instance_Ref (Scope : Var_Scope_Type) return O_Lnode;
432
433      --  Return the address of the instance for block BLOCK.
434      function Get_Instance_Access (Block : Iir) return O_Enode;
435
436      --  Return the storage for the variable VAR.
437      function Get_Alloc_Kind_For_Var (Var : Var_Type) return Allocation_Kind;
438
439      --  Return TRUE iff VAR is stable, ie get_var (VAR) can be referenced
440      --  several times.
441      function Is_Var_Stable (Var : Var_Type) return Boolean;
442
443      --  Used only to generate RTI.
444      function Is_Var_Field (Var : Var_Type) return Boolean;
445      function Get_Var_Offset (Var : Var_Type; Otype : O_Tnode) return O_Cnode;
446      function Get_Var_Label (Var : Var_Type) return O_Dnode;
447
448      --  For package instantiation.
449
450      --  Associate INST_SCOPE as the instantiated scope for ORIG_SCOPE.
451      procedure Push_Instantiate_Var_Scope
452        (Inst_Scope : Var_Scope_Acc; Orig_Scope : Var_Scope_Acc);
453
454      --  Remove the association for INST_SCOPE.
455      procedure Pop_Instantiate_Var_Scope
456        (Inst_Scope : Var_Scope_Acc);
457
458      --  Get the associated instantiated scope for SCOPE.
459      function Instantiated_Var_Scope (Scope : Var_Scope_Acc)
460                                       return Var_Scope_Acc;
461
462      --  Create a copy of VAR using instantiated scope (if needed).
463      function Instantiate_Var (Var : Var_Type) return Var_Type;
464
465      --  Create a copy of SCOPE using instantiated scope (if needed).
466      function Instantiate_Var_Scope (Scope : Var_Scope_Type)
467                                     return Var_Scope_Type;
468
469      --  Utility function: convert identifier of N to a string, encoding
470      --  extended characters in extended identifiers (this is different from
471      --  image_identifier that simply returns the identifier, without special
472      --  handling of extended identifiers).
473      function Identifier_To_String (N : Iir) return String;
474   private
475      type Local_Identifier_Type is new Natural;
476      type Id_Mark_Type is record
477         Len      : Natural;
478         Local_Id : Local_Identifier_Type;
479      end record;
480
481      type Var_Ident_Type is record
482         Id : O_Ident;
483      end record;
484
485      --  An instance contains all the data (variable, signals, constant...)
486      --  which are declared by an entity and an architecture.
487      --  (An architecture inherits the data of its entity).
488      --
489      --  The processes and implicit guard signals of an entity/architecture
490      --  are translated into functions.  The first argument of these functions
491      --  is a pointer to the instance.
492
493      type Inst_Build_Kind_Type is
494        (
495         --  Variables are declared locally.
496         Local,
497
498         --  Variables are global.
499         Global,
500
501         --  A record frame is created, whose lifetime is the lifetime of the
502         --  subprogram.  Variables become fields of the record frame, and
503         --  dynamic memory is allocated from the stack.
504         Stack_Frame,
505
506         --  A record frame is created, whose lifetime is longer than the
507         --  lifetime of the subprogram (for subprogram with suspension).
508         --  Variables become fields, and dynamic memory is allocated from the
509         --  secondary stack.
510         Persistant_Frame,
511
512         --  An instance record is created, which is never free.  Dynamic
513         --  memory is allocated from the heap.
514         Instance);
515
516      type Inst_Build_Type (Kind : Inst_Build_Kind_Type);
517      type Inst_Build_Acc is access Inst_Build_Type;
518      type Inst_Build_Type (Kind : Inst_Build_Kind_Type) is record
519         Prev          : Inst_Build_Acc;
520         Prev_Id_Start : Natural;
521         case Kind is
522            when Local =>
523               --  Previous global storage.
524               Prev_Global_Storage : O_Storage;
525            when Global =>
526               null;
527            when Instance | Stack_Frame | Persistant_Frame =>
528               Scope               : Var_Scope_Acc;
529               Elements            : O_Element_List;
530         end case;
531      end record;
532
533      --  Kind of variable:
534      --  VAR_NONE: the variable doesn't exist.
535      --  VAR_GLOBAL: the variable is a global variable (static or not).
536      --  VAR_LOCAL: the variable is on the stack.
537      --  VAR_SCOPE: the variable is in the instance record.
538      type Var_Kind is (Var_None, Var_Global, Var_Local, Var_Scope);
539
540      type Var_Type (Kind : Var_Kind := Var_None) is record
541         case Kind is
542            when Var_None =>
543               null;
544            when Var_Global
545               | Var_Local =>
546               E       : O_Dnode;
547            when Var_Scope =>
548               --  To remember allocator for this variable.
549               I_Build_Kind : Inst_Build_Kind_Type;
550
551               I_Field : O_Fnode;
552               I_Scope : Var_Scope_Acc;
553         end case;
554      end record;
555
556      Null_Var : constant Var_Type := (Kind => Var_None);
557
558      type Var_Scope_Kind is (Var_Scope_None,
559                              Var_Scope_Ptr,
560                              Var_Scope_Decl,
561                              Var_Scope_Field,
562                              Var_Scope_Field_Ptr);
563
564      type Var_Scope_Type (Kind : Var_Scope_Kind := Var_Scope_None) is record
565         Scope_Type : O_Tnode := O_Tnode_Null;
566
567         case Kind is
568            when Var_Scope_None =>
569               --  Not set, cannot be referenced.
570               null;
571            when Var_Scope_Ptr
572               | Var_Scope_Decl =>
573               --  Instance for entity, architecture, component, subprogram,
574               --  resolver, process, guard function, PSL directive, PSL cover,
575               --  PSL assert, component instantiation elaborator
576               D       : O_Dnode;
577            when Var_Scope_Field
578               | Var_Scope_Field_Ptr =>
579               --  For an entity: the architecture.
580               --  For an architecture: ptr to a generate subblock.
581               --  For a subprogram: parent frame
582               Field   : O_Fnode;
583               Up_Link : Var_Scope_Acc;
584         end case;
585      end record;
586
587      Null_Var_Scope : constant Var_Scope_Type := (Scope_Type => O_Tnode_Null,
588                                                   Kind => Var_Scope_None);
589
590   end Chap10;
591   use Chap10;
592
593   package Subprgs is
594      --  Subprograms instances.
595      --
596      --  Subprograms declared inside entities, architecture, blocks
597      --   or processes (but not inside packages) may access to data declared
598      --   outside the subprogram (and this with a life longer than the
599      --   subprogram life).  These data correspond to constants, variables,
600      --   files, signals or types.  However these data are not shared between
601      --   instances of the same entity, architecture...  Subprograms instances
602      --   is the way subprograms access to these data.
603      --  One subprogram instance corresponds to a record.
604
605      --  Type to save an old instance builder.  Subprograms may have at most
606      --  one instance.  If they need severals (for example a protected
607      --  subprogram), the most recent one will have a reference to the
608      --  previous one.
609      type Subprg_Instance_Stack is limited private;
610
611      --  Declare an instance to be added for subprograms.
612      --  SCOPE is the scope to pass to the subprogram.
613      --  PTR_TYPE is a pointer to SCOPE.
614      --  IDENT is an identifier for the interface.
615      --  The previous instance is stored to PREV.  It must be restored with
616      --  Pop_Subprg_Instance.
617      --  Add_Subprg_Instance_Interfaces will add an interface of name IDENT
618      --   and type PTR_TYPE for every instance declared by
619      --   Push_Subprg_Instance.
620      procedure Push_Subprg_Instance (Scope    : Var_Scope_Acc;
621                                      Ptr_Type : O_Tnode;
622                                      Ident    : O_Ident;
623                                      Prev     : out Subprg_Instance_Stack);
624
625      --  Since local subprograms has a direct access to its father interfaces,
626      --  they do not required instances interfaces.
627      --  These procedures are provided to temporarly disable the addition of
628      --  instances interfaces. Use Pop_Subpg_Instance to restore to the
629      --  previous state.
630      procedure Clear_Subprg_Instance (Prev : out Subprg_Instance_Stack);
631
632      --  Revert of the previous subprogram.
633      --  Instances must be removed in opposite order they are added.
634      procedure Pop_Subprg_Instance (Ident : O_Ident;
635                                     Prev  : Subprg_Instance_Stack);
636
637      --  True iff there is currently a subprogram instance.
638      function Has_Current_Subprg_Instance return Boolean;
639
640      --  Contains the subprogram interface for the instance.
641      type Subprg_Instance_Type is private;
642      Null_Subprg_Instance : constant Subprg_Instance_Type;
643
644      --  Add interfaces during the creation of a subprogram.
645      procedure Add_Subprg_Instance_Interfaces
646        (Interfaces : in out O_Inter_List; Vars : out Subprg_Instance_Type);
647
648      --  Add a field in the current factory that reference the current
649      --  instance.
650      procedure Add_Subprg_Instance_Field
651        (Field : out O_Fnode; Prev_Scope : out Var_Scope_Acc);
652
653      --  Associate values to the instance interface during invocation of a
654      --  subprogram.
655      procedure Add_Subprg_Instance_Assoc
656        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Type);
657
658      --  Get the value to be associated to the instance interface.
659      function Get_Subprg_Instance (Vars : Subprg_Instance_Type)
660                                    return O_Enode;
661
662      --  True iff VARS is associated with an instance.
663      function Has_Subprg_Instance (Vars : Subprg_Instance_Type)
664                                    return Boolean;
665
666      --  Assign the instance field FIELD of VAR.
667      procedure Set_Subprg_Instance_Field
668        (Var : O_Dnode; Field : O_Fnode; Vars : Subprg_Instance_Type);
669
670      --  To be called at the beginning and end of a subprogram body creation.
671      --  Call PUSH_SCOPE for the subprogram intances.
672      procedure Start_Subprg_Instance_Use (Vars : Subprg_Instance_Type);
673      procedure Finish_Subprg_Instance_Use (Vars : Subprg_Instance_Type);
674
675      --  Call Push_Scope to reference instance from FIELD.
676      procedure Start_Prev_Subprg_Instance_Use_Via_Field
677        (Prev_Scope : Var_Scope_Acc; Field : O_Fnode);
678      procedure Finish_Prev_Subprg_Instance_Use_Via_Field
679        (Prev_Scope : Var_Scope_Acc; Field : O_Fnode);
680
681      --  Same as above, but for IIR.
682      procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List;
683                                        Subprg     : Iir);
684
685      procedure Start_Subprg_Instance_Use (Subprg : Iir);
686      procedure Finish_Subprg_Instance_Use (Subprg : Iir);
687
688      function Instantiate_Subprg_Instance (Inst : Subprg_Instance_Type)
689                                            return Subprg_Instance_Type;
690   private
691      type Subprg_Instance_Type is record
692         Inter      : O_Dnode;
693         Inter_Type : O_Tnode;
694         Scope      : Var_Scope_Acc;
695      end record;
696      Null_Subprg_Instance : constant Subprg_Instance_Type :=
697        (O_Dnode_Null, O_Tnode_Null, null);
698
699      type Subprg_Instance_Stack is record
700         Scope    : Var_Scope_Acc;
701         Ptr_Type : O_Tnode;
702         Ident    : O_Ident;
703      end record;
704
705      Null_Subprg_Instance_Stack : constant Subprg_Instance_Stack :=
706        (null, O_Tnode_Null, O_Ident_Nul);
707
708      Current_Subprg_Instance : Subprg_Instance_Stack :=
709        Null_Subprg_Instance_Stack;
710   end Subprgs;
711
712   type Ortho_Info_Kind is
713     (
714      Kind_Type,
715      Kind_Incomplete_Type,
716      Kind_Index,
717      Kind_Enum_Lit,
718      Kind_Subprg,
719      Kind_Operator,
720      Kind_Call,
721      Kind_Call_Assoc,
722      Kind_Object,
723      Kind_Signal,
724      Kind_Alias,
725      Kind_Iterator,
726      Kind_Interface,
727      Kind_Disconnect,
728      Kind_Process,
729      Kind_Psl_Directive,
730      Kind_Loop,
731      Kind_Loop_State,
732      Kind_Locvar_State,
733      Kind_Block,
734      Kind_Generate,
735      Kind_Component,
736      Kind_Field,
737      Kind_Package,
738      Kind_Package_Instance,
739      Kind_Config,
740      Kind_Assoc,
741      Kind_Design_File,
742      Kind_Library,
743      Kind_Expr_Eval
744     );
745
746   type Ortho_Info_Type_Kind is
747     (
748      Kind_Type_Scalar,
749      Kind_Type_Array,
750      Kind_Type_Record,
751      Kind_Type_File,
752      Kind_Type_Protected
753     );
754   type O_Tnode_Array is array (Object_Kind_Type) of O_Tnode;
755   type O_Fnode_Array is array (Object_Kind_Type) of O_Fnode;
756   type O_Dnode_Array is array (Object_Kind_Type) of O_Dnode;
757   type Var_Type_Array is array (Object_Kind_Type) of Var_Type;
758
759   type Rti_Depth_Type is new Natural range 0 .. 255;
760
761   --  Additional info for complex types.
762   type Complex_Type_Info is record
763      --  Parameters for type builders.
764      --  NOTE: this is only set for types (and *not* for subtypes).
765      Builder_Instance     : Subprgs.Subprg_Instance_Type;
766      Builder_Layout_Param : O_Dnode;
767      Builder_Proc         : O_Dnode := O_Dnode_Null;
768   end record;
769   type Complex_Type_Arr_Info is array (Object_Kind_Type) of Complex_Type_Info;
770
771   --  Alignment of a type.
772   --  This is only for Mode_Value (for Mode_Signal, the alignment is
773   --  Align_Ptr).
774   --  The size of complex types is determined at run-time, and the code to
775   --  compute it is generated by translation.  But to know the size, the
776   --  alignment must also be known.  It is assumed that allocators (malloc or
777   --  alloca) always return a pointer with the maximum alignment.
778   --  Eg:  type cpl_rec is record
779   --         b : boolean;
780   --         v : integer_array (1 to n);  -- n is a non-locally constant.
781   --       end record;
782   --  The static part contains only field 'b'.  The whole size is of cpl_rec
783   --  is:  sizeof (b) + align(v) + n * sizeof(integer) + align(cpl_rec).
784   --  This makes a lot of suppositions about the ABI:
785   --    * elementary types (including doubles) are always naturally aligned
786   --    * fields are aligned as their type
787   --    * records are aligned to their maximum field
788   --    * pointers have the same size
789   --    * finally, pointers are either 32 or 64 bits.
790   --  Note: deviation from the ABI may result in incorrect code as an object
791   --   that is statically constrained may be viewed as a complex/unbounded
792   --   object too.
793   --  Note: These suppositions are true on x86-64, on windows32.
794   --        but not for double on linux-x86!!
795   type Alignment_Type is
796     (
797      --  When alignment is not known.
798      Align_Undef,
799
800      --  For enumerations, integers, physical types.
801      Align_8, Align_16, Align_32,
802
803      --  For an access.  We suppose that pointers are either 32 or 64 bits.
804      --  So Align_Ptr >= Align_32 but Align_64 >= Align_Ptr
805      Align_Ptr,
806
807      --  For float64 (floating point types), large integers or large physical
808      --  types.
809      Align_64);
810
811   function Align_Val (Algn : Alignment_Type) return O_Cnode;
812
813   --  Mode of the type; roughly speaking, this corresponds to its size
814   --  (for scalars) or its layout (for composite types).
815   --  Used to select library subprograms for signals.
816   type Type_Mode_Type is
817     (
818      --  Unknown mode.
819      Type_Mode_Unknown,
820
821      --  Boolean type, with 2 elements.
822      Type_Mode_B1,
823      --  Enumeration with at most 256 elements.
824      Type_Mode_E8,
825      --  Enumeration with more than 256 elements.
826      Type_Mode_E32,
827      --  Integer types.
828      Type_Mode_I32,
829      Type_Mode_I64,
830      --  Physical types.
831      Type_Mode_P32,
832      Type_Mode_P64,
833      --  Floating point type.
834      Type_Mode_F64,
835      --  File type.
836      Type_Mode_File,
837      --  Thin access.
838      Type_Mode_Acc,
839
840      --  Access to an unbounded type (this is a thin pointer to bounds
841      --  followed by values).
842      Type_Mode_Bounds_Acc,
843
844      --  Record whose size is known at compile-time.  Can be a boxed record
845      --  if the base type is unbounded.
846      Type_Mode_Static_Record,
847      --  Constrained record, but size is not known at compile time.  Can be
848      --  a boxed record if the base type is unbounded.
849      Type_Mode_Complex_Record,
850      --  Record with unbounded component(s).
851      Type_Mode_Unbounded_Record,
852
853      --  Unbounded array type (used for unconstrained arrays).
854      Type_Mode_Unbounded_Array,
855      --  Constrainted array type, with size known at compile-time.
856      Type_Mode_Static_Array,
857      --  Constrained array type (for constrained arrays), but size is
858      --  not known at compile time.
859      Type_Mode_Complex_Array,
860      --  Protected type (always handled as a complex type).
861      Type_Mode_Protected);
862
863   --  For backward source compatibility, to be removed (TODO).
864   Type_Mode_Fat_Array : constant Type_Mode_Type := Type_Mode_Unbounded_Array;
865
866   subtype Type_Mode_Valid is Type_Mode_Type range
867     Type_Mode_B1 .. Type_Mode_Type'Last;
868
869   subtype Type_Mode_Discrete is Type_Mode_Type range
870     Type_Mode_B1 .. Type_Mode_I64;
871
872   subtype Type_Mode_Scalar is Type_Mode_Type range
873     Type_Mode_B1 .. Type_Mode_F64;
874
875   subtype Type_Mode_Integers is Type_Mode_Type range
876     Type_Mode_I32 .. Type_Mode_I64;
877
878   --  Composite types, with the vhdl meaning: record and arrays.
879   subtype Type_Mode_Composite is Type_Mode_Type range
880     Type_Mode_Static_Record .. Type_Mode_Protected;
881
882   subtype Type_Mode_Non_Composite is Type_Mode_Type range
883     Type_Mode_B1 .. Type_Mode_Bounds_Acc;
884
885   --  Array types.
886   subtype Type_Mode_Arrays is Type_Mode_Type range
887     Type_Mode_Unbounded_Array .. Type_Mode_Complex_Array;
888
889   subtype Type_Mode_Bounded_Arrays is Type_Mode_Type range
890     Type_Mode_Static_Array .. Type_Mode_Complex_Array;
891
892   --  Record types.
893   subtype Type_Mode_Records is Type_Mode_Type range
894     Type_Mode_Static_Record .. Type_Mode_Unbounded_Record;
895
896   subtype Type_Mode_Bounded_Records is Type_Mode_Type range
897     Type_Mode_Static_Record .. Type_Mode_Complex_Record;
898
899   --  Thin types, ie types whose length is a scalar.
900   subtype Type_Mode_Thin is Type_Mode_Type range
901     Type_Mode_B1 .. Type_Mode_Bounds_Acc;
902
903   --  Aggregate types, ie types whose length is longer than a scalar.
904   subtype Type_Mode_Aggregate is Type_Mode_Type range
905     Type_Mode_Static_Record .. Type_Mode_Protected;
906   subtype Type_Mode_Fat is Type_Mode_Aggregate;
907
908   subtype Type_Mode_Unbounded is Type_Mode_Type range
909     Type_Mode_Unbounded_Record .. Type_Mode_Unbounded_Array;
910
911   --  Subprogram call argument mechanism.
912   --  In VHDL, the evaluation is strict: actual parameters are evaluated
913   --  before the call.  This is the usual strategy of most compiled languages
914   --  (the main exception being Algol-68 call by name).
915   --
916   --  Call semantic is described in
917   --  LRM08 4.2.2.2 Constant and variable parameters.
918   --
919   --  At the semantic (and LRM level), there are two call convention: either
920   --  call by value or call by reference.  That vocabulary should be used in
921   --  trans for the semantic level: call convention and call-by.  According to
922   --  the LRM, all scalars use the call by value convention.  It is possible
923   --  to change the actual after the call for inout parameters, using
924   --  pass-by value mechanism and copy-in/copy-out.
925   --
926   --  At the low-level (generated code), there are two mechanisms: either
927   --  pass by copy or pass by address.  Again, that vocabulary should be used
928   --  in trans for the low-level: mechanism and pass-by.
929   --
930   --  A call by reference is always passed by address; while a call by value
931   --  can use a pass-by address to a copy of the value.  The later being
932   --  used for fat accesses.  With Ortho, only scalars and pointers can be
933   --  passed by copy.
934
935   --  In GHDL, all non-composite types use the call-by value convention, and
936   --  composite types use the call-by reference convention.  For fat accesses,
937   --  a copy of the value is passed by address.
938
939   type Call_Mechanism is (Pass_By_Copy, Pass_By_Address);
940   type Call_Mechanism_Array is array (Object_Kind_Type) of Call_Mechanism;
941
942   --  These parameters are passed by copy, ie the argument of the subprogram
943   --  is the value of the object.
944   subtype Type_Mode_Pass_By_Copy is Type_Mode_Thin;
945
946   --  The parameters are passed by address, ie the argument of the
947   --  subprogram is an address to the object.
948   subtype Type_Mode_Pass_By_Address is Type_Mode_Aggregate;
949
950   --  Call conventions.
951   subtype Type_Mode_Call_By_Value is Type_Mode_Non_Composite;
952   subtype Type_Mode_Call_By_Reference is Type_Mode_Composite;
953
954   --  Additional informations for a resolving function.
955   type Subprg_Resolv_Info is record
956      Resolv_Func  : O_Dnode;
957      --  Parameter nodes.
958      Var_Instance : Subprgs.Subprg_Instance_Type;
959
960      --  Signals
961      Var_Vals      : O_Dnode;
962      --  Driving vector.
963      Var_Vec       : O_Dnode;
964      --  Length of Vector.
965      Var_Vlen      : O_Dnode;
966      Var_Nbr_Drv   : O_Dnode;
967      Var_Nbr_Ports : O_Dnode;
968   end record;
969   type Subprg_Resolv_Info_Acc is access Subprg_Resolv_Info;
970
971   --  In order to support resume feature of non-sensitized processes and
972   --  procedure, a state variable is added to encode vertices of the control
973   --  flow graph (only suspendable vertices are considered: an inner loop
974   --  that doesn't suspend is not decomposed by this mechanism).
975   type State_Type is new Nat32;
976
977   --  Translation of types.
978   --  (Where you understand that VHDL is more complex than C...)
979   --
980   --  1) For scalar types (integers, physical types, enumeration, floating
981   --     point types) and pointers, the type is fully known during analysis
982   --     and translation:
983   --     a) for integers and physical types, the size is defined by the range.
984   --        GHDL uses either 32-bit or 64-bit types.
985   --     b) for enumeration, the size is defined by the number of literals.
986   --        GHDL uses either 8-bit or 32-bit types.
987   --     c) for floating-point type, GHDL always uses 64-bit types (Float64).
988   --     d) for access types, GHDL uses pointers.  This is slightly more
989   --        complex as sometimes it can be a fat pointer, which is a record
990   --        of two pointers.  But in all cases, the size is known.
991   --
992   --  For composite subtypes (arrays and records), there are several cases:
993   --
994   --  2) Composite types whose sub-elements are statically constrained.
995   --     Eg:  subtype byte is bit_vector (7 downto 0);
996   --     Eg:  subtype word is std_logic_vector (31 downto 0);
997   --     Eg:  type my_bus is record
998   --             req: bit;
999   --             ack: bit;
1000   --             data: byte;
1001   --          end record;
1002   --     This still corresponds to C: sizes and offsets are known during
1003   --     translation.
1004   --     However, for arrays a bound variable is created.  This variable
1005   --     contains the bounds of the array (left, right and direction) and the
1006   --     length of each bound.  This is used both for 'introspection' and for
1007   --     conversion to fat pointers.
1008   --
1009   --  3) Unbounded types.  This is quite usual for parameters.
1010   --     Eg:  procedure disp_hex (v : std_logic_vector);
1011   --     The bounds of an unbounded types are only known during execution, and
1012   --     thus must be passed with the argument.
1013   --     This is not the same case as an object declared with an unbounded
1014   --     type; in that case the bounds are computed during elaboration (or
1015   --     dynamic elaboration).
1016   --     Eg: constant c : std_logic_vector := xxx;
1017   --
1018   --     For these unbounded types, the interface is translated as a fat
1019   --     pointer, which is a structure containing a base pointer and a bound
1020   --     pointer.  The base pointer points to the data while the bound pointer
1021   --     points to the bounds.
1022   --
1023   --     In some case, we need to convert from a bounded representation to an
1024   --     unbounded representation.  This happens while calling a subprogram
1025   --     with a bounded object (and corresponds to a subtype conversion in
1026   --     VHDL terms).  In that case a fat pointer is created, using the object
1027   --     as data and the bounds variable as the bounds.  The opposite
1028   --     conversion can also happen and we just need to check that the bounds
1029   --     are matching and to keep only the data part.
1030   --
1031   --  4) Complex types.  Complex is a word used only by GHDL (not defined by
1032   --     VHDL).  You need to realize that VHDL types are more powerful than C
1033   --     types as you can declare a type whose size is not known by the
1034   --     compiler.
1035   --     Eg:  constant length : natural := call_to_a_complex_function(5);
1036   --          subtype my_word is std_logic_vector (1 to length);
1037   --          type my_bus is record
1038   --             d : my_word;
1039   --             req : std_logic_vector;
1040   --          end record;
1041   --     Clearly, LENGTH is not known during analysis.  In many cases it
1042   --     could be known during elaboration but this is not enough as such a
1043   --     construct could also be used within subprograms using a parameter to
1044   --     define a bound.
1045   --
1046   --     Because the size of these objects is not known during compilation,
1047   --     the objects are allocated dynamically (either on the heap or on the
1048   --     stack) during (dynamic) elaboration.  They also comes with a bound
1049   --     variable.
1050   --
1051   --     For arrays, the bound variable describes the index of the array and
1052   --     the bounds of the elements (if the element is unbounded).
1053   --
1054   --     For records, the bound variable describes the offset and the bounds
1055   --     of the non-static elements.
1056   --
1057
1058   --  OLD:
1059   --  Complex types.
1060   --
1061   --  A complex type is not a VHDL notion, but a translation notion.
1062   --  A complex type is a composite type whose size is not known at compile
1063   --  type. This happends in VHDL because a bound can be globally static.
1064   --  Therefore, the length of an array may not be known at compile type,
1065   --  and this propagates to composite types (record and array) if they
1066   --  have such an element. This is different from unconstrained arrays.
1067   --
1068   --  This occurs frequently in VHDL, and could even happen within
1069   --  subprograms.
1070   --
1071   --  Such types are always dynamically allocated (on the stack or on the
1072   --  heap). They must be continuous in memory so that they could be copied
1073   --  via memcpy/memmove.
1074   --
1075   --  At runtime, the size of such type is computed. A builder procedure
1076   --  is also created to setup inner pointers. This builder procedure should
1077   --  be called at initialization, but also after a copy.
1078   --
1079   --  Example:
1080   --  1) subtype bv_type is bit_vector (l to h);
1081   --     variable a : bv_type
1082   --
1083   --     This is represented by a pointer to an array of bit. No need for
1084   --     builder procedure, as the element type is not complex. But there
1085   --     is a size variable for the size of bv_type
1086   --
1087   --  2) type rec1_type is record
1088   --       f1 : integer;
1089   --       f2 : bv_type;
1090   --     end record;
1091   --
1092   --     This is represented by a pointer to a record. The 'f2' field is
1093   --     an offset to an array of bit. The size of the object is the size
1094   --     of the record (with f2 as a pointer) + the size of bv_type.
1095   --     The alinment of the object is the maximum alignment of its sub-
1096   --     objects: rec1 and bv_type.
1097   --     A builder procedure is needed to initialize the 'f2' field.
1098   --     The memory layout is:
1099   --     +--------------+
1100   --     | rec1:     f1 |
1101   --     |           f2 |---+
1102   --     +--------------+   |
1103   --     | bv_type      |<--+
1104   --     | ...          |
1105   --     +--------------+
1106   --
1107   --  3) type rec2_type is record
1108   --      g1: rec1_type;
1109   --      g2: bv_type;
1110   --      g3: bv_type;
1111   --    end record;
1112   --
1113   --    This is represented by a pointer to a record.  All the three fields
1114   --    are offset (relative to rec2). Alignment is the maximum alignment of
1115   --    the sub-objects (rec2, rec1, bv_type x 3).
1116   --     The memory layout is:
1117   --     +--------------+
1118   --     | rec2:     g1 |---+
1119   --     |           g2 |---|---+
1120   --     |           g3 |---|---|---+
1121   --     +--------------+   |   |   |
1122   --     | rec1:     f1 |<--+   |   |
1123   --     |           f2 |---+   |   |
1124   --     +--------------+   |   |   |
1125   --     | bv_type (f2) |<--+   |   |
1126   --     | ...          |       |   |
1127   --     +--------------+       |   |
1128   --     | bv_type (g2) |<------+   |
1129   --     | ...          |           |
1130   --     +--------------+           |
1131   --     | bv_type (g3) |<----------+
1132   --     | ...          |
1133   --     +--------------+
1134   --
1135   --  4) type bv_arr_type is array (natural range <>) of bv_type;
1136   --     arr2 : bv_arr_type (1 to 4)
1137   --
1138   --     This should be represented by a pointer to bv_type.
1139   --     The memory layout is:
1140   --     +--------------+
1141   --     | bv_type  (1) |
1142   --     | ...          |
1143   --     +--------------+
1144   --     | bv_type  (2) |
1145   --     | ...          |
1146   --     +--------------+
1147   --     | bv_type  (3) |
1148   --     | ...          |
1149   --     +--------------+
1150   --     | bv_type  (4) |
1151   --     | ...          |
1152   --     +--------------+
1153
1154   type Assoc_Conv_Info is record
1155      --  The subprogram created to do the conversion.
1156      Subprg              : O_Dnode;
1157      --  The local base block
1158      Instance_Block      : Iir;
1159      --   and its address.
1160      Instance_Field      : O_Fnode;
1161      --  The instantiated entity (if any).
1162      Instantiated_Entity : Iir;
1163      --   and its address.
1164      Instantiated_Field  : O_Fnode;
1165      --  The object if the subprogram is a method
1166      Method_Object       : O_Fnode;
1167      In_Sig_Field        : O_Fnode;
1168      In_Val_Field        : O_Fnode;
1169      Out_Sig_Field       : O_Fnode;
1170      Out_Val_Field       : O_Fnode;
1171      Record_Type         : O_Tnode;
1172      Record_Ptr_Type     : O_Tnode;
1173   end record;
1174
1175   type Direct_Driver_Type is record
1176      Sig : Iir;
1177      Var : Var_Type;
1178   end record;
1179   type Direct_Driver_Arr is array (Natural range <>) of Direct_Driver_Type;
1180   type Direct_Drivers_Acc is access Direct_Driver_Arr;
1181
1182   type Ortho_Info_Type (Kind : Ortho_Info_Kind);
1183   type Ortho_Info_Acc is access Ortho_Info_Type;
1184
1185   subtype Type_Info_Acc is Ortho_Info_Acc (Kind_Type);
1186   subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type);
1187   subtype Index_Info_Acc is Ortho_Info_Acc (Kind_Index);
1188   subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg);
1189   subtype Operator_Info_Acc is Ortho_Info_Acc (Kind_Operator);
1190   subtype Interface_Info_Acc is Ortho_Info_Acc (Kind_Interface);
1191   subtype Call_Info_Acc is Ortho_Info_Acc (Kind_Call);
1192   subtype Call_Assoc_Info_Acc is Ortho_Info_Acc (Kind_Call_Assoc);
1193   subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object);
1194   subtype Signal_Info_Acc is Ortho_Info_Acc (Kind_Signal);
1195   subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias);
1196   subtype Proc_Info_Acc is Ortho_Info_Acc (Kind_Process);
1197   subtype Psl_Info_Acc is Ortho_Info_Acc (Kind_Psl_Directive);
1198   subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop);
1199   subtype Loop_State_Info_Acc is Ortho_Info_Acc (Kind_Loop_State);
1200   subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block);
1201   subtype Generate_Info_Acc is Ortho_Info_Acc (Kind_Generate);
1202   subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component);
1203   subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field);
1204   subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config);
1205   subtype Assoc_Info_Acc is Ortho_Info_Acc (Kind_Assoc);
1206   subtype Inter_Info_Acc is Ortho_Info_Acc (Kind_Interface);
1207   subtype Design_File_Info_Acc is Ortho_Info_Acc (Kind_Design_File);
1208   subtype Library_Info_Acc is Ortho_Info_Acc (Kind_Library);
1209
1210   procedure Init_Node_Infos;
1211   procedure Update_Node_Infos;
1212   procedure Free_Node_Infos;
1213
1214   procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc);
1215
1216   procedure Clear_Info (Target : Iir);
1217
1218   function Get_Info (Target : Iir) return Ortho_Info_Acc;
1219   pragma Inline (Get_Info);
1220
1221   --  Create an ortho_info field of kind KIND for iir node TARGET, and
1222   --  return it.
1223   function Add_Info (Target : Iir; Kind : Ortho_Info_Kind)
1224                      return Ortho_Info_Acc;
1225
1226   procedure Free_Info (Target : Iir);
1227
1228   procedure Free_Type_Info (Info : in out Type_Info_Acc);
1229
1230   function Get_Ortho_Literal (Target : Iir) return O_Cnode;
1231
1232   function Get_Ortho_Type (Target : Iir; Is_Sig : Object_Kind_Type)
1233                            return O_Tnode;
1234
1235   --  Return true is INFO is a type info for a composite type, ie:
1236   --  * a record
1237   --  * an array (fat or thin)
1238   --  * a fat pointer.
1239   function Is_Composite (Info : Type_Info_Acc) return Boolean;
1240   pragma Inline (Is_Composite);
1241
1242   --  Type is bounded but layout and size are known only during elaboration.
1243   function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean;
1244
1245   --  Type size is known at compile-time.
1246   function Is_Static_Type (Tinfo : Type_Info_Acc) return Boolean;
1247
1248   --  True iff TINFO is base + bounds.
1249   function Is_Unbounded_Type (Tinfo : Type_Info_Acc) return Boolean;
1250   pragma Inline (Is_Unbounded_Type);
1251
1252   type Hexstr_Type is array (Integer range 0 .. 15) of Character;
1253   N2hex : constant Hexstr_Type := "0123456789abcdef";
1254
1255   type Ortho_Info_Basetype_Type
1256     (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar) is record
1257      --  For all types:
1258      --  This is the maximum depth of RTI, that is the max of the depth of
1259      --  the type itself and every types it depends on.
1260      Rti_Max_Depth : Rti_Depth_Type;
1261
1262      Align : Alignment_Type;
1263
1264      case Kind is
1265         when Kind_Type_Scalar =>
1266            --  For scalar types:
1267            --  Ortho type for the range record type.
1268            Range_Type : O_Tnode;
1269
1270            --  Ortho type for an access to the range record type.
1271            Range_Ptr_Type : O_Tnode;
1272
1273            --  Fields of TYPE_RANGE_TYPE.
1274            Range_Left   : O_Fnode;
1275            Range_Right  : O_Fnode;
1276            Range_Dir    : O_Fnode;
1277            Range_Length : O_Fnode;
1278
1279         when Kind_Type_Array
1280           | Kind_Type_Record =>
1281            --  For unbounded types:
1282            --  The base type.
1283            Base_Type       : O_Tnode_Array;
1284            Base_Ptr_Type   : O_Tnode_Array;
1285            --  The dope vector.
1286            --  For arrays:
1287            --    range of indexes
1288            --    layout of element (if element is unbounded)
1289            --  For record:
1290            --    offsets of complex elements
1291            --    layout of unbounded elements
1292            Bounds_Type     : O_Tnode;
1293            Bounds_Ptr_Type : O_Tnode;
1294
1295            --  For arrays with unbounded element, the layout field of the
1296            --  bounds type.
1297            Bounds_El       : O_Fnode;
1298
1299            --  Size + bounds.
1300            --  Always created for arrays, created for unbounded and complex
1301            --  records.
1302            Layout_Type     : O_Tnode;
1303            Layout_Ptr_Type : O_Tnode;
1304
1305            --  Size and bounds fields of the layout type.
1306            Layout_Size     : O_Fnode;
1307            Layout_Bounds   : O_Fnode;
1308
1309            --  The ortho type is a fat pointer to the base and the bounds.
1310            --  These are the fields of the fat pointer.
1311            Base_Field   : O_Fnode_Array;
1312            Bounds_Field : O_Fnode_Array;
1313
1314            --  Parameters for type builders.
1315            --  NOTE: this is only set for types (and *not* for subtypes).
1316            Builder      : Complex_Type_Arr_Info;
1317
1318         when Kind_Type_File =>
1319            --  Constant containing the signature of the file.
1320            File_Signature : O_Dnode;
1321
1322         when Kind_Type_Protected =>
1323            Prot_Scope : aliased Var_Scope_Type;
1324            Prot_Prev_Scope : Var_Scope_Acc;
1325
1326            --  Init procedure for the protected type.
1327            Prot_Init_Subprg           : O_Dnode;
1328            Prot_Init_Instance         : Subprgs.Subprg_Instance_Type;
1329            --  Final procedure.
1330            Prot_Final_Subprg          : O_Dnode;
1331            Prot_Final_Instance        : Subprgs.Subprg_Instance_Type;
1332            --  The outer instance, if any.
1333            Prot_Subprg_Instance_Field : O_Fnode;
1334            --  The LOCK field in the object type
1335            Prot_Lock_Field            : O_Fnode;
1336      end case;
1337   end record;
1338
1339   type Subtype_Fields_Type is record
1340      Tinfo : Type_Info_Acc;
1341      Fields : O_Fnode_Array;
1342   end record;
1343
1344   Subtype_Fields_Null : constant Subtype_Fields_Type :=
1345     (Tinfo => null, Fields => (others => O_Fnode_Null));
1346
1347   type Subtype_Fields_Array is
1348     array (Iir_Index32 range <>) of Subtype_Fields_Type;
1349   type Subtype_Fields_Array_Acc is access Subtype_Fields_Array;
1350
1351   type Ortho_Info_Subtype_Type
1352     (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar) is record
1353      case Kind is
1354         when Kind_Type_Scalar =>
1355            --  For scalar types:
1356            --  True if no need to check against low/high bound.
1357            Nocheck_Low : Boolean := False;
1358            Nocheck_Hi  : Boolean := False;
1359
1360            --  For scalar types:
1361            --  Range_Var is the same as its type mark (there is no need to
1362            --  create a new range var if the range is the same).
1363            Same_Range : Boolean := False;
1364
1365            --  Tree for the range record declaration.
1366            Range_Var : Var_Type := Null_Var;
1367
1368         when Kind_Type_Array
1369           | Kind_Type_Record =>
1370            --  Variable containing the layout for a constrained type.
1371            Composite_Layout : Var_Type;
1372
1373            Subtype_Owner : Type_Info_Acc := null;
1374            Owner_Field : Field_Info_Acc := null;
1375
1376            --  For static record subtype: the fields of the constraints.
1377            Rec_Fields : Subtype_Fields_Array_Acc;
1378
1379         when Kind_Type_File =>
1380            null;
1381
1382         when Kind_Type_Protected =>
1383            null;
1384      end case;
1385   end record;
1386
1387   --    Ortho_Info_Type_Scalar_Init : constant Ortho_Info_Type_Type :=
1388   --      (Kind => Kind_Type_Scalar,
1389   --       Range_Type => O_Tnode_Null,
1390   --       Range_Ptr_Type => O_Tnode_Null,
1391   --       Range_Var => null,
1392   --       Range_Left => O_Fnode_Null,
1393   --       Range_Right => O_Fnode_Null,
1394   --       Range_Dir => O_Fnode_Null,
1395   --       Range_Length => O_Fnode_Null);
1396
1397   Ortho_Info_Basetype_Array_Init : constant Ortho_Info_Basetype_Type :=
1398     (Kind => Kind_Type_Array,
1399      Rti_Max_Depth => 0,
1400      Align => Align_Undef,
1401      Base_Type => (O_Tnode_Null, O_Tnode_Null),
1402      Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null),
1403      Bounds_Type => O_Tnode_Null,
1404      Bounds_Ptr_Type => O_Tnode_Null,
1405      Bounds_El => O_Fnode_Null,
1406      Layout_Type => O_Tnode_Null,
1407      Layout_Ptr_Type => O_Tnode_Null,
1408      Layout_Size => O_Fnode_Null,
1409      Layout_Bounds => O_Fnode_Null,
1410      Base_Field => (O_Fnode_Null, O_Fnode_Null),
1411      Bounds_Field => (O_Fnode_Null, O_Fnode_Null),
1412      Builder => (others => (Builder_Instance => Subprgs.Null_Subprg_Instance,
1413                             Builder_Layout_Param => O_Dnode_Null,
1414                             Builder_Proc => O_Dnode_Null)));
1415
1416   Ortho_Info_Subtype_Array_Init : constant Ortho_Info_Subtype_Type :=
1417     (Kind => Kind_Type_Array,
1418      Composite_Layout => Null_Var,
1419      Subtype_Owner => null,
1420      Owner_Field => null,
1421      Rec_Fields => null);
1422
1423   Ortho_Info_Basetype_Record_Init : constant Ortho_Info_Basetype_Type :=
1424     (Kind => Kind_Type_Record,
1425      Rti_Max_Depth => 0,
1426      Align => Align_Undef,
1427      Base_Type => (O_Tnode_Null, O_Tnode_Null),
1428      Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null),
1429      Bounds_Type => O_Tnode_Null,
1430      Bounds_Ptr_Type => O_Tnode_Null,
1431      Bounds_El => O_Fnode_Null,
1432      Layout_Type => O_Tnode_Null,
1433      Layout_Ptr_Type => O_Tnode_Null,
1434      Layout_Size => O_Fnode_Null,
1435      Layout_Bounds => O_Fnode_Null,
1436      Base_Field => (O_Fnode_Null, O_Fnode_Null),
1437      Bounds_Field => (O_Fnode_Null, O_Fnode_Null),
1438      Builder => (others => (Builder_Instance => Subprgs.Null_Subprg_Instance,
1439                             Builder_Layout_Param => O_Dnode_Null,
1440                             Builder_Proc => O_Dnode_Null)));
1441
1442   Ortho_Info_Subtype_Record_Init : constant Ortho_Info_Subtype_Type :=
1443     (Kind => Kind_Type_Record,
1444      Composite_Layout => Null_Var,
1445      Subtype_Owner => null,
1446      Owner_Field => null,
1447      Rec_Fields => null);
1448
1449   Ortho_Info_Basetype_File_Init : constant Ortho_Info_Basetype_Type :=
1450     (Kind => Kind_Type_File,
1451      Rti_Max_Depth => 0,
1452      Align => Align_Undef,
1453      File_Signature => O_Dnode_Null);
1454
1455   Ortho_Info_Basetype_Prot_Init : constant Ortho_Info_Basetype_Type :=
1456     (Kind => Kind_Type_Protected,
1457      Rti_Max_Depth => 0,
1458      Align => Align_Undef,
1459      Prot_Scope => Null_Var_Scope,
1460      Prot_Prev_Scope => null,
1461      Prot_Init_Subprg => O_Dnode_Null,
1462      Prot_Init_Instance => Subprgs.Null_Subprg_Instance,
1463      Prot_Final_Subprg => O_Dnode_Null,
1464      Prot_Subprg_Instance_Field => O_Fnode_Null,
1465      Prot_Final_Instance => Subprgs.Null_Subprg_Instance,
1466      Prot_Lock_Field => O_Fnode_Null);
1467
1468
1469   --  In order to unify and have a common handling of Enode/Lnode/Dnode,
1470   --  let's introduce Mnode (yes, another node).
1471   --
1472   --  Mnodes can be converted to Enode/Lnode via the M2xx functions.  If
1473   --  an Mnode are referenced more than once, they must be stabilized (this
1474   --  will create a new variable if needed as Enode and Lnode can be
1475   --  referenced only once).
1476   --
1477   --  An Mnode is a typed union, containing either an Lnode or a Enode.
1478   --  See Mstate for a description of the union.
1479   --  The real data is contained insisde a record, so that the discriminant
1480   --  can be changed.
1481   type Mnode;
1482
1483   --  State of an Mmode.
1484   type Mstate is
1485     (
1486      --  The Mnode contains an Enode for a value.
1487      --  This Mnode can be used only once.
1488      Mstate_Ev,
1489
1490      --  The Mnode contains an Enode for a pointer.
1491      --  This Mnode can be used only once.
1492      Mstate_Ep,
1493
1494      --  The Mnode contains an Lnode representing a value.
1495      --  This Lnode can be used only once.
1496      Mstate_Lv,
1497
1498      --  The Mnode contains an Lnode representing a pointer.
1499      --  This Lnode can be used only once.
1500      Mstate_Lp,
1501
1502      --  The Mnode contains an Dnode for a variable representing a value.
1503      --  This Dnode may be used several times.
1504      Mstate_Dv,
1505
1506      --  The Mnode contains an Dnode for a variable representing a pointer.
1507      --  This Dnode may be used several times.
1508      Mstate_Dp,
1509
1510      --  Null Mnode.
1511      Mstate_Null,
1512
1513      --  The Mnode is invalid (such as already used).
1514      Mstate_Bad);
1515
1516   type Mnode1 (State : Mstate := Mstate_Bad) is record
1517      --  Additionnal informations about the objects: kind and type.
1518      K : Object_Kind_Type;
1519      T : Type_Info_Acc;
1520
1521      --  Ortho type of the object.
1522      Vtype : O_Tnode;
1523
1524      --  Type for a pointer to the object.
1525      Ptype : O_Tnode;
1526
1527      case State is
1528         when Mstate_Ev =>
1529            Ev : O_Enode;
1530         when Mstate_Ep =>
1531            Ep : O_Enode;
1532         when Mstate_Lv =>
1533            Lv : O_Lnode;
1534         when Mstate_Lp =>
1535            Lp : O_Lnode;
1536         when Mstate_Dv =>
1537            Dv : O_Dnode;
1538         when Mstate_Dp =>
1539            Dp : O_Dnode;
1540         when Mstate_Bad
1541            | Mstate_Null =>
1542            null;
1543      end case;
1544   end record;
1545   --pragma Pack (Mnode1);
1546
1547   type Mnode is record
1548      M1 : Mnode1;
1549   end record;
1550
1551   --  Null Mnode.
1552   Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null,
1553                                                K => Mode_Value,
1554                                                Ptype => O_Tnode_Null,
1555                                                Vtype => O_Tnode_Null,
1556                                                T => null));
1557
1558   type Mnode_Array is array (Object_Kind_Type) of Mnode;
1559
1560   --  Object kind of a Mnode
1561   function Get_Object_Kind (M : Mnode) return Object_Kind_Type;
1562
1563   --  Transform VAR to Mnode.
1564   function Get_Var
1565     (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
1566     return Mnode;
1567
1568   --  Likewise, but VAR is a pointer to the value.
1569   function Get_Varp
1570     (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
1571     return Mnode;
1572
1573   --  Return a stabilized node for M.
1574   --  The former M is not usuable anymore.
1575   function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode;
1576
1577   --  Stabilize M.
1578   procedure Stabilize (M : in out Mnode);
1579
1580   --  If M is not stable, create a variable containing the value of M.
1581   --  M must be scalar (or access).
1582   function Stabilize_Value (M : Mnode) return Mnode;
1583
1584   --  Create a temporary of type INFO and kind KIND.
1585   function Create_Temp (Info : Type_Info_Acc;
1586                         Kind : Object_Kind_Type := Mode_Value)
1587                         return Mnode;
1588
1589   function Get_Type_Info (M : Mnode) return Type_Info_Acc;
1590   pragma Inline (Get_Type_Info);
1591
1592   --  Creation of Mnodes.
1593
1594   function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type)
1595                return Mnode;
1596   function E2M (E : O_Enode;
1597                 T : Type_Info_Acc;
1598                 Kind  : Object_Kind_Type;
1599                 Vtype : O_Tnode;
1600                 Ptype : O_Tnode)
1601                return Mnode;
1602
1603   --  From a Lnode, general form (can be used for ranges, bounds, base...)
1604   function Lv2M (L     : O_Lnode;
1605                  T     : Type_Info_Acc;
1606                  Kind  : Object_Kind_Type;
1607                  Vtype : O_Tnode;
1608                  Ptype : O_Tnode)
1609                 return Mnode;
1610
1611   --  From a Lnode, only for values.
1612   function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
1613                 return Mnode;
1614
1615   --  From a Lnode that designates a pointer, general form.
1616   function Lp2M (L     : O_Lnode;
1617                  T     : Type_Info_Acc;
1618                  Kind  : Object_Kind_Type;
1619                  Vtype : O_Tnode;
1620                  Ptype : O_Tnode)
1621                 return Mnode;
1622
1623   --  From a Lnode that designates a pointer to a value.
1624   function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
1625                 return Mnode;
1626
1627   --  From a variable declaration, general form.
1628   function Dv2M (D     : O_Dnode;
1629                  T     : Type_Info_Acc;
1630                  Kind  : Object_Kind_Type;
1631                  Vtype : O_Tnode;
1632                  Ptype : O_Tnode)
1633                  return Mnode;
1634
1635   --  From a variable for a value.
1636   function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
1637                 return Mnode;
1638
1639   --  From a pointer variable, general form.
1640   function Dp2M (D     : O_Dnode;
1641                  T     : Type_Info_Acc;
1642                  Kind  : Object_Kind_Type;
1643                  Vtype : O_Tnode;
1644                  Ptype : O_Tnode)
1645                  return Mnode;
1646
1647   --  From a pointer to a value variable.
1648   function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
1649                 return Mnode;
1650
1651   function M2Lv (M : Mnode) return O_Lnode;
1652
1653   function M2Lp (M : Mnode) return O_Lnode;
1654
1655   function M2Dp (M : Mnode) return O_Dnode;
1656
1657   function M2Dv (M : Mnode) return O_Dnode;
1658
1659   function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode;
1660
1661   function M2E (M : Mnode) return O_Enode;
1662
1663   function M2Addr (M : Mnode) return O_Enode;
1664
1665   --    function Is_Null (M : Mnode) return Boolean is
1666   --    begin
1667   --       return M.M1.State = Mstate_Null;
1668   --    end Is_Null;
1669
1670   function Is_Stable (M : Mnode) return Boolean;
1671
1672   function Varv2M (Var      : Var_Type;
1673                    Var_Type : Type_Info_Acc;
1674                    Mode     : Object_Kind_Type;
1675                    Vtype    : O_Tnode;
1676                    Ptype    : O_Tnode)
1677                    return Mnode;
1678
1679   --  Convert a Lnode for a sub object to an MNODE.
1680   function Lo2M (L : O_Lnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
1681                  return Mnode;
1682
1683   function Lo2M (D : O_Dnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
1684                  return Mnode;
1685
1686   type Ortho_Info_Type (Kind : Ortho_Info_Kind) is record
1687      --  For a simple memory management: use mark and sweep to free all infos.
1688      Mark : Boolean := False;
1689
1690      case Kind is
1691         when Kind_Type =>
1692            --  Mode of the type.
1693            Type_Mode : Type_Mode_Type := Type_Mode_Unknown;
1694
1695            --  If true, the type is (still) incomplete.
1696            Type_Incomplete : Boolean := False;
1697
1698            --  For array only.  True if the type is constrained with locally
1699            --  static bounds.  May have non locally-static bounds in some
1700            --  of its sub-element (ie being a complex type).
1701            Type_Locally_Constrained : Boolean := False;
1702
1703            --  Ortho node which represents the type.
1704            --  Type                             -> Ortho type
1705            --   scalar                          ->  scalar
1706            --   bounded record (complex or not) ->  record
1707            --   constrained non-complex array   ->  constrained array
1708            --   constrained complex array       ->  the element
1709            --   unbounded array or record       ->  fat pointer
1710            --   access to unconstrained array   ->  fat pointer
1711            --   access (others)                 ->  access
1712            --   file                            ->  file_index_type
1713            --   protected                       ->  instance
1714            Ortho_Type : O_Tnode_Array;
1715
1716            --  Ortho pointer to the type.  This is always an access to the
1717            --  ortho_type.
1718            Ortho_Ptr_Type : O_Tnode_Array;
1719
1720            --  More info according to the type.
1721            B : Ortho_Info_Basetype_Type;
1722            S : Ortho_Info_Subtype_Type;
1723
1724            --  Run-time information.
1725            Type_Rti : O_Dnode := O_Dnode_Null;
1726
1727         when Kind_Incomplete_Type =>
1728            --  The declaration of the incomplete type.
1729            Incomplete_Type  : Iir;
1730
1731         when Kind_Index =>
1732            --  For index_subtype_declaration, the field containing
1733            --  the bounds of that index, in the array bounds record.
1734            Index_Field : O_Fnode;
1735
1736         when Kind_Field =>
1737            --  For element whose type is static: field in the record.
1738            --  For element whose type is not static: offset field in the
1739            --    bounds.
1740            Field_Node : O_Fnode_Array := (O_Fnode_Null, O_Fnode_Null);
1741
1742            --  The field in the layout record for the layout of the
1743            --  element (for unbounded element).
1744            Field_Bound : O_Fnode := O_Fnode_Null;
1745
1746         when Kind_Enum_Lit =>
1747            --  Ortho tree which represents the expression, used for
1748            --  enumeration literals.
1749            Lit_Node : O_Cnode;
1750
1751         when Kind_Subprg =>
1752            --  True if the function can return a value stored in the secondary
1753            --  stack.  In this case, the caller must deallocate the area
1754            --  allocated by the callee when the value was used.
1755            Use_Stack2 : Boolean := False;
1756
1757            --  Subprogram declaration node.
1758            Subprg_Node : O_Dnode;
1759
1760            --  For a function:
1761            --    If the return value is not composite, then this field
1762            --      must be O_DNODE_NULL.
1763            --    If the return value is a composite type, then the caller must
1764            --    give to the callee an area to put the result.  This area is
1765            --    given via an (hidden to the user) interface.  Furthermore,
1766            --    the function is translated into a procedure.
1767            --  For a procedure:
1768            --    Interface for parameters.
1769            Res_Interface : O_Dnode := O_Dnode_Null;
1770
1771            --  Field in the frame for a pointer to the PARAMS structure.  This
1772            --  is necessary when nested subprograms need to access to
1773            --  paramters. of this subprogram.
1774            Subprg_Params_Var : Var_Type := Null_Var;
1775
1776            --  For a procedure, record containing the parameters.
1777            Subprg_Params_Type : O_Tnode := O_Tnode_Null;
1778            Subprg_Params_Ptr  : O_Tnode := O_Tnode_Null;
1779
1780            --  Field in the parameter struct for the suspend state. Also the
1781            --  suspend state is not a parameter, it is initialized by the
1782            --  caller.
1783            Subprg_State_Field : O_Fnode := O_Fnode_Null;
1784
1785            --  Field in the parameter struct for local variables.
1786            Subprg_Locvars_Field : O_Fnode := O_Fnode_Null;
1787            Subprg_Locvars_Scope : aliased Var_Scope_Type;
1788
1789            --  Access to the declarations within this subprogram.
1790            Subprg_Frame_Scope : aliased Var_Scope_Type;
1791
1792            --  Instances for the subprograms.
1793            Subprg_Instance : Subprgs.Subprg_Instance_Type :=
1794              Subprgs.Null_Subprg_Instance;
1795
1796            Subprg_Resolv : Subprg_Resolv_Info_Acc := null;
1797
1798            --  Local identifier number, set by spec, continued by body.
1799            Subprg_Local_Id : Local_Identifier_Type;
1800
1801            --  If set, return should be converted into exit out of the
1802            --  SUBPRG_EXIT loop and the value should be assigned to
1803            --  SUBPRG_RESULT, if any.
1804            Subprg_Exit   : O_Snode := O_Snode_Null;
1805            Subprg_Result : O_Dnode := O_Dnode_Null;
1806
1807         when Kind_Operator =>
1808            --  For an implicit subprogram like type operators or file
1809            --  subprograms.
1810
1811            --  Use secondary stack (not referenced).
1812            Operator_Stack2 : Boolean := False;
1813
1814            --  True if the body was generated.  Many operators share the same
1815            --  subprogram.
1816            Operator_Body : Boolean := False;
1817
1818            --  Subprogram declaration node.
1819            Operator_Node : O_Dnode;
1820
1821            --  Instances for the subprograms.
1822            Operator_Instance : Subprgs.Subprg_Instance_Type :=
1823              Subprgs.Null_Subprg_Instance;
1824
1825            --  Parameters
1826            Operator_Left, Operator_Right : O_Dnode;
1827            Operator_Res : O_Dnode;
1828
1829         when Kind_Call =>
1830            Call_State_Scope : aliased Var_Scope_Type;
1831            Call_State_Mark : Var_Type := Null_Var;
1832            Call_Params_Var : Var_Type := Null_Var;
1833
1834         when Kind_Call_Assoc =>
1835            --  Variable containing a reference to the actual, for scalar
1836            --  copyout.  The value is passed in the parameter.
1837            Call_Assoc_Ref : Var_Type := Null_Var;
1838
1839            --  Variable containing the value, the bounds and the fat vector.
1840            Call_Assoc_Value : Var_Type_Array := (others => Null_Var);
1841            Call_Assoc_Bounds : Var_Type := Null_Var;
1842            Call_Assoc_Fat : Var_Type_Array := (others => Null_Var);
1843
1844         when Kind_Object =>
1845            --  For constants: set when the object is defined as a constant.
1846            Object_Static   : Boolean;
1847            --  The object itself.
1848            Object_Var      : Var_Type;
1849            --  RTI constant for the object.
1850            Object_Rti      : O_Dnode := O_Dnode_Null;
1851
1852         when Kind_Signal =>
1853            --  The current value of the signal.
1854            --  Also the initial value of collapsed ports.
1855            Signal_Val      : Var_Type := Null_Var;
1856            --  Pointer to the value, for ports.
1857            Signal_Valp     : Var_Type := Null_Var;
1858            --  A pointer to the signal (contains meta data).
1859            Signal_Sig      : Var_Type;
1860            --  Direct driver for signal (if any).
1861            Signal_Driver   : Var_Type := Null_Var;
1862            --  RTI constant for the object.
1863            Signal_Rti      : O_Dnode := O_Dnode_Null;
1864            --  Function to compute the value of object (used for implicit
1865            --   guard signal declaration).
1866            Signal_Function : O_Dnode := O_Dnode_Null;
1867
1868         when Kind_Alias =>
1869            Alias_Var  : Var_Type_Array;
1870            Alias_Kind : Object_Kind_Type;
1871
1872         when Kind_Iterator =>
1873            --  True if the range should be copied as it may change during
1874            --  the loop.
1875            Iterator_Range_Copy : Boolean;
1876            --  Iterator variable.
1877            Iterator_Var : Var_Type;
1878            --  Iterator right bound (used only if the iterator is a range
1879            --  expression).
1880            Iterator_Right : Var_Type;
1881            --  Iterator range pointer (used only if the iterator is not a
1882            --  range expression).
1883            Iterator_Range : Var_Type;
1884
1885         when Kind_Interface =>
1886            --  Call mechanism (by copy or by address) for the interface.
1887            Interface_Mechanism : Call_Mechanism_Array;
1888
1889            --  Ortho declaration for the interface. If not null, there is
1890            --  a corresponding ortho parameter for the interface. While
1891            --  translating nested subprograms (that are unnested),
1892            --  Interface_Field may be set to the corresponding field in the
1893            --  FRAME record. So:
1894            --   Decl: not null, Field:     null: parameter
1895            --   Decl: not null, Field: not null: parameter with a copy in
1896            --                                    the FRAME record.
1897            --   Decl: null,     Field:     null: not possible
1898            --   Decl: null,     Field: not null: field in RESULT record
1899            Interface_Decl  : O_Dnode_Array := (others => O_Dnode_Null);
1900            --  Field of the PARAMS record for arguments of procedure.
1901            --  In that case, Interface_Node must be null.
1902            Interface_Field : O_Fnode_Array := (others => O_Fnode_Null);
1903
1904         when Kind_Expr_Eval =>
1905            --  Result of an evaluation.
1906            Expr_Eval : Mnode;
1907
1908         when Kind_Disconnect =>
1909            --  Variable which contains the time_expression of the
1910            --  disconnection specification
1911            Disconnect_Var : Var_Type;
1912
1913         when Kind_Process =>
1914            Process_Scope : aliased Var_Scope_Type;
1915
1916            --  Subprogram for the process.
1917            Process_Subprg : O_Dnode;
1918
1919            --  Variable (in the frame) containing the current state (a
1920            --  number) used to resume the process.
1921            Process_State : Var_Type := Null_Var;
1922
1923            --  Union containing local declarations for statements.
1924            Process_Locvar_Scope : aliased Var_Scope_Type;
1925
1926            --  List of drivers if Flag_Direct_Drivers.
1927            Process_Drivers : Direct_Drivers_Acc := null;
1928
1929            --  RTI for the process.
1930            Process_Rti_Const : O_Dnode := O_Dnode_Null;
1931
1932         when Kind_Psl_Directive =>
1933            Psl_Scope : aliased Var_Scope_Type;
1934
1935            --  Procedure for the state machine.
1936            Psl_Proc_Subprg       : O_Dnode;
1937            --  Procedure for finalization.  Handles EOS.
1938            Psl_Proc_Final_Subprg : O_Dnode;
1939
1940            --  Type of the state vector.
1941            Psl_Vect_Type : O_Tnode;
1942
1943            --  State vector variable.
1944            Psl_Vect_Var : Var_Type;
1945
1946            --  Counter variable (nbr of failures or coverage)
1947            Psl_Count_Var : Var_Type;
1948
1949            --  RTI for the process.
1950            Psl_Rti_Const : O_Dnode := O_Dnode_Null;
1951
1952         when Kind_Loop =>
1953            --  Labels for the loop.
1954            --  Used for exit/next from while-loop, and to exit from for-loop.
1955            Label_Exit : O_Snode;
1956            --  Used to next from for-loop, with an exit statment.
1957            Label_Next : O_Snode;
1958
1959         when Kind_Loop_State =>
1960            --  Likewise but for a suspendable loop.
1961            --  State next: evaluate condition for a while-loop, update
1962            --  iterator for a for-loop.
1963            Loop_State_Next : State_Type;
1964            --  Body of a for-loop, not used for a while-loop.
1965            Loop_State_Body: State_Type;
1966            --  State after the loop.
1967            Loop_State_Exit  : State_Type;
1968            --  Access to declarations of the iterator.
1969            Loop_State_Scope : aliased Var_Scope_Type;
1970            Loop_Locvar_Scope : aliased Var_Scope_Type;
1971
1972         when Kind_Locvar_State =>
1973            Locvar_Scope : aliased Var_Scope_Type;
1974
1975         when Kind_Block =>
1976            --  Access to declarations of this block.
1977            Block_Scope : aliased Var_Scope_Type;
1978
1979            --  Instance type (ortho record) for declarations contained in the
1980            --  block/entity/architecture.
1981            Block_Decls_Ptr_Type : O_Tnode;
1982
1983            --  For Entity: field in the instance type containing link to
1984            --              parent.
1985            --  For an instantiation: link in the parent block to the instance.
1986            Block_Link_Field : O_Fnode;
1987
1988            --  For an entity: must be o_fnode_null.
1989            --  For an architecture: the entity field.
1990            --  For a block, a component or a generate block: field in the
1991            --    parent instance which contains the declarations for this
1992            --    block.
1993            Block_Parent_Field : O_Fnode;
1994
1995            --  For a generate block: field in the block providing a chain to
1996            --  the previous block (note: this may not be the parent, but
1997            --  is a parent).
1998            Block_Origin_Field     : O_Fnode;
1999            --  For an iterative block: boolean field set when the block
2000            --  is configured.  This is used to check if the block was already
2001            --  configured since index and slice are not compelled to be
2002            --  locally static.
2003            Block_Configured_Field : O_Fnode;
2004
2005            --  For iterative generate block: array of instances.
2006            Block_Decls_Array_Type     : O_Tnode;
2007            Block_Decls_Array_Ptr_Type : O_Tnode;
2008
2009            --  For if-generate generate statement body: the identifier of the
2010            --  body.  Used to know which block_configuration applies to the
2011            --  block.
2012            Block_Id : Nat32;
2013
2014            --  Subprograms which elaborates the block (for entity or arch).
2015            Block_Elab_Subprg   : O_Dnode_Elab;
2016
2017            --  Size of the block instance.
2018            Block_Instance_Size : O_Dnode;
2019
2020            --  Only for an entity: procedure that elaborate the packages this
2021            --  units depend on.  That must be done before elaborating the
2022            --  entity and before evaluating default expressions in generics.
2023            Block_Elab_Pkg_Subprg : O_Dnode;
2024
2025            --  RTI constant for the block.
2026            Block_Rti_Const : O_Dnode := O_Dnode_Null;
2027
2028         when Kind_Generate =>
2029            --  Like Block_Parent_Field: field in the instance for the
2030            --  sub-block.  Always a Ghdl_Ptr_Type, as there are many possible
2031            --  types for the sub-block instance (if/case generate).
2032            Generate_Parent_Field : O_Fnode;
2033
2034            --  Identifier number of the generate statement body.  Used for
2035            --  configuring sub-block, and for grt to index the rti.
2036            Generate_Body_Id : O_Fnode;
2037
2038            --  RTI for the generate statement.
2039            Generate_Rti_Const : O_Dnode := O_Dnode_Null;
2040
2041         when Kind_Component =>
2042            --  How to access to component interfaces.
2043            Comp_Scope : aliased Var_Scope_Type;
2044
2045            --  Instance for the component.
2046            Comp_Ptr_Type  : O_Tnode;
2047            --  Field containing a pointer to the instance link.
2048            Comp_Link      : O_Fnode;
2049            --  RTI for the component.
2050            Comp_Rti_Const : O_Dnode;
2051
2052         when Kind_Config =>
2053            --  Subprogram that configure the block.
2054            Config_Subprg : O_Dnode;
2055            Config_Instance : O_Dnode;
2056
2057         when Kind_Package =>
2058            --  Subprogram which elaborate the package spec/body.
2059            --  External units should call the body elaborator.
2060            --  The spec elaborator is called only from the body elaborator.
2061            Package_Elab_Spec_Subprg : O_Dnode;
2062            Package_Elab_Body_Subprg : O_Dnode;
2063
2064            --  Instance for the elaborators.
2065            Package_Elab_Spec_Instance : Subprgs.Subprg_Instance_Type;
2066            Package_Elab_Body_Instance : Subprgs.Subprg_Instance_Type;
2067
2068            --  Variable set to true when the package is elaborated.
2069            Package_Elab_Var : Var_Type;
2070
2071            --  RTI constant for the package.
2072            Package_Rti_Const : O_Dnode;
2073
2074            --  Access to declarations of the spec.
2075            Package_Spec_Scope : aliased Var_Scope_Type;
2076
2077            --  Instance type for uninstantiated package
2078            Package_Spec_Ptr_Type : O_Tnode;
2079
2080            Package_Body_Scope    : aliased Var_Scope_Type;
2081            Package_Body_Ptr_Type : O_Tnode;
2082
2083            --  Field to the spec within the body.
2084            Package_Spec_Field : O_Fnode;
2085
2086            --  Local id, set by package declaration, continued by package
2087            --  body.
2088            Package_Local_Id : Local_Identifier_Type;
2089
2090         when Kind_Package_Instance =>
2091            --  The variables containing the instance.  There are two variables
2092            --  for interface package: one for the spec, one for the body.
2093            --  For package instantiation, only the variable for the body is
2094            --  used.  The variable for spec is added so that packages with
2095            --  package interfaces don't need to know the body of their
2096            --  interfaces.
2097            Package_Instance_Spec_Var : Var_Type;
2098            Package_Instance_Body_Var : Var_Type;
2099
2100            --  Elaboration procedure for the instance.
2101            Package_Instance_Elab_Subprg : O_Dnode;
2102
2103            Package_Instance_Spec_Scope : aliased Var_Scope_Type;
2104            Package_Instance_Body_Scope : aliased Var_Scope_Type;
2105
2106         when Kind_Assoc =>
2107            --  Association informations.
2108            Assoc_In  : Assoc_Conv_Info;
2109            Assoc_Out : Assoc_Conv_Info;
2110
2111         when Kind_Design_File =>
2112            Design_Filename : O_Dnode;
2113
2114         when Kind_Library =>
2115            Library_Rti_Const : O_Dnode;
2116      end case;
2117   end record;
2118
2119   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
2120     (Name => Ortho_Info_Acc, Object => Ortho_Info_Type);
2121
2122   package Helpers is
2123      --  Generate code to initialize a ghdl_index_type variable V to 0.
2124      procedure Init_Var (V : O_Dnode);
2125
2126      --  Generate code to increment/decrement a ghdl_index_type variable V.
2127      procedure Inc_Var (V : O_Dnode);
2128      procedure Dec_Var (V : O_Dnode);
2129
2130      --  Generate code to exit from loop LABEL iff COND is true.
2131      procedure Gen_Exit_When (Label : O_Snode; Cond : O_Enode);
2132
2133      --  Low-level stack2 mark and release.
2134      procedure Set_Stack2_Mark (Var : O_Lnode);
2135      procedure Release_Stack2 (Var : O_Lnode);
2136
2137      --  Create a region for temporary variables.  The region is only created
2138      --  on demand (at the first Create_Temp*), so you must be careful not
2139      --  to nest with control statement.  For example, the following
2140      --  sequence is not correct:
2141      --    Open_Temp
2142      --    Start_If_Stmt
2143      --    ... Create_Temp ...
2144      --    Finish_If_Stmt
2145      --    Close_Temp
2146      --  Because the first Create_Temp is within the if statement, the
2147      --  declare block will be created within the if statement, and must
2148      --  have been closed before the end of the if statement.
2149      procedure Open_Temp;
2150
2151      --  Create a temporary variable.
2152      function Create_Temp (Atype : O_Tnode) return O_Dnode;
2153      --  Create a temporary variable of ATYPE and initialize it with VALUE.
2154      function Create_Temp_Init (Atype : O_Tnode; Value : O_Enode)
2155                                 return O_Dnode;
2156      --  Create a temporary variable of ATYPE and initialize it with the
2157      --  address of NAME.
2158      function Create_Temp_Ptr (Atype : O_Tnode; Name : O_Lnode)
2159                               return O_Dnode;
2160
2161      function Create_Temp_Bounds (Tinfo : Type_Info_Acc) return Mnode;
2162
2163      --  Create a mark in the temporary region for the stack2.
2164      --  FIXME: maybe a flag must be added to CLOSE_TEMP where it is known
2165      --   stack2 can be released.
2166      procedure Create_Temp_Stack2_Mark;
2167
2168      --  Close the temporary region.
2169      procedure Close_Temp;
2170
2171      --  Like Open_Temp, but will never create a declare region. To be used
2172      --  only within a subprogram, to use the declare region of the
2173      --  subprogram.
2174      procedure Open_Local_Temp;
2175      procedure Close_Local_Temp;
2176
2177      --  Return TRUE if stack2 will be released.  Used for fine-tuning only
2178      --  (return statement).
2179      function Has_Stack2_Mark return Boolean;
2180      --  Manually release stack2.  Used for fine-tuning only.
2181      procedure Stack2_Release;
2182
2183      --  Used only in procedure calls to disable the release of stack2, as
2184      --  it might be part of the state of the call.  Must be called just after
2185      --  Open_Temp.
2186      procedure Disable_Stack2_Release;
2187
2188      --  Free all old temp.
2189      --  Used only to free memory.
2190      procedure Free_Old_Temp;
2191
2192      --  Return a ghdl_index_type literal for NUM.
2193      function New_Index_Lit (Num : Unsigned_64) return O_Cnode;
2194
2195      --  Create a uniq identifier.
2196      subtype Uniq_Identifier_String is String (1 .. 11);
2197      function Create_Uniq_Identifier return Uniq_Identifier_String;
2198      function Create_Uniq_Identifier return O_Ident;
2199   end Helpers;
2200end Trans;
2201