aboutsummaryrefslogtreecommitdiffstats
path: root/src/synth
diff options
context:
space:
mode:
Diffstat (limited to 'src/synth')
-rw-r--r--src/synth/elab-debugger.adb (renamed from src/synth/synth-debugger.adb)4
-rw-r--r--src/synth/elab-debugger.ads (renamed from src/synth/synth-debugger.ads)6
-rw-r--r--src/synth/elab-debugger__on.adb (renamed from src/synth/synth-debugger__on.adb)44
-rw-r--r--src/synth/elab-memtype.adb (renamed from src/synth/synth-memtype.adb)4
-rw-r--r--src/synth/elab-memtype.ads (renamed from src/synth/synth-memtype.ads)4
-rw-r--r--src/synth/elab-vhdl_context-debug.adb73
-rw-r--r--src/synth/elab-vhdl_context-debug.ads22
-rw-r--r--src/synth/elab-vhdl_context.adb514
-rw-r--r--src/synth/elab-vhdl_context.ads222
-rw-r--r--src/synth/elab-vhdl_decls.adb361
-rw-r--r--src/synth/elab-vhdl_decls.ads40
-rw-r--r--src/synth/elab-vhdl_errors.adb58
-rw-r--r--src/synth/elab-vhdl_errors.ads38
-rw-r--r--src/synth/elab-vhdl_expr.adb1402
-rw-r--r--src/synth/elab-vhdl_expr.ads80
-rw-r--r--src/synth/elab-vhdl_files.adb (renamed from src/synth/synth-vhdl_files.adb)26
-rw-r--r--src/synth/elab-vhdl_files.ads (renamed from src/synth/synth-vhdl_files.ads)11
-rw-r--r--src/synth/elab-vhdl_heap.adb (renamed from src/synth/synth-vhdl_heap.adb)7
-rw-r--r--src/synth/elab-vhdl_heap.ads (renamed from src/synth/synth-vhdl_heap.ads)8
-rw-r--r--src/synth/elab-vhdl_insts.adb673
-rw-r--r--src/synth/elab-vhdl_insts.ads36
-rw-r--r--src/synth/elab-vhdl_objtypes.adb (renamed from src/synth/synth-objtypes.adb)42
-rw-r--r--src/synth/elab-vhdl_objtypes.ads (renamed from src/synth/synth-objtypes.ads)25
-rw-r--r--src/synth/elab-vhdl_stmts.adb231
-rw-r--r--src/synth/elab-vhdl_stmts.ads29
-rw-r--r--src/synth/elab-vhdl_types.adb562
-rw-r--r--src/synth/elab-vhdl_types.ads62
-rw-r--r--src/synth/elab-vhdl_values-debug.adb (renamed from src/synth/synth-values-debug.adb)32
-rw-r--r--src/synth/elab-vhdl_values-debug.ads (renamed from src/synth/synth-values-debug.ads)4
-rw-r--r--src/synth/elab-vhdl_values.adb (renamed from src/synth/synth-values.adb)97
-rw-r--r--src/synth/elab-vhdl_values.ads (renamed from src/synth/synth-values.ads)46
-rw-r--r--src/synth/elab.ads21
-rw-r--r--src/synth/synth-disp_vhdl.adb4
-rw-r--r--src/synth/synth-disp_vhdl.ads2
-rw-r--r--src/synth/synth-ieee-numeric_std.adb3
-rw-r--r--src/synth/synth-ieee-numeric_std.ads2
-rw-r--r--src/synth/synth-ieee-std_logic_1164.ads2
-rw-r--r--src/synth/synth-static_oper.adb9
-rw-r--r--src/synth/synth-static_oper.ads4
-rw-r--r--src/synth/synth-vhdl_aggr.adb7
-rw-r--r--src/synth/synth-vhdl_aggr.ads6
-rw-r--r--src/synth/synth-vhdl_context.adb463
-rw-r--r--src/synth/synth-vhdl_context.ads147
-rw-r--r--src/synth/synth-vhdl_decls.adb769
-rw-r--r--src/synth/synth-vhdl_decls.ads39
-rw-r--r--src/synth/synth-vhdl_environment.ads6
-rw-r--r--src/synth/synth-vhdl_expr.adb284
-rw-r--r--src/synth/synth-vhdl_expr.ads34
-rw-r--r--src/synth/synth-vhdl_insts.adb410
-rw-r--r--src/synth/synth-vhdl_insts.ads10
-rw-r--r--src/synth/synth-vhdl_oper.adb5
-rw-r--r--src/synth/synth-vhdl_oper.ads6
-rw-r--r--src/synth/synth-vhdl_static_proc.adb9
-rw-r--r--src/synth/synth-vhdl_static_proc.ads3
-rw-r--r--src/synth/synth-vhdl_stmts.adb231
-rw-r--r--src/synth/synth-vhdl_stmts.ads16
-rw-r--r--src/synth/synthesis.adb22
-rw-r--r--src/synth/synthesis.ads10
58 files changed, 5291 insertions, 1996 deletions
diff --git a/src/synth/synth-debugger.adb b/src/synth/elab-debugger.adb
index 187412cc4..9121cc3a9 100644
--- a/src/synth/synth-debugger.adb
+++ b/src/synth/elab-debugger.adb
@@ -18,7 +18,7 @@
with Types; use Types;
-package body Synth.Debugger is
+package body Elab.Debugger is
procedure Debug_Init (Top : Node) is
begin
null;
@@ -38,4 +38,4 @@ package body Synth.Debugger is
begin
null;
end Debug_Error;
-end Synth.Debugger;
+end Elab.Debugger;
diff --git a/src/synth/synth-debugger.ads b/src/synth/elab-debugger.ads
index 329bab3e2..2b6a79b32 100644
--- a/src/synth/synth-debugger.ads
+++ b/src/synth/elab-debugger.ads
@@ -18,9 +18,9 @@
with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
-package Synth.Debugger is
+package Elab.Debugger is
-- If true, debugging is enabled:
-- * call Debug_Break() before executing the next sequential statement
-- * call Debug_Leave when a frame is destroyed.
@@ -34,4 +34,4 @@ package Synth.Debugger is
-- To be called in case of execution error, like:
-- * index out of bounds.
procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node);
-end Synth.Debugger;
+end Elab.Debugger;
diff --git a/src/synth/synth-debugger__on.adb b/src/synth/elab-debugger__on.adb
index d0e342e1e..608edbb07 100644
--- a/src/synth/synth-debugger__on.adb
+++ b/src/synth/elab-debugger__on.adb
@@ -34,12 +34,14 @@ with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk;
with Vhdl.Parse;
with Vhdl.Utils; use Vhdl.Utils;
-with Synth. Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
--- with Synth.Environment; use Synth.Environment;
-with Synth.Flags;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Context.Debug; use Elab.Vhdl_Context.Debug;
+
+package body Elab.Debugger is
+ Flag_Enabled : Boolean := False;
-package body Synth.Debugger is
Current_Instance : Synth_Instance_Acc;
Current_Loc : Node;
@@ -440,6 +442,8 @@ package body Synth.Debugger is
Put ("net");
when Value_Wire =>
Put ("wire");
+ when Value_Signal =>
+ Put ("signal");
when Value_File =>
Put ("file");
when Value_Const =>
@@ -600,13 +604,12 @@ package body Synth.Debugger is
loop
case Get_Kind (Decl) is
when Iir_Kind_Procedure_Body
- | Iir_Kind_Function_Body =>
+ | Iir_Kind_Function_Body
+ | Iir_Kind_Process_Statement
+ | Iir_Kind_Sensitized_Process_Statement
+ | Iir_Kind_Generate_Statement_Body =>
Decls := Get_Declaration_Chain (Decl);
exit;
- when Iir_Kind_Process_Statement
- | Iir_Kind_Sensitized_Process_Statement =>
- Put_Line ("processes have no parameters");
- return;
when Iir_Kind_While_Loop_Statement
| Iir_Kind_If_Statement
| Iir_Kind_For_Loop_Statement
@@ -619,6 +622,13 @@ package body Synth.Debugger is
Disp_Declaration_Objects (Current_Instance, Decls);
end Info_Locals_Proc;
+ procedure Info_Instance_Proc (Line : String)
+ is
+ pragma Unreferenced (Line);
+ begin
+ Debug_Synth_Instance (Current_Instance);
+ end Info_Instance_Proc;
+
function Walk_Files (Cb : Walk_Cb) return Walk_Status
is
Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain;
@@ -939,10 +949,16 @@ package body Synth.Debugger is
Disp_Current_Lines;
end List_Proc;
+ Menu_Info_Instance : aliased Menu_Entry :=
+ (Kind => Menu_Command,
+ Name => new String'("inst*ance"),
+ Next => null, -- Menu_Info_Tree'Access,
+ Proc => Info_Instance_Proc'Access);
+
Menu_Info_Locals : aliased Menu_Entry :=
(Kind => Menu_Command,
Name => new String'("locals"),
- Next => null, -- Menu_Info_Tree'Access,
+ Next => Menu_Info_Instance'Access,
Proc => Info_Locals_Proc'Access);
Menu_Info_Params : aliased Menu_Entry :=
@@ -1230,6 +1246,8 @@ package body Synth.Debugger is
procedure Debug_Init (Top : Node) is
begin
+ Flag_Enabled := True;
+
Current_Instance := null;
Current_Loc := Top;
@@ -1269,10 +1287,10 @@ package body Synth.Debugger is
procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node) is
begin
- if Flags.Flag_Debug_Enable then
+ if Flag_Enabled then
Current_Instance := Inst;
Current_Loc := Expr;
Debug (Reason_Error);
end if;
end Debug_Error;
-end Synth.Debugger;
+end Elab.Debugger;
diff --git a/src/synth/synth-memtype.adb b/src/synth/elab-memtype.adb
index 7c8943abd..382378c1c 100644
--- a/src/synth/synth-memtype.adb
+++ b/src/synth/elab-memtype.adb
@@ -19,7 +19,7 @@
with System; use System;
with System.Storage_Elements;
-package body Synth.Memtype is
+package body Elab.Memtype is
function "+" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr
is
@@ -114,4 +114,4 @@ package body Synth.Memtype is
return V;
end Read_Fp64;
-end Synth.Memtype;
+end Elab.Memtype;
diff --git a/src/synth/synth-memtype.ads b/src/synth/elab-memtype.ads
index ee6f61c38..2fc088d5e 100644
--- a/src/synth/synth-memtype.ads
+++ b/src/synth/elab-memtype.ads
@@ -23,7 +23,7 @@ with Types; use Types;
with Grt.Types; use Grt.Types;
-package Synth.Memtype is
+package Elab.Memtype is
type Memory_Element is mod 2**8;
type Memory_Array is array (Size_Type range <>) of Memory_Element;
@@ -55,4 +55,4 @@ package Synth.Memtype is
procedure Write_Fp64 (Mem : Memory_Ptr; Val : Fp64);
function Read_Fp64 (Mem : Memory_Ptr) return Fp64;
-end Synth.Memtype;
+end Elab.Memtype;
diff --git a/src/synth/elab-vhdl_context-debug.adb b/src/synth/elab-vhdl_context-debug.adb
new file mode 100644
index 000000000..13f615558
--- /dev/null
+++ b/src/synth/elab-vhdl_context-debug.adb
@@ -0,0 +1,73 @@
+-- Synthesis context.
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+with Simple_IO; use Simple_IO;
+with Utils_IO; use Utils_IO;
+
+with Vhdl.Errors;
+with Elab.Vhdl_Values.Debug; use Elab.Vhdl_Values.Debug;
+
+package body Elab.Vhdl_Context.Debug is
+ procedure Debug_Synth_Instance (Inst : Synth_Instance_Acc) is
+ begin
+ Put_Line ("instance for: "
+ & Vhdl.Errors.Disp_Node (Get_Source_Scope (Inst)));
+ for I in Inst.Objects'Range loop
+ Put_Uns32 (Uns32 (I));
+ Put (": ");
+ case Inst.Objects (I).Kind is
+ when Obj_None =>
+ Put_Line ("none");
+ when Obj_Object =>
+ Put ("object");
+ Put (": ");
+ Debug_Valtyp (Inst.Objects (I).Obj);
+ when Obj_Subtype =>
+ Put ("subtype");
+ Put (": ");
+ Debug_Typ (Inst.Objects (I).T_Typ);
+ when Obj_Instance =>
+ Put ("instance");
+ New_Line;
+ end case;
+ end loop;
+ end Debug_Synth_Instance;
+
+ procedure Debug_Elab_Tree_1 (Inst : Synth_Instance_Acc; Level : Natural) is
+ begin
+ Put_Indent (Level);
+ if Inst = null then
+ Put_Line ("*null*");
+ return;
+ end if;
+
+ Put_Line (Vhdl.Errors.Disp_Node (Get_Source_Scope (Inst)));
+
+ for I in Inst.Objects'Range loop
+ if Inst.Objects (I).Kind = Obj_Instance then
+ Debug_Elab_Tree_1 (Inst.Objects (I).I_Inst, Level + 1);
+ end if;
+ end loop;
+ end Debug_Elab_Tree_1;
+
+ procedure Debug_Elab_Tree (Inst : Synth_Instance_Acc) is
+ begin
+ Debug_Elab_Tree_1 (Inst, 0);
+ end Debug_Elab_Tree;
+end Elab.Vhdl_Context.Debug;
diff --git a/src/synth/elab-vhdl_context-debug.ads b/src/synth/elab-vhdl_context-debug.ads
new file mode 100644
index 000000000..edc057fd3
--- /dev/null
+++ b/src/synth/elab-vhdl_context-debug.ads
@@ -0,0 +1,22 @@
+-- Synthesis context.
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+package Elab.Vhdl_Context.Debug is
+ procedure Debug_Synth_Instance (Inst : Synth_Instance_Acc);
+ procedure Debug_Elab_Tree (Inst : Synth_Instance_Acc);
+end Elab.Vhdl_Context.Debug;
diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb
new file mode 100644
index 000000000..7235ef04d
--- /dev/null
+++ b/src/synth/elab-vhdl_context.adb
@@ -0,0 +1,514 @@
+-- Synthesis context.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Ada.Unchecked_Deallocation;
+
+with Types; use Types;
+with Tables;
+
+with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils;
+
+package body Elab.Vhdl_Context is
+
+ Sig_Nbr : Uns32 := 0;
+
+ package Inst_Tables is new Tables
+ (Table_Component_Type => Synth_Instance_Acc,
+ Table_Index_Type => Instance_Id_Type,
+ Table_Low_Bound => First_Instance_Id,
+ Table_Initial => 16);
+
+ function Get_Instance_Id (Inst : Synth_Instance_Acc)
+ return Instance_Id_Type is
+ begin
+ return Inst.Id;
+ end Get_Instance_Id;
+
+ procedure Make_Root_Instance is
+ begin
+ -- Allow multiple elaborations
+ -- pragma Assert (Root_Instance = null);
+
+ Root_Instance :=
+ new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects,
+ Is_Const => False,
+ Is_Error => False,
+ Id => Inst_Tables.Last + 1,
+ Block_Scope => Global_Info,
+ Up_Block => null,
+ Uninst_Scope => null,
+ Source_Scope => Null_Node,
+ Config => Null_Node,
+ Extra_Units => null,
+ Extra_Link => null,
+ Elab_Objects => 0,
+ Objects => (others => (Kind => Obj_None)));
+ Inst_Tables.Append (Root_Instance);
+ end Make_Root_Instance;
+
+ procedure Free_Base_Instance is
+ begin
+ -- TODO: really free.
+ null;
+ end Free_Base_Instance;
+
+ function Make_Elab_Instance
+ (Parent : Synth_Instance_Acc; Blk : Node; Config : Node)
+ return Synth_Instance_Acc
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Blk);
+ Scope : Sim_Info_Acc;
+ Res : Synth_Instance_Acc;
+ begin
+ if Get_Kind (Blk) = Iir_Kind_Architecture_Body then
+ -- Architectures are extensions of entities.
+ Scope := Get_Info (Vhdl.Utils.Get_Entity (Blk));
+ else
+ Scope := Info;
+ end if;
+
+ Res := new Synth_Instance_Type'(Max_Objs => Info.Nbr_Objects,
+ Is_Const => False,
+ Is_Error => False,
+ Id => Inst_Tables.Last + 1,
+ Block_Scope => Scope,
+ Up_Block => Parent,
+ Uninst_Scope => null,
+ Source_Scope => Blk,
+ Config => Config,
+ Extra_Units => null,
+ Extra_Link => null,
+ Elab_Objects => 0,
+ Objects => (others =>
+ (Kind => Obj_None)));
+ Inst_Tables.Append (Res);
+ return Res;
+ end Make_Elab_Instance;
+
+ procedure Free_Elab_Instance (Synth_Inst : in out Synth_Instance_Acc)
+ is
+ procedure Deallocate is new Ada.Unchecked_Deallocation
+ (Synth_Instance_Type, Synth_Instance_Acc);
+ Id : constant Instance_Id_Type := Synth_Inst.Id;
+ begin
+ Deallocate (Synth_Inst);
+ if Id = Inst_Tables.Last then
+ Inst_Tables.Decrement_Last;
+ else
+ Inst_Tables.Table (Id) := null;
+ end if;
+ end Free_Elab_Instance;
+
+ function Make_Elab_Generate_Instance
+ (Parent : Synth_Instance_Acc; Blk : Node; Config : Node; Len : Natural)
+ return Synth_Instance_Acc
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Blk);
+ Res : Synth_Instance_Acc;
+ begin
+ Res := new Synth_Instance_Type'(Max_Objs => Object_Slot_Type (Len),
+ Is_Const => False,
+ Is_Error => False,
+ Id => Inst_Tables.Last + 1,
+ Block_Scope => Info,
+ Up_Block => Parent,
+ Uninst_Scope => null,
+ Source_Scope => Blk,
+ Config => Config,
+ Extra_Units => null,
+ Extra_Link => null,
+ Elab_Objects => 0,
+ Objects => (others =>
+ (Kind => Obj_None)));
+ Inst_Tables.Append (Res);
+ return Res;
+ end Make_Elab_Generate_Instance;
+
+ function Get_Generate_Sub_Instance
+ (Parent : Synth_Instance_Acc; Idx : Positive) return Synth_Instance_Acc is
+ begin
+ return Parent.Objects (Object_Slot_Type (Idx)).I_Inst;
+ end Get_Generate_Sub_Instance;
+
+ procedure Set_Generate_Sub_Instance
+ (Parent : Synth_Instance_Acc; Idx : Positive; Child : Synth_Instance_Acc)
+ is
+ begin
+ Parent.Objects (Object_Slot_Type (Idx)) := (Obj_Instance, Child);
+ end Set_Generate_Sub_Instance;
+
+ function Is_Error (Inst : Synth_Instance_Acc) return Boolean is
+ begin
+ return Inst.Is_Error;
+ end Is_Error;
+
+ procedure Set_Error (Inst : Synth_Instance_Acc) is
+ begin
+ Inst.Is_Error := True;
+ end Set_Error;
+
+ function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node is
+ begin
+ return Inst.Source_Scope;
+ end Get_Source_Scope;
+
+ function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean is
+ begin
+ return Inst.Is_Const;
+ end Get_Instance_Const;
+
+ function Check_Set_Instance_Const (Inst : Synth_Instance_Acc)
+ return Boolean is
+ begin
+ for I in 1 .. Inst.Elab_Objects loop
+ if Inst.Objects (I).Kind /= Obj_Subtype then
+ return False;
+ end if;
+ end loop;
+ return True;
+ end Check_Set_Instance_Const;
+
+ procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean) is
+ begin
+ pragma Assert (not Val or else Check_Set_Instance_Const (Inst));
+ Inst.Is_Const := Val;
+ end Set_Instance_Const;
+
+ procedure Set_Instance_Config (Inst : Synth_Instance_Acc; Config : Node) is
+ begin
+ pragma Assert (Inst.Config = Null_Node);
+ Inst.Config := Config;
+ end Set_Instance_Config;
+
+ function Get_Instance_Config (Inst : Synth_Instance_Acc) return Node is
+ begin
+ return Inst.Config;
+ end Get_Instance_Config;
+
+ procedure Add_Extra_Instance (Inst : Synth_Instance_Acc;
+ Extra : Synth_Instance_Acc) is
+ begin
+ pragma Assert (Extra.Extra_Link = null);
+ Extra.Extra_Link := Inst.Extra_Units;
+ Inst.Extra_Units := Extra;
+ end Add_Extra_Instance;
+
+ function Get_First_Extra_Instance (Inst : Synth_Instance_Acc)
+ return Synth_Instance_Acc is
+ begin
+ return Inst.Extra_Units;
+ end Get_First_Extra_Instance;
+
+ function Get_Next_Extra_Instance (Inst : Synth_Instance_Acc)
+ return Synth_Instance_Acc is
+ begin
+ return Inst.Extra_Link;
+ end Get_Next_Extra_Instance;
+
+ procedure Create_Object (Syn_Inst : Synth_Instance_Acc;
+ Slot : Object_Slot_Type;
+ Num : Object_Slot_Type := 1) is
+ begin
+ -- Check elaboration order.
+ -- Note: this is not done for package since objects from package are
+ -- commons (same scope), and package annotation order can be different
+ -- from package elaboration order (eg: body).
+ if Slot /= Syn_Inst.Elab_Objects + 1
+ or else Syn_Inst.Objects (Slot).Kind /= Obj_None
+ then
+ Error_Msg_Elab ("synth: bad elaboration order of objects");
+ raise Internal_Error;
+ end if;
+ Syn_Inst.Elab_Objects := Slot + Num - 1;
+ end Create_Object;
+
+ procedure Create_Object_Force
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ begin
+ pragma Assert
+ (Syn_Inst.Objects (Info.Slot).Kind = Obj_None
+ or else Vt = (null, null)
+ or else Syn_Inst.Objects (Info.Slot) = (Kind => Obj_Object,
+ Obj => No_Valtyp));
+ Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt);
+ end Create_Object_Force;
+
+ procedure Create_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ begin
+ Create_Object (Syn_Inst, Info.Slot, 1);
+ Create_Object_Force (Syn_Inst, Decl, Vt);
+ end Create_Object;
+
+ procedure Create_Signal (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Typ : Type_Acc;
+ Init : Value_Acc)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ Vt : Valtyp;
+ begin
+ Create_Object (Syn_Inst, Info.Slot, 1);
+ Vt := (Typ, Create_Value_Signal (Sig_Nbr, Init));
+ Sig_Nbr := Sig_Nbr + 1;
+ Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt);
+ end Create_Signal;
+
+ procedure Replace_Signal
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ Obj : Obj_Type renames Syn_Inst.Objects (Info.Slot);
+ begin
+ pragma Assert (Obj.Kind = Obj_Object);
+ pragma Assert (Obj.Obj.Typ = Vt.Typ);
+ pragma Assert (Obj.Obj.Val.Kind = Value_Signal);
+
+ Obj.Obj := Vt;
+
+ -- TODO: free old signal ?
+ end Replace_Signal;
+
+ procedure Mutate_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ Obj : Obj_Type renames Syn_Inst.Objects (Info.Slot);
+ begin
+ pragma Assert (Obj.Kind = Obj_Object);
+ pragma Assert (Obj.Obj.Typ = Vt.Typ);
+
+ Obj.Obj := Vt;
+ end Mutate_Object;
+
+ procedure Create_Sub_Instance (Syn_Inst : Synth_Instance_Acc;
+ Stmt : Node;
+ Sub_Inst : Synth_Instance_Acc)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Stmt);
+ begin
+ Create_Object (Syn_Inst, Info.Inst_Slot, 1);
+ pragma Assert (Syn_Inst.Objects (Info.Inst_Slot).Kind = Obj_None);
+ Syn_Inst.Objects (Info.Inst_Slot) := (Kind => Obj_Instance,
+ I_Inst => Sub_Inst);
+ end Create_Sub_Instance;
+
+ procedure Create_Component_Instance (Syn_Inst : Synth_Instance_Acc;
+ Sub_Inst : Synth_Instance_Acc)
+ is
+ Slot : constant Object_Slot_Type := Syn_Inst.Max_Objs;
+ begin
+ pragma Assert (Slot > 0);
+ pragma Assert (Syn_Inst.Objects (Slot).Kind = Obj_None);
+ Create_Object (Syn_Inst, Slot, 1);
+ Syn_Inst.Objects (Slot) := (Kind => Obj_Instance,
+ I_Inst => Sub_Inst);
+ end Create_Component_Instance;
+
+ procedure Create_Subtype_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc)
+ is
+ pragma Assert (Typ /= null);
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ begin
+ Create_Object (Syn_Inst, Info.Slot, 1);
+ pragma Assert (Syn_Inst.Objects (Info.Slot).Kind = Obj_None);
+ Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Subtype, T_Typ => Typ);
+ end Create_Subtype_Object;
+
+ procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Inst : Synth_Instance_Acc;
+ Is_Global : Boolean)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ begin
+ if Is_Global then
+ pragma Assert (Syn_Inst.Objects (Info.Pkg_Slot).Kind = Obj_None);
+ pragma Assert (Syn_Inst.Up_Block = null);
+ null;
+ else
+ pragma Assert (Syn_Inst.Up_Block /= null);
+ Create_Object (Syn_Inst, Info.Slot, 1);
+ end if;
+ Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance,
+ I_Inst => Inst);
+ end Create_Package_Object;
+
+ procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Inst : Synth_Instance_Acc)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ begin
+ pragma Assert (Syn_Inst.Up_Block /= null);
+ Create_Object (Syn_Inst, Info.Pkg_Slot, 1);
+ Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance,
+ I_Inst => Inst);
+ end Create_Package_Interface;
+
+ function Get_Package_Object
+ (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc)
+ return Synth_Instance_Acc
+ is
+ Parent : Synth_Instance_Acc;
+ begin
+ Parent := Get_Instance_By_Scope (Syn_Inst, Info.Pkg_Parent);
+ return Parent.Objects (Info.Pkg_Slot).I_Inst;
+ end Get_Package_Object;
+
+ function Get_Package_Object
+ (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc is
+ begin
+ return Get_Package_Object (Syn_Inst, Get_Info (Pkg));
+ end Get_Package_Object;
+
+ function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc;
+ Pkg : Node)
+ return Synth_Instance_Acc
+ is
+ Syn_Inst : Synth_Instance_Acc;
+ begin
+ Syn_Inst := Make_Elab_Instance (Parent_Inst, Pkg, Null_Node);
+ if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then
+ -- Global package.
+ Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, True);
+ else
+ -- Local package: check elaboration order.
+ Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, False);
+ end if;
+ return Syn_Inst;
+ end Create_Package_Instance;
+
+ function Get_Sub_Instance
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node) return Synth_Instance_Acc
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Stmt);
+ begin
+ return Syn_Inst.Objects (Info.Inst_Slot).I_Inst;
+ end Get_Sub_Instance;
+
+ function Get_Component_Instance
+ (Syn_Inst : Synth_Instance_Acc) return Synth_Instance_Acc
+ is
+ Slot : constant Object_Slot_Type := Syn_Inst.Max_Objs;
+ begin
+ return Syn_Inst.Objects (Slot).I_Inst;
+ end Get_Component_Instance;
+
+ procedure Set_Uninstantiated_Scope
+ (Syn_Inst : Synth_Instance_Acc; Bod : Node) is
+ begin
+ Syn_Inst.Uninst_Scope := Get_Info (Bod);
+ end Set_Uninstantiated_Scope;
+
+ procedure Destroy_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ Slot : constant Object_Slot_Type := Info.Slot;
+ begin
+ if Slot /= Syn_Inst.Elab_Objects
+ or else Info.Obj_Scope /= Syn_Inst.Block_Scope
+ then
+ Error_Msg_Elab ("synth: bad destroy order");
+ end if;
+ Syn_Inst.Objects (Slot) := (Kind => Obj_None);
+ Syn_Inst.Elab_Objects := Slot - 1;
+ end Destroy_Object;
+
+ function Get_Instance_By_Scope
+ (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc)
+ return Synth_Instance_Acc is
+ begin
+ case Scope.Kind is
+ when Kind_Block
+ | Kind_Frame
+ | Kind_Process =>
+ declare
+ Current : Synth_Instance_Acc;
+ begin
+ Current := Syn_Inst;
+ while Current /= null loop
+ if Current.Block_Scope = Scope then
+ return Current;
+ end if;
+ Current := Current.Up_Block;
+ end loop;
+ raise Internal_Error;
+ end;
+ when Kind_Package =>
+ if Scope.Pkg_Parent = null then
+ -- This is a scope for an uninstantiated package.
+ declare
+ Current : Synth_Instance_Acc;
+ begin
+ Current := Syn_Inst;
+ while Current /= null loop
+ if Current.Uninst_Scope = Scope then
+ return Current;
+ end if;
+ Current := Current.Up_Block;
+ end loop;
+ raise Internal_Error;
+ end;
+ else
+ -- Instantiated package.
+ return Get_Package_Object (Syn_Inst, Scope);
+ end if;
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Instance_By_Scope;
+
+ function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc
+ is
+ Parent : Node;
+ begin
+ Parent := Get_Parent (Blk);
+ if Get_Kind (Parent) = Iir_Kind_Architecture_Body then
+ Parent := Vhdl.Utils.Get_Entity (Parent);
+ end if;
+ return Get_Info (Parent);
+ end Get_Parent_Scope;
+
+ function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node)
+ return Valtyp
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Obj);
+ Obj_Inst : Synth_Instance_Acc;
+ begin
+ Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope);
+ return Obj_Inst.Objects (Info.Slot).Obj;
+ end Get_Value;
+
+ function Get_Subtype_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Decl);
+ Obj_Inst : Synth_Instance_Acc;
+ begin
+ Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope);
+ return Obj_Inst.Objects (Info.Slot).T_Typ;
+ end Get_Subtype_Object;
+end Elab.Vhdl_Context;
diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads
new file mode 100644
index 000000000..2fc483c7f
--- /dev/null
+++ b/src/synth/elab-vhdl_context.ads
@@ -0,0 +1,222 @@
+-- Synthesis context.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Vhdl.Annotations; use Vhdl.Annotations;
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
+package Elab.Vhdl_Context is
+ -- Values are stored into Synth_Instance, which is parallel to simulation
+ -- Block_Instance_Type.
+
+ type Synth_Instance_Type (<>) is limited private;
+ type Synth_Instance_Acc is access Synth_Instance_Type;
+
+ Root_Instance : Synth_Instance_Acc;
+
+ -- Unique per instance id. Used to create parallel tables.
+ type Instance_Id_Type is new Natural;
+ First_Instance_Id : constant Instance_Id_Type := 1;
+
+ function Get_Instance_Id (Inst : Synth_Instance_Acc)
+ return Instance_Id_Type;
+ pragma Inline (Get_Instance_Id);
+
+ function Get_Instance_By_Scope
+ (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc)
+ return Synth_Instance_Acc;
+
+ -- Create the root instance (which contains the packages).
+ -- Assign ROOT_INSTANCE.
+ procedure Make_Root_Instance;
+
+ -- Free the first instance.
+ procedure Free_Base_Instance;
+
+ -- Create and free the corresponding synth instance.
+ function Make_Elab_Instance
+ (Parent : Synth_Instance_Acc; Blk : Node; Config : Node)
+ return Synth_Instance_Acc;
+
+ procedure Free_Elab_Instance (Synth_Inst : in out Synth_Instance_Acc);
+
+ function Make_Elab_Generate_Instance
+ (Parent : Synth_Instance_Acc; Blk : Node; Config : Node; Len : Natural)
+ return Synth_Instance_Acc;
+
+ function Get_Generate_Sub_Instance
+ (Parent : Synth_Instance_Acc; Idx : Positive) return Synth_Instance_Acc;
+ procedure Set_Generate_Sub_Instance
+ (Parent : Synth_Instance_Acc; Idx : Positive; Child : Synth_Instance_Acc);
+
+ function Is_Error (Inst : Synth_Instance_Acc) return Boolean;
+ pragma Inline (Is_Error);
+
+ procedure Set_Error (Inst : Synth_Instance_Acc);
+
+ function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean;
+ procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean);
+
+ -- Get the corresponding source for the scope of the instance.
+ function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node;
+
+ procedure Set_Instance_Config (Inst : Synth_Instance_Acc; Config : Node);
+ function Get_Instance_Config (Inst : Synth_Instance_Acc) return Node;
+
+ -- Add/Get extra instances.
+ -- Those instances are verification units.
+ procedure Add_Extra_Instance (Inst : Synth_Instance_Acc;
+ Extra : Synth_Instance_Acc);
+ function Get_First_Extra_Instance (Inst : Synth_Instance_Acc)
+ return Synth_Instance_Acc;
+ function Get_Next_Extra_Instance (Inst : Synth_Instance_Acc)
+ return Synth_Instance_Acc;
+
+ procedure Create_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
+
+ procedure Create_Signal (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Typ : Type_Acc;
+ Init : Value_Acc);
+
+ -- Create a sub instance: either a direct entity instantiation, or
+ -- a component instantiation.
+ procedure Create_Sub_Instance (Syn_Inst : Synth_Instance_Acc;
+ Stmt : Node;
+ Sub_Inst : Synth_Instance_Acc);
+
+ -- Create a sub instance for a component.
+ procedure Create_Component_Instance (Syn_Inst : Synth_Instance_Acc;
+ Sub_Inst : Synth_Instance_Acc);
+
+ procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Inst : Synth_Instance_Acc;
+ Is_Global : Boolean);
+
+ function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc;
+ Pkg : Node)
+ return Synth_Instance_Acc;
+
+ procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Inst : Synth_Instance_Acc);
+
+ procedure Create_Subtype_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc);
+
+ -- Force the value of DECL, without checking for elaboration order.
+ -- It is for deferred constants.
+ procedure Create_Object_Force
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
+
+ procedure Replace_Signal
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
+ procedure Mutate_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
+
+ procedure Destroy_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node);
+
+ -- Get the value of OBJ.
+ function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node)
+ return Valtyp;
+
+ function Get_Package_Object
+ (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc;
+
+ -- Return the type for DECL (a subtype indication).
+ function Get_Subtype_Object
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc;
+
+ function Get_Sub_Instance
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node) return Synth_Instance_Acc;
+ function Get_Component_Instance
+ (Syn_Inst : Synth_Instance_Acc) return Synth_Instance_Acc;
+
+ -- Return the scope of the parent of BLK. Deals with architecture bodies.
+ function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc;
+
+ procedure Set_Uninstantiated_Scope
+ (Syn_Inst : Synth_Instance_Acc; Bod : Node);
+private
+ type Obj_Kind is
+ (
+ Obj_None,
+ Obj_Object,
+ Obj_Subtype,
+ Obj_Instance
+ );
+
+ type Obj_Type (Kind : Obj_Kind := Obj_None) is record
+ case Kind is
+ when Obj_None =>
+ null;
+ when Obj_Object =>
+ Obj : Valtyp;
+ when Obj_Subtype =>
+ T_Typ : Type_Acc;
+ when Obj_Instance =>
+ I_Inst : Synth_Instance_Acc;
+ end case;
+ end record;
+
+ type Objects_Array is array (Object_Slot_Type range <>) of Obj_Type;
+
+ type Synth_Instance_Type (Max_Objs : Object_Slot_Type) is limited record
+ Is_Const : Boolean;
+
+ -- True if a fatal error has been detected that aborts the synthesis
+ -- of this instance.
+ Is_Error : Boolean;
+
+ Id : Instance_Id_Type;
+
+ -- The corresponding info for this instance.
+ -- This is used for lookup.
+ Block_Scope : Sim_Info_Acc;
+
+ -- The corresponding info the the uninstantiated specification of
+ -- an instantiated package. When an object is looked for from the
+ -- uninstantiated body, the scope of the uninstantiated specification
+ -- is used. And it is different from Block_Scope.
+ -- This is used for lookup of uninstantiated specification.
+ Uninst_Scope : Sim_Info_Acc;
+
+ -- Instance of the parent scope.
+ Up_Block : Synth_Instance_Acc;
+
+ -- Source construct corresponding to this instance.
+ Source_Scope : Node;
+
+ -- Block configuration (unless the instance is for a package).
+ Config : Node;
+
+ -- Chain of verification units that applies to this one.
+ Extra_Units : Synth_Instance_Acc;
+ Extra_Link : Synth_Instance_Acc;
+
+ Elab_Objects : Object_Slot_Type;
+
+ -- Instance for synthesis.
+ Objects : Objects_Array (1 .. Max_Objs);
+ end record;
+end Elab.Vhdl_Context;
diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb
new file mode 100644
index 000000000..6c4091afd
--- /dev/null
+++ b/src/synth/elab-vhdl_decls.adb
@@ -0,0 +1,361 @@
+-- Create declarations for synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils; use Vhdl.Utils;
+
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Files;
+with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
+
+package body Elab.Vhdl_Decls is
+ procedure Elab_Subprogram_Declaration
+ (Syn_Inst : Synth_Instance_Acc; Subprg : Node)
+ is
+ Inter : Node;
+ begin
+ if Is_Second_Subprogram_Specification (Subprg) then
+ -- Already handled.
+ return;
+ end if;
+
+ Inter := Get_Interface_Declaration_Chain (Subprg);
+ while Inter /= Null_Node loop
+ Elab_Declaration_Type (Syn_Inst, Inter);
+ Inter := Get_Chain (Inter);
+ end loop;
+ end Elab_Subprogram_Declaration;
+
+ procedure Elab_Constant_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Last_Type : in out Node)
+ is
+ Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl);
+ First_Decl : Node;
+ Decl_Type : Node;
+ Val : Valtyp;
+ Obj_Type : Type_Acc;
+ begin
+ Elab_Declaration_Type (Syn_Inst, Decl);
+ if Deferred_Decl = Null_Node
+ or else Get_Deferred_Declaration_Flag (Decl)
+ then
+ -- Create the object (except for full declaration of a
+ -- deferred constant).
+ Create_Object (Syn_Inst, Decl, No_Valtyp);
+ end if;
+ -- Initialize the value (except for a deferred declaration).
+ if Get_Deferred_Declaration_Flag (Decl) then
+ return;
+ end if;
+ if Deferred_Decl = Null_Node then
+ -- A normal constant declaration
+ First_Decl := Decl;
+ else
+ -- The full declaration of a deferred constant.
+ First_Decl := Deferred_Decl;
+ end if;
+ pragma Assert (First_Decl /= Null_Node);
+
+ -- Use the type of the declaration. The type of the constant may
+ -- be derived from the value.
+ -- FIXME: what about multiple declarations ?
+ Decl_Type := Get_Subtype_Indication (Decl);
+ if Decl_Type = Null_Node then
+ Decl_Type := Last_Type;
+ else
+ if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then
+ -- Type mark.
+ Decl_Type := Get_Type (Get_Named_Entity (Decl_Type));
+ end if;
+ Last_Type := Decl_Type;
+ end if;
+ Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type);
+ Val := Exec_Expression_With_Type
+ (Syn_Inst, Get_Default_Value (Decl), Obj_Type);
+ if Val = No_Valtyp then
+ Set_Error (Syn_Inst);
+ return;
+ end if;
+ Val := Exec_Subtype_Conversion (Val, Obj_Type, True, Decl);
+ Create_Object_Force (Syn_Inst, First_Decl, Val);
+ end Elab_Constant_Declaration;
+
+ procedure Elab_Signal_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node)
+ is
+ Def : constant Iir := Get_Default_Value (Decl);
+ Init : Valtyp;
+ Obj_Typ : Type_Acc;
+ begin
+ Elab_Declaration_Type (Syn_Inst, Decl);
+ Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
+
+ if Is_Valid (Def) then
+ Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
+ Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl);
+ else
+ Init := No_Valtyp;
+ end if;
+ Create_Signal (Syn_Inst, Decl, Obj_Typ, Init.Val);
+ end Elab_Signal_Declaration;
+
+ procedure Elab_Variable_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node)
+ is
+ Def : constant Node := Get_Default_Value (Decl);
+ Decl_Type : constant Node := Get_Type (Decl);
+ Init : Valtyp;
+ Obj_Typ : Type_Acc;
+ begin
+ Elab_Declaration_Type (Syn_Inst, Decl);
+ if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then
+ Error_Msg_Elab (+Decl, "protected type not supported");
+ return;
+ end if;
+ Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type);
+
+ if Is_Valid (Def) then
+ Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
+ Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl);
+ else
+ Init := No_Valtyp;
+ end if;
+ Create_Object (Syn_Inst, Decl, Init);
+ end Elab_Variable_Declaration;
+
+ procedure Elab_File_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node)
+ is
+ F : File_Index;
+ Res : Valtyp;
+ Obj_Typ : Type_Acc;
+ begin
+ F := Elab.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl);
+ Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
+ Res := Create_Value_File (Obj_Typ, F);
+ Create_Object (Syn_Inst, Decl, Res);
+ end Elab_File_Declaration;
+
+ procedure Elab_Attribute_Specification
+ (Syn_Inst : Synth_Instance_Acc; Spec : Node)
+ is
+ Attr_Decl : constant Node :=
+ Get_Named_Entity (Get_Attribute_Designator (Spec));
+ Value : Node;
+ Val : Valtyp;
+ Val_Type : Type_Acc;
+ begin
+ Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Attr_Decl));
+ Value := Get_Attribute_Value_Spec_Chain (Spec);
+ while Value /= Null_Iir loop
+ -- 2. The expression is evaluated to determine the value
+ -- of the attribute.
+ -- It is an error if the value of the expression does not
+ -- belong to the subtype of the attribute; if the
+ -- attribute is of an array type, then an implicit
+ -- subtype conversion is first performed on the value,
+ -- unless the attribute's subtype indication denotes an
+ -- unconstrained array type.
+ Val := Exec_Expression_With_Type
+ (Syn_Inst, Get_Expression (Spec), Val_Type);
+ -- Check_Constraints (Instance, Val, Attr_Type, Decl);
+
+ -- 3. A new instance of the designated attribute is created
+ -- and associated with each of the affected items.
+ --
+ -- 4. Each new attribute instance is assigned the value of
+ -- the expression.
+ Create_Object (Syn_Inst, Value, Val);
+ -- Unshare (Val, Instance_Pool);
+
+ Value := Get_Spec_Chain (Value);
+ end loop;
+ end Elab_Attribute_Specification;
+
+ procedure Elab_Object_Alias_Declaration
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+ is
+ Atype : constant Node := Get_Declaration_Type (Decl);
+ Off : Value_Offsets;
+ Res : Valtyp;
+ Obj_Typ : Type_Acc;
+ Base : Valtyp;
+ Typ : Type_Acc;
+ begin
+ -- Subtype indication may not be present.
+ if Atype /= Null_Node then
+ Synth_Subtype_Indication (Syn_Inst, Atype);
+ Obj_Typ := Get_Subtype_Object (Syn_Inst, Atype);
+ else
+ Obj_Typ := null;
+ end if;
+
+ Exec_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off);
+ Res := Create_Value_Alias (Base, Off, Typ);
+ if Obj_Typ /= null then
+ Res := Exec_Subtype_Conversion (Res, Obj_Typ, True, Decl);
+ end if;
+ Create_Object (Syn_Inst, Decl, Res);
+ end Elab_Object_Alias_Declaration;
+
+ procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Last_Type : in out Node) is
+ begin
+ case Get_Kind (Decl) is
+ when Iir_Kind_Variable_Declaration =>
+ Elab_Variable_Declaration (Syn_Inst, Decl);
+ -- when Iir_Kind_Interface_Variable_Declaration =>
+ -- -- Ignore default value.
+ -- Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
+ -- Create_Var_Wire (Syn_Inst, Decl, No_Valtyp);
+ when Iir_Kind_Constant_Declaration =>
+ Elab_Constant_Declaration (Syn_Inst, Decl, Last_Type);
+ when Iir_Kind_Signal_Declaration =>
+ Elab_Signal_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Object_Alias_Declaration =>
+ Elab_Object_Alias_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Function_Declaration =>
+ Elab_Subprogram_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Procedure_Body
+ | Iir_Kind_Function_Body =>
+ null;
+ when Iir_Kind_Non_Object_Alias_Declaration =>
+ null;
+ when Iir_Kind_Attribute_Declaration =>
+ -- Nothing to do: the type is a type_mark, not a subtype
+ -- indication.
+ null;
+ when Iir_Kind_Attribute_Specification =>
+ Elab_Attribute_Specification (Syn_Inst, Decl);
+ when Iir_Kind_Type_Declaration =>
+ Elab_Type_Definition (Syn_Inst, Get_Type_Definition (Decl));
+ when Iir_Kind_Anonymous_Type_Declaration =>
+ Elab_Anonymous_Type_Definition
+ (Syn_Inst, Get_Type_Definition (Decl),
+ Get_Subtype_Definition (Decl));
+ when Iir_Kind_Subtype_Declaration =>
+ Elab_Declaration_Type (Syn_Inst, Decl);
+ when Iir_Kind_Component_Declaration =>
+ null;
+ when Iir_Kind_File_Declaration =>
+ Elab_File_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Protected_Type_Body =>
+ null;
+ when Iir_Kind_Psl_Default_Clock =>
+ -- Ignored; directly used by PSL directives.
+ null;
+ when Iir_Kind_Use_Clause =>
+ null;
+ when Iir_Kind_Configuration_Specification =>
+ null;
+ when Iir_Kind_Signal_Attribute_Declaration =>
+ -- Not supported by synthesis.
+ null;
+ when others =>
+ Vhdl.Errors.Error_Kind ("elab_declaration", Decl);
+ end case;
+ end Elab_Declaration;
+
+ procedure Elab_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Iir)
+ is
+ Decl : Node;
+ Last_Type : Node;
+ begin
+ Last_Type := Null_Node;
+ Decl := Decls;
+ while Is_Valid (Decl) loop
+ Elab_Declaration (Syn_Inst, Decl, Last_Type);
+
+ exit when Is_Error (Syn_Inst);
+
+ Decl := Get_Chain (Decl);
+ end loop;
+ end Elab_Declarations;
+
+ procedure Finalize_Declaration
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean)
+ is
+ pragma Unreferenced (Syn_Inst);
+ begin
+ case Get_Kind (Decl) is
+ when Iir_Kind_Variable_Declaration
+ | Iir_Kind_Interface_Variable_Declaration =>
+ null;
+ when Iir_Kind_Constant_Declaration =>
+ null;
+ when Iir_Kind_Signal_Declaration
+ | Iir_Kind_Interface_Signal_Declaration =>
+ pragma Assert (not Is_Subprg);
+ null;
+ when Iir_Kind_Object_Alias_Declaration =>
+ null;
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Function_Declaration =>
+ null;
+ when Iir_Kind_Procedure_Body
+ | Iir_Kind_Function_Body =>
+ null;
+ when Iir_Kind_Non_Object_Alias_Declaration =>
+ null;
+ when Iir_Kind_Attribute_Declaration =>
+ null;
+ when Iir_Kind_Attribute_Specification =>
+ null;
+ when Iir_Kind_Type_Declaration =>
+ null;
+ when Iir_Kind_Anonymous_Type_Declaration =>
+ null;
+ when Iir_Kind_Subtype_Declaration =>
+ null;
+ when Iir_Kind_Component_Declaration =>
+ null;
+ when Iir_Kind_File_Declaration =>
+ null;
+ when Iir_Kind_Configuration_Specification =>
+ null;
+ when Iir_Kind_Psl_Default_Clock =>
+ -- Ignored; directly used by PSL directives.
+ null;
+ when Iir_Kind_Signal_Attribute_Declaration =>
+ -- Not supported by synthesis.
+ null;
+ when others =>
+ Vhdl.Errors.Error_Kind ("finalize_declaration", Decl);
+ end case;
+ end Finalize_Declaration;
+
+ procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
+ Decls : Iir;
+ Is_Subprg : Boolean := False)
+ is
+ Decl : Iir;
+ begin
+ Decl := Decls;
+ while Is_Valid (Decl) loop
+ Finalize_Declaration (Syn_Inst, Decl, Is_Subprg);
+
+ Decl := Get_Chain (Decl);
+ end loop;
+ end Finalize_Declarations;
+end Elab.Vhdl_Decls;
diff --git a/src/synth/elab-vhdl_decls.ads b/src/synth/elab-vhdl_decls.ads
new file mode 100644
index 000000000..5937e1f58
--- /dev/null
+++ b/src/synth/elab-vhdl_decls.ads
@@ -0,0 +1,40 @@
+-- Create declarations for synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
+package Elab.Vhdl_Decls is
+ procedure Elab_Subprogram_Declaration
+ (Syn_Inst : Synth_Instance_Acc; Subprg : Node);
+
+ procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Last_Type : in out Node);
+
+ procedure Elab_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Iir);
+
+ procedure Finalize_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Iir;
+ Is_Subprg : Boolean);
+ procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
+ Decls : Iir;
+ Is_Subprg : Boolean := False);
+
+end Elab.Vhdl_Decls;
diff --git a/src/synth/elab-vhdl_errors.adb b/src/synth/elab-vhdl_errors.adb
new file mode 100644
index 000000000..827f73a17
--- /dev/null
+++ b/src/synth/elab-vhdl_errors.adb
@@ -0,0 +1,58 @@
+-- Error handling for synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+package body Elab.Vhdl_Errors is
+ procedure Error_Msg_Elab (Loc : Location_Type;
+ Msg : String;
+ Arg1 : Earg_Type) is
+ begin
+ Report_Msg (Msgid_Error, Errorout.Elaboration,
+ +Loc, Msg, (1 => Arg1));
+ end Error_Msg_Elab;
+
+ procedure Error_Msg_Elab (Loc : Location_Type;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs) is
+ begin
+ Report_Msg (Msgid_Error, Errorout.Elaboration,
+ +Loc, Msg, Args);
+ end Error_Msg_Elab;
+
+ -- procedure Warning_Msg_Synth (Loc : Location_Type;
+ -- Msg : String;
+ -- Arg1 : Earg_Type) is
+ -- begin
+ -- Report_Msg (Msgid_Warning, Errorout.Elaboration,
+ -- +Loc, Msg, (1 => Arg1));
+ -- end Warning_Msg_Synth;
+
+ -- procedure Warning_Msg_Synth (Loc : Location_Type;
+ -- Msg : String;
+ -- Args : Earg_Arr := No_Eargs) is
+ -- begin
+ -- Report_Msg (Msgid_Warning, Errorout.Elaboration, +Loc, Msg, Args);
+ -- end Warning_Msg_Synth;
+
+ -- procedure Info_Msg_Synth (Loc : Location_Type;
+ -- Msg : String;
+ -- Args : Earg_Arr := No_Eargs) is
+ -- begin
+ -- Report_Msg (Msgid_Note, Errorout.Elaboration, +Loc, Msg, Args);
+ -- end Info_Msg_Synth;
+
+end Elab.Vhdl_Errors;
diff --git a/src/synth/elab-vhdl_errors.ads b/src/synth/elab-vhdl_errors.ads
new file mode 100644
index 000000000..d4cd19a24
--- /dev/null
+++ b/src/synth/elab-vhdl_errors.ads
@@ -0,0 +1,38 @@
+-- Error handling for synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+with Errorout; use Errorout;
+
+package Elab.Vhdl_Errors is
+ procedure Error_Msg_Elab (Loc : Location_Type;
+ Msg : String;
+ Arg1 : Earg_Type);
+ procedure Error_Msg_Elab (Loc : Location_Type;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs);
+ -- procedure Warning_Msg_Synth (Loc : Location_Type;
+ -- Msg : String;
+ -- Arg1 : Earg_Type);
+ -- procedure Warning_Msg_Synth (Loc : Location_Type;
+ -- Msg : String;
+ -- Args : Earg_Arr := No_Eargs);
+ -- procedure Info_Msg_Synth (Loc : Location_Type;
+ -- Msg : String;
+ -- Args : Earg_Arr := No_Eargs);
+end Elab.Vhdl_Errors;
diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb
new file mode 100644
index 000000000..35a92c39d
--- /dev/null
+++ b/src/synth/elab-vhdl_expr.adb
@@ -0,0 +1,1402 @@
+-- Expressions synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Name_Table;
+with Std_Names;
+with Str_Table;
+with Errorout; use Errorout;
+
+with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Evaluation; use Vhdl.Evaluation;
+with Vhdl.Annotations; use Vhdl.Annotations;
+
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Heap; use Elab.Vhdl_Heap;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;
+with Elab.Debugger;
+
+with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
+with Synth.Vhdl_Oper; use Synth.Vhdl_Oper;
+with Synth.Vhdl_Aggr;
+
+with Grt.Types;
+with Grt.To_Strings;
+
+package body Elab.Vhdl_Expr is
+ function Get_Value_Memtyp (V : Valtyp) return Memtyp is
+ begin
+ case V.Val.Kind is
+ when Value_Memory =>
+ return (V.Typ, V.Val.Mem);
+ when Value_Const =>
+ return Get_Memtyp (V);
+ when Value_Alias =>
+ declare
+ Res : Memtyp;
+ begin
+ Res := Get_Value_Memtyp ((V.Val.A_Typ, V.Val.A_Obj));
+ return (V.Typ, Res.Mem + V.Val.A_Off.Mem_Off);
+ end;
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Value_Memtyp;
+
+ function Get_Static_Discrete (V : Valtyp) return Int64 is
+ begin
+ case V.Val.Kind is
+ when Value_Memory =>
+ return Read_Discrete (V);
+ when Value_Const =>
+ return Read_Discrete (Get_Memtyp (V));
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Static_Discrete;
+
+ function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc;
+ Atype : Node;
+ Dim : Dim_Type) return Bound_Type
+ is
+ Info : constant Sim_Info_Acc := Get_Info (Atype);
+ begin
+ if Info = null then
+ pragma Assert (Get_Type_Declarator (Atype) = Null_Node);
+ declare
+ Index_Type : constant Node :=
+ Get_Index_Type (Atype, Natural (Dim - 1));
+ begin
+ return Synth_Bounds_From_Range (Syn_Inst, Index_Type);
+ end;
+ else
+ declare
+ Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype);
+ begin
+ case Bnds.Kind is
+ when Type_Vector =>
+ pragma Assert (Dim = 1);
+ return Bnds.Vbound;
+ when Type_Array =>
+ return Bnds.Abounds.D (Dim);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end;
+ end if;
+ end Synth_Array_Bounds;
+
+ function Synth_Bounds_From_Length (Atype : Node; Len : Int32)
+ return Bound_Type
+ is
+ Rng : constant Node := Get_Range_Constraint (Atype);
+ Limit : Int32;
+ begin
+ Limit := Int32 (Eval_Pos (Get_Left_Limit (Rng)));
+ case Get_Direction (Rng) is
+ when Dir_To =>
+ return (Dir => Dir_To,
+ Left => Limit,
+ Right => Limit + Len - 1,
+ Len => Uns32 (Len));
+ when Dir_Downto =>
+ return (Dir => Dir_Downto,
+ Left => Limit,
+ Right => Limit - Len + 1,
+ Len => Uns32 (Len));
+ end case;
+ end Synth_Bounds_From_Length;
+
+ function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc;
+ Aggr : Node) return Valtyp
+ is
+ Aggr_Type : constant Node := Get_Type (Aggr);
+ pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1);
+ El_Type : constant Node := Get_Element_Subtype (Aggr_Type);
+ El_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, El_Type);
+ Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr);
+ Last : constant Natural := Flist_Last (Els);
+ Bnd : Bound_Type;
+ Bnds : Bound_Array_Acc;
+ Res_Type : Type_Acc;
+ Val : Valtyp;
+ Res : Valtyp;
+ begin
+ -- Allocate the result.
+ Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1);
+ pragma Assert (Bnd.Len = Uns32 (Last + 1));
+
+ if El_Typ.Kind in Type_Nets then
+ Res_Type := Create_Vector_Type (Bnd, El_Typ);
+ else
+ Bnds := Create_Bound_Array (1);
+ Bnds.D (1) := Bnd;
+ Res_Type := Create_Array_Type (Bnds, El_Typ);
+ end if;
+
+ Res := Create_Value_Memory (Res_Type);
+
+ for I in Flist_First .. Last loop
+ -- Elements are supposed to be static, so no need for enable.
+ Val := Exec_Expression_With_Type
+ (Syn_Inst, Get_Nth_Element (Els, I), El_Typ);
+ pragma Assert (Is_Static (Val.Val));
+ Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val);
+ end loop;
+
+ return Res;
+ end Synth_Simple_Aggregate;
+
+ -- Change the bounds of VAL.
+ function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is
+ begin
+ case Val.Val.Kind is
+ when Value_Alias =>
+ return Create_Value_Alias
+ ((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype);
+ when Value_Const =>
+ return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype);
+ when Value_Memory =>
+ return (Ntype, Val.Val);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Reshape_Value;
+
+ function Exec_Subtype_Conversion (Vt : Valtyp;
+ Dtype : Type_Acc;
+ Bounds : Boolean;
+ Loc : Node)
+ return Valtyp
+ is
+ Vtype : constant Type_Acc := Vt.Typ;
+ begin
+ if Vt = No_Valtyp then
+ -- Propagate error.
+ return No_Valtyp;
+ end if;
+ if Dtype = Vtype then
+ return Vt;
+ end if;
+
+ case Dtype.Kind is
+ when Type_Bit =>
+ pragma Assert (Vtype.Kind = Type_Bit);
+ return Vt;
+ when Type_Logic =>
+ pragma Assert (Vtype.Kind = Type_Logic);
+ return Vt;
+ when Type_Discrete =>
+ pragma Assert (Vtype.Kind in Type_All_Discrete);
+ case Vt.Val.Kind is
+ when Value_Net
+ | Value_Wire
+ | Value_Alias =>
+ raise Internal_Error;
+ when Value_Const =>
+ return Exec_Subtype_Conversion
+ ((Vt.Typ, Vt.Val.C_Val), Dtype, Bounds, Loc);
+ when Value_Memory =>
+ -- Check for overflow.
+ declare
+ Val : constant Int64 := Read_Discrete (Vt);
+ begin
+ if not In_Range (Dtype.Drange, Val) then
+ Error_Msg_Elab (+Loc, "value out of range");
+ return No_Valtyp;
+ end if;
+ return Create_Value_Discrete (Val, Dtype);
+ end;
+ when others =>
+ raise Internal_Error;
+ end case;
+ when Type_Float =>
+ pragma Assert (Vtype.Kind = Type_Float);
+ -- TODO: check range
+ return Vt;
+ when Type_Vector =>
+ pragma Assert (Vtype.Kind = Type_Vector
+ or Vtype.Kind = Type_Slice);
+ if Dtype.W /= Vtype.W then
+ Error_Msg_Elab
+ (+Loc, "mismatching vector length; got %v, expect %v",
+ (+Vtype.W, +Dtype.W));
+ return No_Valtyp;
+ end if;
+ if Bounds then
+ return Reshape_Value (Vt, Dtype);
+ else
+ return Vt;
+ end if;
+ when Type_Slice =>
+ -- TODO: check width
+ return Vt;
+ when Type_Array =>
+ pragma Assert (Vtype.Kind = Type_Array);
+ -- Check bounds.
+ for I in Vtype.Abounds.D'Range loop
+ if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then
+ Error_Msg_Elab (+Loc, "mismatching array bounds");
+ return No_Valtyp;
+ end if;
+ end loop;
+ -- TODO: check element.
+ if Bounds then
+ return Reshape_Value (Vt, Dtype);
+ else
+ return Vt;
+ end if;
+ when Type_Unbounded_Array =>
+ pragma Assert (Vtype.Kind = Type_Array);
+ return Vt;
+ when Type_Unbounded_Vector =>
+ pragma Assert (Vtype.Kind = Type_Vector
+ or else Vtype.Kind = Type_Slice);
+ return Vt;
+ when Type_Record =>
+ pragma Assert (Vtype.Kind = Type_Record);
+ -- TODO: handle elements.
+ return Vt;
+ when Type_Unbounded_Record =>
+ pragma Assert (Vtype.Kind = Type_Record);
+ return Vt;
+ when Type_Access =>
+ return Vt;
+ when Type_File
+ | Type_Protected =>
+ -- No conversion expected.
+ -- As the subtype is identical, it is already handled by the
+ -- above check.
+ raise Internal_Error;
+ end case;
+ end Exec_Subtype_Conversion;
+
+ function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
+ return Valtyp
+ is
+ Param : constant Node := Get_Parameter (Attr);
+ Etype : constant Node := Get_Type (Attr);
+ Btype : constant Node := Get_Base_Type (Etype);
+ V : Valtyp;
+ Dtype : Type_Acc;
+ begin
+ -- The value is supposed to be static.
+ V := Exec_Expression (Syn_Inst, Param);
+ if V = No_Valtyp then
+ return No_Valtyp;
+ end if;
+
+ Dtype := Get_Subtype_Object (Syn_Inst, Etype);
+ if not Is_Static (V.Val) then
+ Error_Msg_Elab (+Attr, "parameter of 'value must be static");
+ return No_Valtyp;
+ end if;
+
+ declare
+ Str : constant String := Value_To_String (V);
+ Res_N : Node;
+ Val : Int64;
+ begin
+ case Get_Kind (Btype) is
+ when Iir_Kind_Enumeration_Type_Definition =>
+ Res_N := Eval_Value_Attribute (Str, Etype, Attr);
+ Val := Int64 (Get_Enum_Pos (Res_N));
+ Free_Iir (Res_N);
+ when Iir_Kind_Integer_Type_Definition =>
+ Val := Int64'Value (Str);
+ when others =>
+ Error_Msg_Elab (+Attr, "unhandled type for 'value");
+ return No_Valtyp;
+ end case;
+ return Create_Value_Discrete (Val, Dtype);
+ end;
+ end Synth_Value_Attribute;
+
+ function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir)
+ return String
+ is
+ use Grt.Types;
+ begin
+ case Get_Kind (Expr_Type) is
+ when Iir_Kind_Floating_Type_Definition
+ | Iir_Kind_Floating_Subtype_Definition =>
+ declare
+ Str : String (1 .. 24);
+ Last : Natural;
+ begin
+ Grt.To_Strings.To_String
+ (Str, Last, Ghdl_F64 (Read_Fp64 (Val)));
+ return Str (Str'First .. Last);
+ end;
+ when Iir_Kind_Integer_Type_Definition
+ | Iir_Kind_Integer_Subtype_Definition =>
+ declare
+ Str : String (1 .. 21);
+ First : Natural;
+ begin
+ Grt.To_Strings.To_String
+ (Str, First, Ghdl_I64 (Read_Discrete (Val)));
+ return Str (First .. Str'Last);
+ end;
+ when Iir_Kind_Enumeration_Type_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition =>
+ declare
+ Lits : constant Iir_Flist :=
+ Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type));
+ begin
+ return Name_Table.Image
+ (Get_Identifier
+ (Get_Nth_Element (Lits, Natural (Read_Discrete (Val)))));
+ end;
+ when Iir_Kind_Physical_Type_Definition
+ | Iir_Kind_Physical_Subtype_Definition =>
+ declare
+ Str : String (1 .. 21);
+ First : Natural;
+ Id : constant Name_Id :=
+ Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type)));
+ begin
+ Grt.To_Strings.To_String
+ (Str, First, Ghdl_I64 (Read_Discrete (Val)));
+ return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id);
+ end;
+ when others =>
+ Error_Kind ("execute_image_attribute", Expr_Type);
+ end case;
+ end Synth_Image_Attribute_Str;
+
+ function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp
+ is
+ Len : constant Natural := Str'Length;
+ Bnd : Bound_Array_Acc;
+ Typ : Type_Acc;
+ Res : Valtyp;
+ begin
+ Bnd := Create_Bound_Array (1);
+ Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len),
+ Len => Uns32 (Len));
+ Typ := Create_Array_Type (Bnd, Styp.Uarr_El);
+
+ Res := Create_Value_Memory (Typ);
+ for I in Str'Range loop
+ Write_U8 (Res.Val.Mem + Size_Type (I - Str'First),
+ Character'Pos (Str (I)));
+ end loop;
+ return Res;
+ end String_To_Valtyp;
+
+ function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
+ return Valtyp
+ is
+ Param : constant Node := Get_Parameter (Attr);
+ Etype : constant Node := Get_Type (Attr);
+ V : Valtyp;
+ Dtype : Type_Acc;
+ begin
+ -- The parameter is expected to be static.
+ V := Exec_Expression (Syn_Inst, Param);
+ if V = No_Valtyp then
+ return No_Valtyp;
+ end if;
+ Dtype := Get_Subtype_Object (Syn_Inst, Etype);
+ if not Is_Static (V.Val) then
+ Error_Msg_Elab (+Attr, "parameter of 'image must be static");
+ return No_Valtyp;
+ end if;
+
+ Strip_Const (V);
+ return String_To_Valtyp
+ (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype);
+ end Synth_Image_Attribute;
+
+ function Synth_Instance_Name_Attribute
+ (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp
+ is
+ Atype : constant Node := Get_Type (Attr);
+ Atyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype);
+ Name : constant Path_Instance_Name_Type :=
+ Get_Path_Instance_Name_Suffix (Attr);
+ begin
+ -- Return a truncated name, as the prefix is not completly known.
+ return String_To_Valtyp (Name.Suffix, Atyp);
+ end Synth_Instance_Name_Attribute;
+
+ -- Convert index IDX in PFX to an offset.
+ -- SYN_INST and LOC are used in case of error.
+ function Index_To_Offset
+ (Syn_Inst : Synth_Instance_Acc; Bnd : Bound_Type; Idx : Int64; Loc : Node)
+ return Value_Offsets
+ is
+ Res : Value_Offsets;
+ begin
+ if not In_Bounds (Bnd, Int32 (Idx)) then
+ Error_Msg_Elab (+Loc, "index not within bounds");
+ Elab.Debugger.Debug_Error (Syn_Inst, Loc);
+ return (0, 0);
+ end if;
+
+ -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one.
+ case Bnd.Dir is
+ when Dir_To =>
+ Res.Net_Off := Uns32 (Bnd.Right - Int32 (Idx));
+ Res.Mem_Off := Size_Type (Int32 (Idx) - Bnd.Left);
+ when Dir_Downto =>
+ Res.Net_Off := Uns32 (Int32 (Idx) - Bnd.Right);
+ Res.Mem_Off := Size_Type (Bnd.Left - Int32 (Idx));
+ end case;
+
+ return Res;
+ end Index_To_Offset;
+
+ -- Return the bounds of a one dimensional array/vector type and the
+ -- width of the element.
+ procedure Get_Onedimensional_Array_Bounds
+ (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc) is
+ begin
+ case Typ.Kind is
+ when Type_Vector =>
+ El_Typ := Typ.Vec_El;
+ Bnd := Typ.Vbound;
+ when Type_Array =>
+ El_Typ := Typ.Arr_El;
+ Bnd := Typ.Abounds.D (1);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Onedimensional_Array_Bounds;
+
+ function Create_Onedimensional_Array_Subtype
+ (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc
+ is
+ Res : Type_Acc;
+ Bnds : Bound_Array_Acc;
+ begin
+ case Btyp.Kind is
+ when Type_Vector =>
+ Res := Create_Vector_Type (Bnd, Btyp.Vec_El);
+ when Type_Unbounded_Vector =>
+ Res := Create_Vector_Type (Bnd, Btyp.Uvec_El);
+ when Type_Array =>
+ pragma Assert (Btyp.Abounds.Ndim = 1);
+ Bnds := Create_Bound_Array (1);
+ Bnds.D (1) := Bnd;
+ Res := Create_Array_Type (Bnds, Btyp.Arr_El);
+ when Type_Unbounded_Array =>
+ pragma Assert (Btyp.Uarr_Ndim = 1);
+ Bnds := Create_Bound_Array (1);
+ Bnds.D (1) := Bnd;
+ Res := Create_Array_Type (Bnds, Btyp.Uarr_El);
+ when others =>
+ raise Internal_Error;
+ end case;
+ return Res;
+ end Create_Onedimensional_Array_Subtype;
+
+ procedure Exec_Indexed_Name (Syn_Inst : Synth_Instance_Acc;
+ Name : Node;
+ Pfx_Type : Type_Acc;
+ Off : out Value_Offsets)
+ is
+ Indexes : constant Iir_Flist := Get_Index_List (Name);
+ El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type);
+ Idx_Expr : Node;
+ Idx_Val : Valtyp;
+ Bnd : Bound_Type;
+ Stride : Uns32;
+ Idx_Off : Value_Offsets;
+ begin
+ Off := (0, 0);
+
+ Stride := 1;
+ for I in reverse Flist_First .. Flist_Last (Indexes) loop
+ Idx_Expr := Get_Nth_Element (Indexes, I);
+
+ -- Use the base type as the subtype of the index is not synth-ed.
+ Idx_Val := Exec_Expression_With_Basetype (Syn_Inst, Idx_Expr);
+ if Idx_Val = No_Valtyp then
+ -- Propagate errorc
+ Off := (0, 0);
+ return;
+ end if;
+
+ Strip_Const (Idx_Val);
+
+ Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1));
+
+ pragma Assert (Is_Static (Idx_Val.Val));
+
+ Idx_Off := Index_To_Offset (Syn_Inst, Bnd,
+ Get_Static_Discrete (Idx_Val), Name);
+ Off.Net_Off := Off.Net_Off + Idx_Off.Net_Off * Stride * El_Typ.W;
+ Off.Mem_Off := Off.Mem_Off
+ + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz;
+
+ Stride := Stride * Bnd.Len;
+ end loop;
+ end Exec_Indexed_Name;
+
+ procedure Exec_Slice_Const_Suffix (Syn_Inst: Synth_Instance_Acc;
+ Expr : Node;
+ Name : Node;
+ Pfx_Bnd : Bound_Type;
+ L, R : Int64;
+ Dir : Direction_Type;
+ El_Typ : Type_Acc;
+ Res_Bnd : out Bound_Type;
+ Off : out Value_Offsets)
+ is
+ Is_Null : Boolean;
+ Len : Uns32;
+ begin
+ if Pfx_Bnd.Dir /= Dir then
+ Error_Msg_Elab (+Name, "direction mismatch in slice");
+ Off := (0, 0);
+ if Dir = Dir_To then
+ Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0);
+ else
+ Res_Bnd := (Dir => Dir_Downto, Left => 0, Right => 1, Len => 0);
+ end if;
+ return;
+ end if;
+
+ -- Might be a null slice.
+ case Pfx_Bnd.Dir is
+ when Dir_To =>
+ Is_Null := L > R;
+ when Dir_Downto =>
+ Is_Null := L < R;
+ end case;
+ if Is_Null then
+ Len := 0;
+ Off := (0, 0);
+ else
+ if not In_Bounds (Pfx_Bnd, Int32 (L))
+ or else not In_Bounds (Pfx_Bnd, Int32 (R))
+ then
+ Error_Msg_Elab (+Name, "index not within bounds");
+ Elab.Debugger.Debug_Error (Syn_Inst, Expr);
+ Off := (0, 0);
+ return;
+ end if;
+
+ case Pfx_Bnd.Dir is
+ when Dir_To =>
+ Len := Uns32 (R - L + 1);
+ Off.Net_Off := Uns32 (Pfx_Bnd.Right - Int32 (R)) * El_Typ.W;
+ Off.Mem_Off := Size_Type (Int32 (L) - Pfx_Bnd.Left) * El_Typ.Sz;
+ when Dir_Downto =>
+ Len := Uns32 (L - R + 1);
+ Off.Net_Off := Uns32 (Int32 (R) - Pfx_Bnd.Right) * El_Typ.W;
+ Off.Mem_Off := Size_Type (Pfx_Bnd.Left - Int32 (L)) * El_Typ.Sz;
+ end case;
+ end if;
+ Res_Bnd := (Dir => Pfx_Bnd.Dir,
+ Len => Len,
+ Left => Int32 (L),
+ Right => Int32 (R));
+ end Exec_Slice_Const_Suffix;
+
+ procedure Exec_Slice_Suffix (Syn_Inst : Synth_Instance_Acc;
+ Name : Node;
+ Pfx_Bnd : Bound_Type;
+ El_Typ : Type_Acc;
+ Res_Bnd : out Bound_Type;
+ Off : out Value_Offsets)
+ is
+ Expr : constant Node := Get_Suffix (Name);
+ Left, Right : Valtyp;
+ Dir : Direction_Type;
+ begin
+ Off := (0, 0);
+
+ case Get_Kind (Expr) is
+ when Iir_Kind_Range_Expression =>
+ -- As the range may be dynamic, cannot use synth_discrete_range.
+ Left := Exec_Expression_With_Basetype
+ (Syn_Inst, Get_Left_Limit (Expr));
+ Right := Exec_Expression_With_Basetype
+ (Syn_Inst, Get_Right_Limit (Expr));
+ Dir := Get_Direction (Expr);
+
+ when Iir_Kind_Range_Array_Attribute
+ | Iir_Kind_Reverse_Range_Array_Attribute
+ | Iir_Kinds_Denoting_Name =>
+ declare
+ Rng : Discrete_Range_Type;
+ begin
+ Synth_Discrete_Range (Syn_Inst, Expr, Rng);
+ Exec_Slice_Const_Suffix (Syn_Inst, Expr,
+ Name, Pfx_Bnd,
+ Rng.Left, Rng.Right, Rng.Dir,
+ El_Typ, Res_Bnd, Off);
+ return;
+ end;
+ when others =>
+ Error_Msg_Elab
+ (+Expr, "only range expression supported for slices");
+ Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0);
+ return;
+ end case;
+
+ pragma Assert (Is_Static (Left.Val));
+ pragma Assert (Is_Static (Right.Val));
+ Exec_Slice_Const_Suffix (Syn_Inst, Expr,
+ Name, Pfx_Bnd,
+ Get_Static_Discrete (Left),
+ Get_Static_Discrete (Right),
+ Dir,
+ El_Typ, Res_Bnd, Off);
+ end Exec_Slice_Suffix;
+
+ function Exec_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
+ return Valtyp is
+ begin
+ case Get_Kind (Name) is
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Selected_Name =>
+ return Exec_Name (Syn_Inst, Get_Named_Entity (Name));
+ when Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Variable_Declaration
+ | Iir_Kind_Interface_Variable_Declaration
+ | Iir_Kind_Signal_Declaration
+ | Iir_Kind_Interface_Constant_Declaration
+ | Iir_Kind_Constant_Declaration
+ | Iir_Kind_Iterator_Declaration
+ | Iir_Kind_Object_Alias_Declaration
+ | Iir_Kind_File_Declaration
+ | Iir_Kind_Interface_File_Declaration =>
+ return Get_Value (Syn_Inst, Name);
+ when Iir_Kind_Enumeration_Literal =>
+ declare
+ Typ : constant Type_Acc :=
+ Get_Subtype_Object (Syn_Inst, Get_Type (Name));
+ Res : Valtyp;
+ begin
+ Res := Create_Value_Memory (Typ);
+ Write_Discrete (Res, Int64 (Get_Enum_Pos (Name)));
+ return Res;
+ end;
+ when Iir_Kind_Unit_Declaration =>
+ declare
+ Typ : constant Type_Acc :=
+ Get_Subtype_Object (Syn_Inst, Get_Type (Name));
+ begin
+ return Create_Value_Discrete
+ (Vhdl.Evaluation.Get_Physical_Value (Name), Typ);
+ end;
+ when Iir_Kind_Implicit_Dereference
+ | Iir_Kind_Dereference =>
+ declare
+ Val : Valtyp;
+ begin
+ Val := Exec_Expression (Syn_Inst, Get_Prefix (Name));
+ return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));
+ end;
+ when others =>
+ Error_Kind ("synth_name", Name);
+ end case;
+ end Exec_Name;
+
+ procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
+ Pfx : Node;
+ Dest_Base : out Valtyp;
+ Dest_Typ : out Type_Acc;
+ Dest_Off : out Value_Offsets) is
+ begin
+ case Get_Kind (Pfx) is
+ when Iir_Kind_Simple_Name =>
+ Exec_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx),
+ Dest_Base, Dest_Typ, Dest_Off);
+ when Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Variable_Declaration
+ | Iir_Kind_Interface_Variable_Declaration
+ | Iir_Kind_Signal_Declaration
+ | Iir_Kind_Interface_Constant_Declaration
+ | Iir_Kind_Constant_Declaration
+ | Iir_Kind_File_Declaration
+ | Iir_Kind_Interface_File_Declaration
+ | Iir_Kind_Object_Alias_Declaration =>
+ declare
+ Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx);
+ begin
+ Dest_Typ := Targ.Typ;
+
+ if Targ.Val.Kind = Value_Alias then
+ -- Replace alias by the aliased name.
+ Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj);
+ Dest_Off := Targ.Val.A_Off;
+ else
+ Dest_Base := Targ;
+ Dest_Off := (0, 0);
+ end if;
+ end;
+
+ when Iir_Kind_Indexed_Name =>
+ declare
+ Off : Value_Offsets;
+ begin
+ Exec_Assignment_Prefix
+ (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off);
+ Strip_Const (Dest_Base);
+ Exec_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Off);
+
+ Dest_Off := Dest_Off + Off;
+ Dest_Typ := Get_Array_Element (Dest_Typ);
+ end;
+
+ when Iir_Kind_Selected_Element =>
+ declare
+ Idx : constant Iir_Index32 :=
+ Get_Element_Position (Get_Named_Entity (Pfx));
+ begin
+ Exec_Assignment_Prefix
+ (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off);
+ Dest_Off.Net_Off :=
+ Dest_Off.Net_Off + Dest_Typ.Rec.E (Idx + 1).Boff;
+ Dest_Off.Mem_Off :=
+ Dest_Off.Mem_Off + Dest_Typ.Rec.E (Idx + 1).Moff;
+
+ Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ;
+ end;
+
+ when Iir_Kind_Slice_Name =>
+ declare
+ Pfx_Bnd : Bound_Type;
+ El_Typ : Type_Acc;
+ Res_Bnd : Bound_Type;
+ Sl_Off : Value_Offsets;
+ begin
+ Exec_Assignment_Prefix
+ (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off);
+ Strip_Const (Dest_Base);
+
+ Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ);
+ Exec_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ,
+ Res_Bnd, Sl_Off);
+
+ -- Fixed slice.
+ Dest_Typ := Create_Onedimensional_Array_Subtype
+ (Dest_Typ, Res_Bnd);
+ Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off;
+ Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off;
+ end;
+
+ when others =>
+ Error_Kind ("exec_assignment_prefix", Pfx);
+ end case;
+ end Exec_Assignment_Prefix;
+
+ -- Return the type of EXPR without evaluating it.
+ function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
+ return Type_Acc is
+ begin
+ case Get_Kind (Expr) is
+ when Iir_Kinds_Object_Declaration =>
+ declare
+ Val : constant Valtyp := Get_Value (Syn_Inst, Expr);
+ begin
+ return Val.Typ;
+ end;
+ when Iir_Kind_Simple_Name =>
+ return Exec_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr));
+ when Iir_Kind_Slice_Name =>
+ declare
+ Pfx_Typ : Type_Acc;
+ Pfx_Bnd : Bound_Type;
+ El_Typ : Type_Acc;
+ Res_Bnd : Bound_Type;
+ Sl_Off : Value_Offsets;
+ begin
+ Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
+ Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ);
+ Exec_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ,
+ Res_Bnd, Sl_Off);
+ return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd);
+ end;
+ when Iir_Kind_Indexed_Name =>
+ declare
+ Pfx_Typ : Type_Acc;
+ begin
+ Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
+ return Get_Array_Element (Pfx_Typ);
+ end;
+ when Iir_Kind_Selected_Element =>
+ declare
+ Idx : constant Iir_Index32 :=
+ Get_Element_Position (Get_Named_Entity (Expr));
+ Pfx_Typ : Type_Acc;
+ begin
+ Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
+ return Pfx_Typ.Rec.E (Idx + 1).Typ;
+ end;
+
+ when Iir_Kind_Implicit_Dereference
+ | Iir_Kind_Dereference =>
+ declare
+ Val : Valtyp;
+ Res : Valtyp;
+ begin
+ -- Maybe do not dereference it if its type is known ?
+ Val := Exec_Expression (Syn_Inst, Get_Prefix (Expr));
+ Res := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));
+ return Res.Typ;
+ end;
+
+ when Iir_Kind_String_Literal8 =>
+ -- TODO: the value should be computed (once) and its type
+ -- returned.
+ return Synth_Subtype_Indication (Syn_Inst, Get_Type (Expr));
+
+ when others =>
+ Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr);
+ end case;
+ return null;
+ end Exec_Type_Of_Object;
+
+ function Exec_Type_Conversion
+ (Syn_Inst : Synth_Instance_Acc; Conv : Node) return Valtyp
+ is
+ Expr : constant Node := Get_Expression (Conv);
+ Conv_Type : constant Node := Get_Type (Conv);
+ Conv_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Conv_Type);
+ Val : Valtyp;
+ begin
+ Val := Exec_Expression_With_Basetype (Syn_Inst, Expr);
+ if Val = No_Valtyp then
+ return No_Valtyp;
+ end if;
+ Strip_Const (Val);
+ case Get_Kind (Conv_Type) is
+ when Iir_Kind_Integer_Subtype_Definition =>
+ if Val.Typ.Kind = Type_Discrete then
+ -- Int to int.
+ return Val;
+ elsif Val.Typ.Kind = Type_Float then
+ return Create_Value_Discrete
+ (Int64 (Read_Fp64 (Val)), Conv_Typ);
+ else
+ Error_Msg_Elab (+Conv, "unhandled type conversion (to int)");
+ return No_Valtyp;
+ end if;
+ when Iir_Kind_Floating_Subtype_Definition =>
+ if Is_Static (Val.Val) then
+ return Create_Value_Float
+ (Fp64 (Read_Discrete (Val)), Conv_Typ);
+ else
+ Error_Msg_Elab (+Conv, "unhandled type conversion (to float)");
+ return No_Valtyp;
+ end if;
+ when Iir_Kind_Array_Type_Definition
+ | Iir_Kind_Array_Subtype_Definition =>
+ case Conv_Typ.Kind is
+ when Type_Vector
+ | Type_Unbounded_Vector =>
+ return Val;
+ when others =>
+ Error_Msg_Elab
+ (+Conv, "unhandled type conversion (to array)");
+ return No_Valtyp;
+ end case;
+ when Iir_Kind_Enumeration_Type_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition =>
+ pragma Assert (Get_Base_Type (Get_Type (Expr))
+ = Get_Base_Type (Conv_Type));
+ return Val;
+ when others =>
+ Error_Msg_Elab (+Conv, "unhandled type conversion");
+ return No_Valtyp;
+ end case;
+ end Exec_Type_Conversion;
+
+ function Error_Ieee_Operator (Imp : Node; Loc : Node) return Boolean
+ is
+ use Std_Names;
+ Parent : constant Iir := Get_Parent (Imp);
+ begin
+ if Get_Kind (Parent) = Iir_Kind_Package_Declaration
+ and then (Get_Identifier
+ (Get_Library (Get_Design_File (Get_Design_Unit (Parent))))
+ = Name_Ieee)
+ then
+ case Get_Identifier (Parent) is
+ when Name_Std_Logic_1164
+ | Name_Std_Logic_Arith
+ | Name_Std_Logic_Signed
+ | Name_Std_Logic_Unsigned
+ | Name_Std_Logic_Misc
+ | Name_Numeric_Std
+ | Name_Numeric_Bit
+ | Name_Math_Real =>
+ Error_Msg_Elab
+ (+Loc, "unhandled predefined IEEE operator %i", +Imp);
+ Error_Msg_Elab
+ (+Imp, " declared here");
+ return True;
+ when others =>
+ -- ieee 2008 packages are handled like regular packages.
+ null;
+ end case;
+ end if;
+
+ return False;
+ end Error_Ieee_Operator;
+
+ function Synth_String_Literal
+ (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc)
+ return Valtyp
+ is
+ pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8);
+ Id : constant String8_Id := Get_String8_Id (Str);
+
+ Str_Type : constant Node := Get_Type (Str);
+ El_Type : Type_Acc;
+ Bounds : Bound_Type;
+ Bnds : Bound_Array_Acc;
+ Res_Type : Type_Acc;
+ Res : Valtyp;
+ Pos : Nat8;
+ begin
+ case Str_Typ.Kind is
+ when Type_Vector =>
+ Bounds := Str_Typ.Vbound;
+ when Type_Array =>
+ Bounds := Str_Typ.Abounds.D (1);
+ when Type_Unbounded_Vector
+ | Type_Unbounded_Array =>
+ Bounds := Synth_Bounds_From_Length
+ (Get_Index_Type (Str_Type, 0), Get_String_Length (Str));
+ when others =>
+ raise Internal_Error;
+ end case;
+
+ El_Type := Get_Subtype_Object (Syn_Inst, Get_Element_Subtype (Str_Type));
+ if El_Type.Kind in Type_Nets then
+ Res_Type := Create_Vector_Type (Bounds, El_Type);
+ else
+ Bnds := Create_Bound_Array (1);
+ Bnds.D (1) := Bounds;
+ Res_Type := Create_Array_Type (Bnds, El_Type);
+ end if;
+ Res := Create_Value_Memory (Res_Type);
+
+ -- Only U8 are handled.
+ pragma Assert (El_Type.Sz = 1);
+
+ -- From left to right.
+ for I in 1 .. Bounds.Len loop
+ -- FIXME: use literal from type ??
+ Pos := Str_Table.Element_String8 (Id, Pos32 (I));
+ Write_U8 (Res.Val.Mem + Size_Type (I - 1), Nat8'Pos (Pos));
+ end loop;
+
+ return Res;
+ end Synth_String_Literal;
+
+ -- Return the left bound if the direction of the range is LEFT_DIR.
+ function Synth_Low_High_Type_Attribute
+ (Syn_Inst : Synth_Instance_Acc; Expr : Node; Left_Dir : Direction_Type)
+ return Valtyp
+ is
+ Typ : Type_Acc;
+ R : Int64;
+ begin
+ Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Get_Prefix (Expr)));
+ pragma Assert (Typ.Kind = Type_Discrete);
+ if Typ.Drange.Dir = Left_Dir then
+ R := Typ.Drange.Left;
+ else
+ R := Typ.Drange.Right;
+ end if;
+ return Create_Value_Discrete (R, Typ);
+ end Synth_Low_High_Type_Attribute;
+
+ function Exec_Short_Circuit (Syn_Inst : Synth_Instance_Acc;
+ Val : Int64;
+ Left_Expr : Node;
+ Right_Expr : Node;
+ Typ : Type_Acc) return Valtyp
+ is
+ Left : Valtyp;
+ Right : Valtyp;
+ begin
+ Left := Exec_Expression_With_Type (Syn_Inst, Left_Expr, Typ);
+ if Left = No_Valtyp then
+ -- Propagate error.
+ return No_Valtyp;
+ end if;
+ pragma Assert (Is_Static (Left.Val));
+ if Get_Static_Discrete (Left) = Val then
+ -- Short-circuit when the left operand determines the result.
+ return Create_Value_Discrete (Val, Typ);
+ end if;
+
+ Strip_Const (Left);
+ Right := Exec_Expression_With_Type (Syn_Inst, Right_Expr, Typ);
+ if Right = No_Valtyp then
+ -- Propagate error.
+ return No_Valtyp;
+ end if;
+ Strip_Const (Right);
+
+ pragma Assert (Is_Static (Right.Val));
+ if Get_Static_Discrete (Right) = Val then
+ -- If the right operand can determine the result, return it.
+ return Create_Value_Discrete (Val, Typ);
+ end if;
+
+ -- Return a static value if both operands are static.
+ -- Note: we know the value of left if it is not constant.
+ return Create_Value_Discrete (Get_Static_Discrete (Right), Typ);
+ end Exec_Short_Circuit;
+
+ function Exec_Expression_With_Type (Syn_Inst : Synth_Instance_Acc;
+ Expr : Node;
+ Expr_Type : Type_Acc) return Valtyp is
+ begin
+ case Get_Kind (Expr) is
+ when Iir_Kinds_Dyadic_Operator =>
+ declare
+ Imp : constant Node := Get_Implementation (Expr);
+ Def : constant Iir_Predefined_Functions :=
+ Get_Implicit_Definition (Imp);
+ begin
+ -- Specially handle short-circuit operators.
+ case Def is
+ when Iir_Predefined_Boolean_And =>
+ return Exec_Short_Circuit
+ (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr),
+ Boolean_Type);
+ when Iir_Predefined_Boolean_Or =>
+ return Exec_Short_Circuit
+ (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr),
+ Boolean_Type);
+ when Iir_Predefined_Bit_And =>
+ return Exec_Short_Circuit
+ (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr),
+ Bit_Type);
+ when Iir_Predefined_Bit_Or =>
+ return Exec_Short_Circuit
+ (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr),
+ Bit_Type);
+ when Iir_Predefined_None =>
+ if Error_Ieee_Operator (Imp, Expr) then
+ return No_Valtyp;
+ else
+ return Synth_User_Operator
+ (Syn_Inst, Get_Left (Expr), Get_Right (Expr), Expr);
+ end if;
+ when others =>
+ return Synth_Dyadic_Operation
+ (Syn_Inst, Imp,
+ Get_Left (Expr), Get_Right (Expr), Expr);
+ end case;
+ end;
+ when Iir_Kinds_Monadic_Operator =>
+ declare
+ Imp : constant Node := Get_Implementation (Expr);
+ Def : constant Iir_Predefined_Functions :=
+ Get_Implicit_Definition (Imp);
+ begin
+ if Def = Iir_Predefined_None then
+ if Error_Ieee_Operator (Imp, Expr) then
+ return No_Valtyp;
+ else
+ return Synth_User_Operator
+ (Syn_Inst, Get_Operand (Expr), Null_Node, Expr);
+ end if;
+ else
+ return Synth_Monadic_Operation
+ (Syn_Inst, Imp, Get_Operand (Expr), Expr);
+ end if;
+ end;
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Selected_Name
+ | Iir_Kind_Interface_Signal_Declaration -- For PSL.
+ | Iir_Kind_Signal_Declaration -- For PSL.
+ | Iir_Kind_Implicit_Dereference
+ | Iir_Kind_Dereference =>
+ declare
+ Res : Valtyp;
+ begin
+ Res := Exec_Name (Syn_Inst, Expr);
+ if Res.Val.Kind = Value_Signal then
+ Vhdl_Errors.Error_Msg_Elab
+ (+Expr, "cannot use signal value during elaboration");
+ return No_Valtyp;
+ end if;
+ if Res.Typ /= null
+ and then Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory
+ then
+ -- This is a null object. As nothing can be done about it,
+ -- returns 0.
+ return Create_Value_Memtyp (Create_Memory_Zero (Res.Typ));
+ end if;
+ return Res;
+ end;
+ when Iir_Kind_Reference_Name =>
+ -- Only used for anonymous signals in internal association.
+ return Exec_Expression_With_Type
+ (Syn_Inst, Get_Named_Entity (Expr), Expr_Type);
+ when Iir_Kind_Indexed_Name
+ | Iir_Kind_Slice_Name =>
+ raise Internal_Error;
+ -- declare
+ -- Base : Valtyp;
+ -- Typ : Type_Acc;
+ -- Off : Value_Offsets;
+ -- Res : Valtyp;
+
+ -- Dyn : Dyn_Name;
+ -- begin
+ -- Synth_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off, Dyn);
+ -- if Dyn.Voff = No_Net and then Is_Static (Base.Val) then
+ -- Res := Create_Value_Memory (Typ);
+ -- Copy_Memory
+ -- (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz);
+ -- return Res;
+ -- end if;
+ -- return Synth_Read_Memory
+ -- (Syn_Inst, Base, Typ, Off.Net_Off, Dyn, Expr);
+ -- end;
+ when Iir_Kind_Selected_Element =>
+ declare
+ Idx : constant Iir_Index32 :=
+ Get_Element_Position (Get_Named_Entity (Expr));
+ Pfx : constant Node := Get_Prefix (Expr);
+ Res_Typ : Type_Acc;
+ Val : Valtyp;
+ Res : Valtyp;
+ begin
+ Val := Exec_Expression (Syn_Inst, Pfx);
+ Strip_Const (Val);
+ Res_Typ := Val.Typ.Rec.E (Idx + 1).Typ;
+ if Res_Typ.W = 0 and then Val.Val.Kind /= Value_Memory then
+ -- This is a null object. As nothing can be done about it,
+ -- returns 0.
+ return Create_Value_Memtyp (Create_Memory_Zero (Res_Typ));
+ end if;
+ pragma Assert (Is_Static (Val.Val));
+ Res := Create_Value_Memory (Res_Typ);
+ Copy_Memory
+ (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Moff,
+ Res_Typ.Sz);
+ return Res;
+ end;
+ when Iir_Kind_Character_Literal =>
+ return Exec_Expression_With_Type
+ (Syn_Inst, Get_Named_Entity (Expr), Expr_Type);
+ when Iir_Kind_Integer_Literal =>
+ declare
+ Res : Valtyp;
+ begin
+ Res := Create_Value_Memory (Expr_Type);
+ Write_Discrete (Res, Get_Value (Expr));
+ return Res;
+ end;
+ when Iir_Kind_Floating_Point_Literal =>
+ return Create_Value_Float (Get_Fp_Value (Expr), Expr_Type);
+ when Iir_Kind_Physical_Int_Literal
+ | Iir_Kind_Physical_Fp_Literal =>
+ return Create_Value_Discrete
+ (Get_Physical_Value (Expr), Expr_Type);
+ when Iir_Kind_String_Literal8 =>
+ return Synth_String_Literal (Syn_Inst, Expr, Expr_Type);
+ when Iir_Kind_Enumeration_Literal =>
+ return Exec_Name (Syn_Inst, Expr);
+ when Iir_Kind_Type_Conversion =>
+ return Exec_Type_Conversion (Syn_Inst, Expr);
+ when Iir_Kind_Qualified_Expression =>
+ return Exec_Expression_With_Type
+ (Syn_Inst, Get_Expression (Expr),
+ Get_Subtype_Object (Syn_Inst, Get_Type (Get_Type_Mark (Expr))));
+ when Iir_Kind_Function_Call =>
+ declare
+ Imp : constant Node := Get_Implementation (Expr);
+ begin
+ case Get_Implicit_Definition (Imp) is
+ when Iir_Predefined_Pure_Functions
+ | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators =>
+ return Synth_Operator_Function_Call (Syn_Inst, Expr);
+ when Iir_Predefined_None =>
+ return Synth_User_Function_Call (Syn_Inst, Expr);
+ when others =>
+ return Synth_Predefined_Function_Call (Syn_Inst, Expr);
+ end case;
+ end;
+ when Iir_Kind_Aggregate =>
+ return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type);
+ when Iir_Kind_Simple_Aggregate =>
+ return Synth_Simple_Aggregate (Syn_Inst, Expr);
+ when Iir_Kind_Parenthesis_Expression =>
+ return Exec_Expression_With_Type
+ (Syn_Inst, Get_Expression (Expr), Expr_Type);
+ when Iir_Kind_Left_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Expr);
+ return Create_Value_Discrete (Int64 (B.Left), Expr_Type);
+ end;
+ when Iir_Kind_Right_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Expr);
+ return Create_Value_Discrete (Int64 (B.Right), Expr_Type);
+ end;
+ when Iir_Kind_High_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ V : Int32;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Expr);
+ case B.Dir is
+ when Dir_To =>
+ V := B.Right;
+ when Dir_Downto =>
+ V := B.Left;
+ end case;
+ return Create_Value_Discrete (Int64 (V), Expr_Type);
+ end;
+ when Iir_Kind_Low_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ V : Int32;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Expr);
+ case B.Dir is
+ when Dir_To =>
+ V := B.Left;
+ when Dir_Downto =>
+ V := B.Right;
+ end case;
+ return Create_Value_Discrete (Int64 (V), Expr_Type);
+ end;
+ when Iir_Kind_Length_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Expr);
+ return Create_Value_Discrete (Int64 (B.Len), Expr_Type);
+ end;
+ when Iir_Kind_Ascending_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ V : Int64;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Expr);
+ case B.Dir is
+ when Dir_To =>
+ V := 1;
+ when Dir_Downto =>
+ V := 0;
+ end case;
+ return Create_Value_Discrete (V, Expr_Type);
+ end;
+
+ when Iir_Kind_Pos_Attribute
+ | Iir_Kind_Val_Attribute =>
+ declare
+ Param : constant Node := Get_Parameter (Expr);
+ V : Valtyp;
+ Dtype : Type_Acc;
+ begin
+ V := Exec_Expression (Syn_Inst, Param);
+ Dtype := Get_Subtype_Object (Syn_Inst, Get_Type (Expr));
+ -- FIXME: to be generalized. Not always as simple as a
+ -- subtype conversion.
+ return Exec_Subtype_Conversion (V, Dtype, False, Expr);
+ end;
+ when Iir_Kind_Low_Type_Attribute =>
+ return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_To);
+ when Iir_Kind_High_Type_Attribute =>
+ return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto);
+ when Iir_Kind_Value_Attribute =>
+ return Synth_Value_Attribute (Syn_Inst, Expr);
+ when Iir_Kind_Image_Attribute =>
+ return Synth_Image_Attribute (Syn_Inst, Expr);
+ when Iir_Kind_Instance_Name_Attribute =>
+ return Synth_Instance_Name_Attribute (Syn_Inst, Expr);
+ when Iir_Kind_Null_Literal =>
+ return Create_Value_Access (Null_Heap_Index, Expr_Type);
+ when Iir_Kind_Allocator_By_Subtype =>
+ declare
+ T : Type_Acc;
+ Acc : Heap_Index;
+ begin
+ T := Synth_Subtype_Indication
+ (Syn_Inst, Get_Subtype_Indication (Expr));
+ Acc := Allocate_By_Type (T);
+ return Create_Value_Access (Acc, Expr_Type);
+ end;
+ when Iir_Kind_Allocator_By_Expression =>
+ declare
+ V : Valtyp;
+ Acc : Heap_Index;
+ begin
+ V := Exec_Expression_With_Type
+ (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc);
+ Acc := Allocate_By_Value (V);
+ return Create_Value_Access (Acc, Expr_Type);
+ end;
+ when Iir_Kind_Stable_Attribute =>
+ Error_Msg_Elab (+Expr, "signal attribute not supported");
+ return No_Valtyp;
+ when Iir_Kind_Overflow_Literal =>
+ Error_Msg_Elab (+Expr, "out of bound expression");
+ return No_Valtyp;
+ when others =>
+ Error_Kind ("exec_expression_with_type", Expr);
+ end case;
+ end Exec_Expression_With_Type;
+
+ function Exec_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node)
+ return Valtyp
+ is
+ Etype : Node;
+ begin
+ Etype := Get_Type (Expr);
+
+ case Get_Kind (Expr) is
+ when Iir_Kind_High_Array_Attribute
+ | Iir_Kind_Low_Array_Attribute
+ | Iir_Kind_Integer_Literal =>
+ -- The type of this attribute is the type of the index, which is
+ -- not synthesized as atype (only as an index).
+ -- For integer_literal, the type is not really needed, and it
+ -- may be created by static evaluation of an array attribute.
+ Etype := Get_Base_Type (Etype);
+ when others =>
+ null;
+ end case;
+
+ return Exec_Expression_With_Type
+ (Syn_Inst, Expr, Get_Subtype_Object (Syn_Inst, Etype));
+ end Exec_Expression;
+
+ function Exec_Expression_With_Basetype
+ (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp
+ is
+ Basetype : Type_Acc;
+ begin
+ Basetype := Get_Subtype_Object
+ (Syn_Inst, Get_Base_Type (Get_Type (Expr)));
+ return Exec_Expression_With_Type (Syn_Inst, Expr, Basetype);
+ end Exec_Expression_With_Basetype;
+end Elab.Vhdl_Expr;
diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads
new file mode 100644
index 000000000..2eac33f1c
--- /dev/null
+++ b/src/synth/elab-vhdl_expr.ads
@@ -0,0 +1,80 @@
+-- Expressions synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
+package Elab.Vhdl_Expr is
+ -- For a static value V, return the value.
+ function Get_Static_Discrete (V : Valtyp) return Int64;
+
+ -- Return the memory (as a memtyp) of static value V.
+ function Get_Value_Memtyp (V : Valtyp) return Memtyp;
+
+ -- Return the bounds of a one dimensional array/vector type and the
+ -- width of the element.
+ procedure Get_Onedimensional_Array_Bounds
+ (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc);
+
+ -- Create an array subtype from bound BND.
+ function Create_Onedimensional_Array_Subtype
+ (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc;
+
+ -- Return the type of EXPR without evaluating it.
+ function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
+ return Type_Acc;
+
+ procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
+ Pfx : Node;
+ Dest_Base : out Valtyp;
+ Dest_Typ : out Type_Acc;
+ Dest_Off : out Value_Offsets);
+
+ function Exec_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
+ return Valtyp;
+
+ -- Synthesize EXPR. The expression must be self-constrained.
+ -- If EN is not No_Net, the execution is controlled by EN. This is used
+ -- for assertions and checks.
+ function Exec_Expression
+ (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp;
+
+ -- Same as Synth_Expression, but the expression may be constrained by
+ -- EXPR_TYPE.
+ function Exec_Expression_With_Type (Syn_Inst : Synth_Instance_Acc;
+ Expr : Node;
+ Expr_Type : Type_Acc) return Valtyp;
+
+ -- Use base type of EXPR to synthesize EXPR. Useful when the type of
+ -- EXPR is defined by itself or a range.
+ function Exec_Expression_With_Basetype (Syn_Inst : Synth_Instance_Acc;
+ Expr : Node) return Valtyp;
+
+ -- Subtype conversion.
+ function Exec_Subtype_Conversion (Vt : Valtyp;
+ Dtype : Type_Acc;
+ Bounds : Boolean;
+ Loc : Node)
+ return Valtyp;
+
+end Elab.Vhdl_Expr;
diff --git a/src/synth/synth-vhdl_files.adb b/src/synth/elab-vhdl_files.adb
index 2300ff9f9..2e00265f6 100644
--- a/src/synth/synth-vhdl_files.adb
+++ b/src/synth/elab-vhdl_files.adb
@@ -20,16 +20,18 @@ with Types; use Types;
with Files_Map;
with Name_Table;
+with Vhdl.Errors; use Vhdl.Errors;
+
with Grt.Types; use Grt.Types;
with Grt.Files_Operations; use Grt.Files_Operations;
with Grt.Stdio;
-with Synth.Memtype; use Synth.Memtype;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
-with Synth.Errors; use Synth.Errors;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
+with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;
-package body Synth.Vhdl_Files is
+package body Elab.Vhdl_Files is
-- Variables to store the search path.
Current_Unit : Node := Null_Node;
@@ -45,7 +47,7 @@ package body Synth.Vhdl_Files is
procedure File_Error (Loc : Node; Status : Op_Status) is
begin
pragma Assert (Status /= Op_Ok);
- Error_Msg_Synth (+Loc, "file operation failed");
+ Error_Msg_Elab (+Loc, "file operation failed");
raise File_Execution_Error;
end File_Error;
@@ -211,10 +213,10 @@ package body Synth.Vhdl_Files is
return F;
end if;
- File_Name := Synth_Expression_With_Basetype (Syn_Inst, External_Name);
+ File_Name := Exec_Expression_With_Basetype (Syn_Inst, External_Name);
if Open_Kind /= Null_Node then
- Mode := Synth_Expression (Syn_Inst, Open_Kind);
+ Mode := Exec_Expression (Syn_Inst, Open_Kind);
File_Mode := Ghdl_I32 (Read_Discrete (Mode));
else
case Get_Mode (Decl) is
@@ -240,7 +242,7 @@ package body Synth.Vhdl_Files is
if Status /= Op_Ok then
if Status = Op_Name_Error then
- Error_Msg_Synth
+ Error_Msg_Elab
(+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len));
Set_Error (Syn_Inst);
else
@@ -251,7 +253,7 @@ package body Synth.Vhdl_Files is
return F;
end Elaborate_File_Declaration;
- function Endfile (F : File_Index; Loc : Syn_Src) return Boolean
+ function Endfile (F : File_Index; Loc : Node) return Boolean
is
Status : Op_Status;
begin
@@ -298,7 +300,7 @@ package body Synth.Vhdl_Files is
if Status /= Op_Ok then
if Status = Op_Name_Error then
- Error_Msg_Synth
+ Error_Msg_Elab
(+Loc, "cannot open file: " & C_Name (1 .. C_Name_Len));
raise File_Execution_Error;
else
@@ -413,4 +415,4 @@ package body Synth.Vhdl_Files is
File_Read_Value (File, (Value.Typ, Value.Val.Mem), Loc);
end Synth_File_Read;
-end Synth.Vhdl_Files;
+end Elab.Vhdl_Files;
diff --git a/src/synth/synth-vhdl_files.ads b/src/synth/elab-vhdl_files.ads
index 1d373664e..7987e0ccf 100644
--- a/src/synth/synth-vhdl_files.ads
+++ b/src/synth/elab-vhdl_files.ads
@@ -18,11 +18,10 @@
with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Source; use Synth.Source;
-with Synth.Values; use Synth.Values;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
-package Synth.Vhdl_Files is
+package Elab.Vhdl_Files is
-- Raised in case of un-recoverable error.
File_Execution_Error : exception;
@@ -33,7 +32,7 @@ package Synth.Vhdl_Files is
function Elaborate_File_Declaration
(Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index;
- function Endfile (F : File_Index; Loc : Syn_Src) return Boolean;
+ function Endfile (F : File_Index; Loc : Node) return Boolean;
procedure Synth_File_Open
(Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node);
@@ -45,4 +44,4 @@ package Synth.Vhdl_Files is
procedure Synth_File_Read
(Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node);
-end Synth.Vhdl_Files;
+end Elab.Vhdl_Files;
diff --git a/src/synth/synth-vhdl_heap.adb b/src/synth/elab-vhdl_heap.adb
index 6ab9af3e5..a6027bfef 100644
--- a/src/synth/synth-vhdl_heap.adb
+++ b/src/synth/elab-vhdl_heap.adb
@@ -19,10 +19,9 @@
with Types; use Types;
with Tables;
+with Elab.Memtype; use Elab.Memtype;
-with Synth.Memtype; use Synth.Memtype;
-
-package body Synth.Vhdl_Heap is
+package body Elab.Vhdl_Heap is
package Heap_Table is new Tables
(Table_Component_Type => Valtyp,
@@ -91,4 +90,4 @@ package body Synth.Vhdl_Heap is
Free (Heap_Table.Table (Idx));
end Synth_Deallocate;
-end Synth.Vhdl_Heap;
+end Elab.Vhdl_Heap;
diff --git a/src/synth/synth-vhdl_heap.ads b/src/synth/elab-vhdl_heap.ads
index 0e1928b26..e6c9db777 100644
--- a/src/synth/synth-vhdl_heap.ads
+++ b/src/synth/elab-vhdl_heap.ads
@@ -16,10 +16,10 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
-package Synth.Vhdl_Heap is
+package Elab.Vhdl_Heap is
-- Allocate a value.
function Allocate_By_Type (T : Type_Acc) return Heap_Index;
function Allocate_By_Value (V : Valtyp) return Heap_Index;
@@ -27,4 +27,4 @@ package Synth.Vhdl_Heap is
function Synth_Dereference (Idx : Heap_Index) return Valtyp;
procedure Synth_Deallocate (Idx : Heap_Index);
-end Synth.Vhdl_Heap;
+end Elab.Vhdl_Heap;
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb
new file mode 100644
index 000000000..e5fc5e97b
--- /dev/null
+++ b/src/synth/elab-vhdl_insts.adb
@@ -0,0 +1,673 @@
+-- Design elaboration
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+with Libraries;
+
+with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Std_Package;
+with Vhdl.Annotations;
+with Vhdl.Configuration; use Vhdl.Configuration;
+with Vhdl.Errors; use Vhdl.Errors;
+
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Decls; use Elab.Vhdl_Decls;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Stmts; use Elab.Vhdl_Stmts;
+with Elab.Vhdl_Files;
+with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
+
+package body Elab.Vhdl_Insts is
+ procedure Elab_Convertible_Declarations (Syn_Inst : Synth_Instance_Acc)
+ is
+ use Vhdl.Std_Package;
+ begin
+ Create_Subtype_Object
+ (Syn_Inst, Convertible_Integer_Type_Definition,
+ Get_Subtype_Object (Syn_Inst, Universal_Integer_Type_Definition));
+ Create_Subtype_Object
+ (Syn_Inst, Convertible_Real_Type_Definition,
+ Get_Subtype_Object (Syn_Inst, Universal_Real_Type_Definition));
+ end Elab_Convertible_Declarations;
+
+ procedure Elab_Generics_Association (Sub_Inst : Synth_Instance_Acc;
+ Syn_Inst : Synth_Instance_Acc;
+ Inter_Chain : Node;
+ Assoc_Chain : Node)
+ is
+ Inter : Node;
+ Inter_Type : Type_Acc;
+ Assoc : Node;
+ Assoc_Inter : Node;
+ Actual : Node;
+ Val : Valtyp;
+ begin
+ Assoc := Assoc_Chain;
+ Assoc_Inter := Inter_Chain;
+ while Is_Valid (Assoc) loop
+ Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+ case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
+ when Iir_Kind_Interface_Constant_Declaration =>
+ Elab_Declaration_Type (Sub_Inst, Inter);
+ Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
+
+ case Get_Kind (Assoc) is
+ when Iir_Kind_Association_Element_Open =>
+ Actual := Get_Default_Value (Inter);
+ Val := Exec_Expression_With_Type
+ (Sub_Inst, Actual, Inter_Type);
+ when Iir_Kind_Association_Element_By_Expression =>
+ Actual := Get_Actual (Assoc);
+ Val := Exec_Expression_With_Type
+ (Syn_Inst, Actual, Inter_Type);
+ when others =>
+ raise Internal_Error;
+ end case;
+
+ Val := Exec_Subtype_Conversion (Val, Inter_Type, True, Assoc);
+
+ if Val = No_Valtyp then
+ Set_Error (Sub_Inst);
+ elsif not Is_Static (Val.Val) then
+ Error_Msg_Elab
+ (+Assoc, "value of generic %i must be static", +Inter);
+ Val := No_Valtyp;
+ Set_Error (Sub_Inst);
+ end if;
+
+ Create_Object (Sub_Inst, Inter, Val);
+
+ when Iir_Kind_Interface_Package_Declaration =>
+ declare
+ Actual : constant Iir :=
+ Strip_Denoting_Name (Get_Actual (Assoc));
+ Pkg_Inst : Synth_Instance_Acc;
+ begin
+ Pkg_Inst := Get_Package_Object (Sub_Inst, Actual);
+ Create_Package_Interface (Sub_Inst, Inter, Pkg_Inst);
+ end;
+
+ when Iir_Kind_Interface_Variable_Declaration
+ | Iir_Kind_Interface_File_Declaration
+ | Iir_Kind_Interface_Signal_Declaration
+ | Iir_Kind_Interface_Quantity_Declaration
+ | Iir_Kind_Interface_Terminal_Declaration =>
+ raise Internal_Error;
+
+ when Iir_Kinds_Interface_Subprogram_Declaration
+ | Iir_Kind_Interface_Type_Declaration =>
+ raise Internal_Error;
+ end case;
+
+ Next_Association_Interface (Assoc, Assoc_Inter);
+ end loop;
+ end Elab_Generics_Association;
+
+ procedure Elab_Package_Declaration
+ (Parent_Inst : Synth_Instance_Acc; Pkg : Node)
+ is
+ Syn_Inst : Synth_Instance_Acc;
+ begin
+ if Is_Uninstantiated_Package (Pkg) then
+ -- Nothing to do (yet) for uninstantiated packages.
+ return;
+ end if;
+
+ Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg);
+
+ Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg));
+ if Pkg = Vhdl.Std_Package.Standard_Package then
+ Elab_Convertible_Declarations (Syn_Inst);
+ end if;
+ end Elab_Package_Declaration;
+
+ procedure Elab_Package_Body
+ (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node)
+ is
+ Pkg_Inst : Synth_Instance_Acc;
+ begin
+ if Is_Uninstantiated_Package (Pkg) then
+ -- Nothing to do (yet) for uninstantiated packages.
+ return;
+ end if;
+
+ Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg);
+
+ Elab_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod));
+ end Elab_Package_Body;
+
+ procedure Elab_Package_Instantiation
+ (Parent_Inst : Synth_Instance_Acc; Pkg : Node)
+ is
+ Bod : constant Node := Get_Instance_Package_Body (Pkg);
+ Sub_Inst : Synth_Instance_Acc;
+ begin
+ Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg);
+
+ Elab_Generics_Association
+ (Sub_Inst, Parent_Inst,
+ Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg));
+
+ Elab_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg));
+
+ if Bod /= Null_Node then
+ -- Macro expanded package instantiation.
+ raise Internal_Error;
+ else
+ -- Shared body
+ declare
+ Uninst : constant Node := Get_Uninstantiated_Package_Decl (Pkg);
+ Uninst_Bod : constant Node := Get_Package_Body (Uninst);
+ begin
+ Set_Uninstantiated_Scope (Sub_Inst, Uninst);
+ -- Synth declarations of (optional) body.
+ if Uninst_Bod /= Null_Node then
+ Elab_Declarations
+ (Sub_Inst, Get_Declaration_Chain (Uninst_Bod));
+ end if;
+ end;
+ end if;
+ end Elab_Package_Instantiation;
+
+ procedure Elab_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node)
+ is
+ Dep_List : constant Node_List := Get_Dependence_List (Unit);
+ Dep_It : List_Iterator;
+ Dep : Node;
+ Dep_Unit : Node;
+ begin
+ Dep_It := List_Iterate (Dep_List);
+ while Is_Valid (Dep_It) loop
+ Dep := Get_Element (Dep_It);
+ if Get_Kind (Dep) = Iir_Kind_Design_Unit
+ and then not Get_Elab_Flag (Dep)
+ then
+ Set_Elab_Flag (Dep, True);
+ Elab_Dependencies (Parent_Inst, Dep);
+ Dep_Unit := Get_Library_Unit (Dep);
+ case Iir_Kinds_Library_Unit (Get_Kind (Dep_Unit)) is
+ when Iir_Kind_Entity_Declaration =>
+ null;
+ when Iir_Kind_Configuration_Declaration =>
+ null;
+ when Iir_Kind_Context_Declaration =>
+ null;
+ when Iir_Kind_Package_Declaration =>
+ declare
+ Bod : constant Node := Get_Package_Body (Dep_Unit);
+ Bod_Unit : Node;
+ begin
+ Elab_Package_Declaration (Parent_Inst, Dep_Unit);
+ -- Do not try to elaborate math_real body: there are
+ -- functions with loop. Currently, try create signals,
+ -- which is not possible during package elaboration.
+ if Bod /= Null_Node then
+ Bod_Unit := Get_Design_Unit (Bod);
+ Elab_Dependencies (Parent_Inst, Bod_Unit);
+ Elab_Package_Body (Parent_Inst, Dep_Unit, Bod);
+ end if;
+ end;
+ when Iir_Kind_Package_Instantiation_Declaration =>
+ Elab_Package_Instantiation (Parent_Inst, Dep_Unit);
+ when Iir_Kind_Package_Body =>
+ null;
+ when Iir_Kind_Architecture_Body =>
+ null;
+ when Iir_Kinds_Verification_Unit =>
+ null;
+ end case;
+ end if;
+ Next (Dep_It);
+ end loop;
+ end Elab_Dependencies;
+
+ procedure Apply_Block_Configuration (Cfg : Node; Blk : Node)
+ is
+ Item : Node;
+ begin
+ -- Be sure CFG applies to BLK.
+ pragma Assert (Get_Block_From_Block_Specification
+ (Get_Block_Specification (Cfg)) = Blk);
+
+ -- Clear_Instantiation_Configuration (Blk);
+
+ Item := Get_Configuration_Item_Chain (Cfg);
+ while Item /= Null_Node loop
+ case Get_Kind (Item) is
+ when Iir_Kind_Component_Configuration =>
+ declare
+ List : constant Iir_Flist :=
+ Get_Instantiation_List (Item);
+ El : Node;
+ Inst : Node;
+ begin
+ for I in Flist_First .. Flist_Last (List) loop
+ El := Get_Nth_Element (List, I);
+ Inst := Get_Named_Entity (El);
+ pragma Assert
+ (Get_Kind (Inst)
+ = Iir_Kind_Component_Instantiation_Statement);
+ pragma Assert
+ (Get_Component_Configuration (Inst) = Null_Node);
+ Set_Component_Configuration (Inst, Item);
+ end loop;
+ end;
+ when Iir_Kind_Block_Configuration =>
+ declare
+ Sub_Blk : constant Node := Get_Block_From_Block_Specification
+ (Get_Block_Specification (Item));
+ begin
+ case Get_Kind (Sub_Blk) is
+ when Iir_Kind_Generate_Statement_Body =>
+ -- Linked chain.
+ Set_Prev_Block_Configuration
+ (Item, Get_Generate_Block_Configuration (Sub_Blk));
+ Set_Generate_Block_Configuration (Sub_Blk, Item);
+ when Iir_Kind_Block_Statement =>
+ Set_Block_Block_Configuration (Sub_Blk, Item);
+ when others =>
+ Vhdl.Errors.Error_Kind
+ ("apply_block_configuration(blk)", Sub_Blk);
+ end case;
+ end;
+ when others =>
+ Vhdl.Errors.Error_Kind ("apply_block_configuration", Item);
+ end case;
+ Item := Get_Chain (Item);
+ end loop;
+ end Apply_Block_Configuration;
+
+ function Elab_Port_Association_Type (Sub_Inst : Synth_Instance_Acc;
+ Syn_Inst : Synth_Instance_Acc;
+ Inter : Node;
+ Assoc : Node) return Type_Acc is
+ begin
+ if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
+ -- TODO
+ -- Find the association for this interface
+ -- * if individual assoc: get type
+ -- * if whole assoc: get type from object.
+ if Assoc = Null_Node then
+ raise Internal_Error;
+ end if;
+ case Get_Kind (Assoc) is
+ when Iir_Kinds_Association_Element_By_Actual =>
+ return Exec_Type_Of_Object (Syn_Inst, Get_Actual (Assoc));
+ when others =>
+ raise Internal_Error;
+ end case;
+ else
+ Elab_Declaration_Type (Sub_Inst, Inter);
+ return Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
+ end if;
+ end Elab_Port_Association_Type;
+
+ procedure Elab_Ports_Association_Type (Sub_Inst : Synth_Instance_Acc;
+ Syn_Inst : Synth_Instance_Acc;
+ Inter_Chain : Node;
+ Assoc_Chain : Node)
+ is
+ Inter : Node;
+ Assoc : Node;
+ Assoc_Inter : Node;
+ Inter_Typ : Type_Acc;
+ begin
+ Assoc := Assoc_Chain;
+ Assoc_Inter := Inter_Chain;
+ while Is_Valid (Assoc) loop
+ Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+ if Get_Whole_Association_Flag (Assoc) then
+ Inter_Typ := Elab_Port_Association_Type
+ (Sub_Inst, Syn_Inst, Inter, Assoc);
+ Create_Signal (Sub_Inst, Inter, Inter_Typ, null);
+ end if;
+ Next_Association_Interface (Assoc, Assoc_Inter);
+ end loop;
+ end Elab_Ports_Association_Type;
+
+ procedure Elab_Verification_Unit
+ (Syn_Inst : Synth_Instance_Acc; Unit : Node)
+ is
+ Unit_Inst : Synth_Instance_Acc;
+ Item : Node;
+ Last_Type : Node;
+ begin
+ Unit_Inst := Make_Elab_Instance (Syn_Inst, Unit, Config => Null_Node);
+ Add_Extra_Instance (Syn_Inst, Unit_Inst);
+
+ Apply_Block_Configuration
+ (Get_Verification_Block_Configuration (Unit), Unit);
+
+ Last_Type := Null_Node;
+ Item := Get_Vunit_Item_Chain (Unit);
+ while Item /= Null_Node loop
+ case Get_Kind (Item) is
+ when Iir_Kind_Psl_Default_Clock
+ | Iir_Kind_Psl_Declaration =>
+ null;
+ when Iir_Kind_Psl_Assert_Directive
+ | Iir_Kind_Psl_Assume_Directive
+ | Iir_Kind_Psl_Cover_Directive
+ | Iir_Kind_Psl_Restrict_Directive =>
+ null;
+ when Iir_Kind_Signal_Declaration
+ | Iir_Kind_Constant_Declaration
+ | Iir_Kind_Function_Declaration
+ | Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Function_Body
+ | Iir_Kind_Procedure_Body
+ | Iir_Kind_Attribute_Declaration
+ | Iir_Kind_Attribute_Specification =>
+ Elab_Declaration (Unit_Inst, Item, Last_Type);
+ when Iir_Kinds_Concurrent_Signal_Assignment
+ | Iir_Kinds_Process_Statement
+ | Iir_Kinds_Generate_Statement
+ | Iir_Kind_Block_Statement
+ | Iir_Kind_Concurrent_Procedure_Call_Statement
+ | Iir_Kind_Component_Instantiation_Statement =>
+ Elab_Concurrent_Statement (Unit_Inst, Item);
+ when others =>
+ Error_Kind ("elab_vunit_declaration", Item);
+ end case;
+ Item := Get_Chain (Item);
+ end loop;
+ end Elab_Verification_Unit;
+
+ procedure Elab_Verification_Units
+ (Syn_Inst : Synth_Instance_Acc; Parent : Node)
+ is
+ Unit : Node;
+ begin
+ Unit := Get_Bound_Vunit_Chain (Parent);
+ while Unit /= Null_Node loop
+ Elab_Verification_Unit (Syn_Inst, Unit);
+ Unit := Get_Bound_Vunit_Chain (Unit);
+ end loop;
+ end Elab_Verification_Units;
+
+ procedure Elab_Instance_Body (Syn_Inst : Synth_Instance_Acc;
+ Entity : Node;
+ Arch : Node;
+ Config : Node) is
+ begin
+ Apply_Block_Configuration (Config, Arch);
+
+ Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
+ Elab_Concurrent_Statements
+ (Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
+
+ Elab_Verification_Units (Syn_Inst, Entity);
+
+ Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
+ Elab_Concurrent_Statements
+ (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
+
+ Elab_Verification_Units (Syn_Inst, Arch);
+ end Elab_Instance_Body;
+
+ procedure Elab_Direct_Instantiation_Statement
+ (Syn_Inst : Synth_Instance_Acc;
+ Stmt : Node;
+ Entity : Node;
+ Arch : Node;
+ Config : Node)
+ is
+ Sub_Inst : Synth_Instance_Acc;
+ begin
+ -- Elaborate generic + map aspect
+ Sub_Inst := Make_Elab_Instance (Syn_Inst, Arch, Config);
+
+ Create_Sub_Instance (Syn_Inst, Stmt, Sub_Inst);
+
+ Elab_Dependencies (Root_Instance, Get_Design_Unit (Entity));
+ Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch));
+
+
+ Elab_Generics_Association (Sub_Inst, Syn_Inst,
+ Get_Generic_Chain (Entity),
+ Get_Generic_Map_Aspect_Chain (Stmt));
+
+ -- Elaborate port types.
+ Elab_Ports_Association_Type (Sub_Inst, Syn_Inst,
+ Get_Port_Chain (Entity),
+ Get_Port_Map_Aspect_Chain (Stmt));
+
+ if Is_Error (Sub_Inst) then
+ -- TODO: Free it?
+ return;
+ end if;
+
+ -- Recurse.
+ Elab_Instance_Body (Sub_Inst, Entity, Arch, Config);
+ end Elab_Direct_Instantiation_Statement;
+
+ procedure Elab_Component_Instantiation_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
+ is
+ Component : constant Node :=
+ Get_Named_Entity (Get_Instantiated_Unit (Stmt));
+ Config : constant Node := Get_Component_Configuration (Stmt);
+ Bind : constant Node := Get_Binding_Indication (Config);
+ Aspect : Iir;
+ Comp_Inst : Synth_Instance_Acc;
+
+ Ent : Node;
+ Arch : Node;
+ Sub_Config : Node;
+ Sub_Inst : Synth_Instance_Acc;
+ begin
+ -- Create the sub-instance for the component
+ -- Elaborate generic + map aspect
+ Comp_Inst := Make_Elab_Instance (Syn_Inst, Component, Config);
+ Create_Sub_Instance (Syn_Inst, Stmt, Comp_Inst);
+
+ Elab_Generics_Association (Comp_Inst, Syn_Inst,
+ Get_Generic_Chain (Component),
+ Get_Generic_Map_Aspect_Chain (Stmt));
+
+ -- Create objects for the inputs and the outputs of the component,
+ -- assign inputs (that's nets) and create wires for outputs.
+ declare
+ Assoc : Node;
+ Assoc_Inter : Node;
+ Inter : Node;
+ Inter_Typ : Type_Acc;
+ begin
+ Assoc := Get_Port_Map_Aspect_Chain (Stmt);
+ Assoc_Inter := Get_Port_Chain (Component);
+ while Is_Valid (Assoc) loop
+ if Get_Whole_Association_Flag (Assoc) then
+ Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+
+ Inter_Typ := Elab_Port_Association_Type
+ (Comp_Inst, Syn_Inst, Inter, Assoc);
+
+ Create_Signal (Comp_Inst, Assoc_Inter, Inter_Typ, null);
+ end if;
+ Next_Association_Interface (Assoc, Assoc_Inter);
+ end loop;
+ end;
+
+ Set_Component_Configuration (Stmt, Null_Node);
+
+ if Bind = Null_Iir then
+ -- No association.
+ return;
+ end if;
+
+ Aspect := Get_Entity_Aspect (Bind);
+
+ -- Extract entity/architecture instantiated by the component.
+ case Get_Kind (Aspect) is
+ when Iir_Kind_Entity_Aspect_Entity =>
+ Ent := Get_Entity (Aspect);
+ Arch := Get_Architecture (Aspect);
+ when others =>
+ Vhdl.Errors.Error_Kind
+ ("Elab_Component_Instantiation_Statement(2)", Aspect);
+ end case;
+
+ if Get_Kind (Ent) = Iir_Kind_Foreign_Module then
+ -- TODO.
+ raise Internal_Error;
+ end if;
+
+ if Arch = Null_Node then
+ Arch := Libraries.Get_Latest_Architecture (Ent);
+ else
+ Arch := Get_Named_Entity (Arch);
+ end if;
+ Sub_Config := Get_Library_Unit
+ (Get_Default_Configuration_Declaration (Arch));
+ Sub_Config := Get_Block_Configuration (Sub_Config);
+
+ Elab_Dependencies (Root_Instance, Get_Design_Unit (Ent));
+ Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch));
+
+ -- Elaborate generic + map aspect for the entity instance.
+ Sub_Inst := Make_Elab_Instance (Comp_Inst, Arch, Sub_Config);
+ Create_Component_Instance (Comp_Inst, Sub_Inst);
+
+ Elab_Generics_Association (Sub_Inst, Comp_Inst,
+ Get_Generic_Chain (Ent),
+ Get_Generic_Map_Aspect_Chain (Bind));
+
+ Elab_Ports_Association_Type (Sub_Inst, Comp_Inst,
+ Get_Port_Chain (Ent),
+ Get_Port_Map_Aspect_Chain (Bind));
+
+ -- Recurse.
+ -- TODO: factorize with direct instantiation
+ Elab_Instance_Body (Sub_Inst, Ent, Arch, Sub_Config);
+ end Elab_Component_Instantiation_Statement;
+
+ procedure Elab_Design_Instantiation_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
+ is
+ Aspect : constant Iir := Get_Instantiated_Unit (Stmt);
+ Arch : Node;
+ Ent : Node;
+ Config : Node;
+ begin
+ -- Load configured entity + architecture
+ case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is
+ when Iir_Kind_Entity_Aspect_Entity =>
+ Arch := Get_Architecture (Aspect);
+ if Arch = Null_Node then
+ Arch := Libraries.Get_Latest_Architecture (Get_Entity (Aspect));
+ else
+ Arch := Strip_Denoting_Name (Arch);
+ end if;
+ Config := Get_Library_Unit
+ (Get_Default_Configuration_Declaration (Arch));
+ when Iir_Kind_Entity_Aspect_Configuration =>
+ Config := Get_Configuration (Aspect);
+ Arch := Get_Block_Specification (Get_Block_Configuration (Config));
+ when Iir_Kind_Entity_Aspect_Open =>
+ return;
+ end case;
+ Config := Get_Block_Configuration (Config);
+ Ent := Get_Entity (Arch);
+
+ Elab_Direct_Instantiation_Statement
+ (Syn_Inst, Stmt, Ent, Arch, Config);
+ end Elab_Design_Instantiation_Statement;
+
+ function Elab_Top_Unit (Config : Node) return Synth_Instance_Acc
+ is
+ Arch : Node;
+ Entity : Node;
+ Inter : Node;
+ Top_Inst : Synth_Instance_Acc;
+ begin
+ Arch := Get_Named_Entity
+ (Get_Block_Specification (Get_Block_Configuration (Config)));
+ Entity := Get_Entity (Arch);
+
+ -- Annotate units.
+ Vhdl.Annotations.Flag_Synthesis := True;
+ Vhdl.Annotations.Initialize_Annotate;
+ Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit);
+ for I in Design_Units.First .. Design_Units.Last loop
+ Vhdl.Annotations.Annotate (Design_Units.Table (I));
+ end loop;
+
+ Elab.Vhdl_Objtypes.Init;
+
+ -- Start elaboration.
+ Make_Root_Instance;
+
+ Top_Inst := Make_Elab_Instance (Root_Instance, Arch, Null_Node);
+
+ -- Save the current architecture, so that files can be open using a
+ -- path relative to the architecture filename.
+ Elab.Vhdl_Files.Set_Design_Unit (Arch);
+
+ Elab_Dependencies (Root_Instance, Get_Design_Unit (Entity));
+ Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch));
+
+ -- Compute generics.
+ Inter := Get_Generic_Chain (Entity);
+ while Is_Valid (Inter) loop
+ Elab_Declaration_Type (Top_Inst, Inter);
+ declare
+ Val : Valtyp;
+ Inter_Typ : Type_Acc;
+ begin
+ Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter));
+ Val := Exec_Expression_With_Type
+ (Top_Inst, Get_Default_Value (Inter), Inter_Typ);
+ pragma Assert (Is_Static (Val.Val));
+ Create_Object (Top_Inst, Inter, Val);
+ end;
+ Inter := Get_Chain (Inter);
+ end loop;
+
+ -- Elaborate port types.
+ -- FIXME: what about unconstrained ports ? Get the type from the
+ -- association.
+ Inter := Get_Port_Chain (Entity);
+ while Is_Valid (Inter) loop
+ if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
+ -- TODO
+ raise Internal_Error;
+ end if;
+ declare
+ Inter_Typ : Type_Acc;
+ begin
+ Elab_Declaration_Type (Top_Inst, Inter);
+ Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter));
+ Create_Signal (Top_Inst, Inter, Inter_Typ, null);
+ end;
+ Inter := Get_Chain (Inter);
+ end loop;
+
+ Elab_Instance_Body
+ (Top_Inst, Entity, Arch, Get_Block_Configuration (Config));
+
+ -- Clear elab_flag
+ for I in Design_Units.First .. Design_Units.Last loop
+ Set_Elab_Flag (Design_Units.Table (I), False);
+ end loop;
+
+ return Top_Inst;
+ end Elab_Top_Unit;
+
+end Elab.Vhdl_Insts;
diff --git a/src/synth/elab-vhdl_insts.ads b/src/synth/elab-vhdl_insts.ads
new file mode 100644
index 000000000..3c34fa4ed
--- /dev/null
+++ b/src/synth/elab-vhdl_insts.ads
@@ -0,0 +1,36 @@
+-- Design elaboration
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
+package Elab.Vhdl_Insts is
+ function Elab_Top_Unit (Config : Node) return Synth_Instance_Acc;
+
+ procedure Elab_Component_Instantiation_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node);
+ procedure Elab_Design_Instantiation_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node);
+
+ -- Apply block configuration CFG to BLK.
+ -- Must be done before synthesis of BLK.
+ -- The synthesis of BLK will clear all configuration of it.
+ procedure Apply_Block_Configuration (Cfg : Node; Blk : Node);
+
+end Elab.Vhdl_Insts;
diff --git a/src/synth/synth-objtypes.adb b/src/synth/elab-vhdl_objtypes.adb
index 036c4151d..da223b4a2 100644
--- a/src/synth/synth-objtypes.adb
+++ b/src/synth/elab-vhdl_objtypes.adb
@@ -21,7 +21,7 @@ with System; use System;
with Mutils; use Mutils;
-package body Synth.Objtypes is
+package body Elab.Vhdl_Objtypes is
function To_Bound_Array_Acc is new Ada.Unchecked_Conversion
(System.Address, Bound_Array_Acc);
@@ -117,10 +117,10 @@ package body Synth.Objtypes is
end case;
end Are_Types_Equal;
- function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width
+ function Discrete_Range_Width (Rng : Discrete_Range_Type) return Uns32
is
Lo, Hi : Int64;
- W : Width;
+ W : Uns32;
begin
case Rng.Dir is
when Dir_To =>
@@ -135,19 +135,19 @@ package body Synth.Objtypes is
W := 0;
elsif Lo >= 0 then
-- Positive.
- W := Width (Clog2 (Uns64 (Hi) + 1));
+ W := Uns32 (Clog2 (Uns64 (Hi) + 1));
elsif Lo = Int64'First then
-- Handle possible overflow.
W := 64;
elsif Hi < 0 then
-- Negative only.
- W := Width (Clog2 (Uns64 (-Lo))) + 1;
+ W := Uns32 (Clog2 (Uns64 (-Lo))) + 1;
else
declare
- Wl : constant Width := Width (Clog2 (Uns64 (-Lo)));
- Wh : constant Width := Width (Clog2 (Uns64 (Hi) + 1));
+ Wl : constant Uns32 := Uns32 (Clog2 (Uns64 (-Lo)));
+ Wh : constant Uns32 := Uns32 (Clog2 (Uns64 (Hi) + 1));
begin
- W := Width'Max (Wl, Wh) + 1;
+ W := Uns32'Max (Wl, Wh) + 1;
end;
end if;
return W;
@@ -173,6 +173,15 @@ package body Synth.Objtypes is
end case;
end In_Range;
+ function Build_Discrete_Range_Type
+ (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type is
+ begin
+ return (Dir => Dir,
+ Left => L,
+ Right => R,
+ Is_Signed => L < 0 or R < 0);
+ end Build_Discrete_Range_Type;
+
function Create_Bit_Type return Type_Acc
is
subtype Bit_Type_Type is Type_Type (Type_Bit);
@@ -199,7 +208,7 @@ package body Synth.Objtypes is
function Create_Discrete_Type (Rng : Discrete_Range_Type;
Sz : Size_Type;
- W : Width)
+ W : Uns32)
return Type_Acc
is
subtype Discrete_Type_Type is Type_Type (Type_Discrete);
@@ -266,7 +275,7 @@ package body Synth.Objtypes is
Slice_El => El_Type)));
end Create_Slice_Type;
- function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc)
+ function Create_Vec_Type_By_Length (Len : Uns32; El : Type_Acc)
return Type_Acc is
begin
return Create_Vector_Type ((Dir => Dir_Downto,
@@ -433,13 +442,12 @@ package body Synth.Objtypes is
return (Off + Mask) and not Mask;
end Align;
- function Create_Record_Type (Els : Rec_El_Array_Acc)
- return Type_Acc
+ function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc
is
subtype Record_Type_Type is Type_Type (Type_Record);
function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type);
Is_Synth : Boolean;
- W : Width;
+ W : Uns32;
Al : Palign_Type;
Sz : Size_Type;
begin
@@ -539,7 +547,7 @@ package body Synth.Objtypes is
return Iir_Index32 (Typ.Vbound.Len);
when Type_Array =>
declare
- Len : Width;
+ Len : Uns32;
begin
Len := 1;
for I in Typ.Abounds.D'Range loop
@@ -552,13 +560,13 @@ package body Synth.Objtypes is
end case;
end Get_Array_Flat_Length;
- function Get_Type_Width (Atype : Type_Acc) return Width is
+ function Get_Type_Width (Atype : Type_Acc) return Uns32 is
begin
pragma Assert (Atype.Kind /= Type_Unbounded_Array);
return Atype.W;
end Get_Type_Width;
- function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width is
+ function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32 is
begin
case T.Kind is
when Type_Vector =>
@@ -773,4 +781,4 @@ package body Synth.Objtypes is
Bit0 := (Bit_Type, To_Memory_Ptr (Bit0_Mem'Address));
Bit1 := (Bit_Type, To_Memory_Ptr (Bit1_Mem'Address));
end Init;
-end Synth.Objtypes;
+end Elab.Vhdl_Objtypes;
diff --git a/src/synth/synth-objtypes.ads b/src/synth/elab-vhdl_objtypes.ads
index 91c26327e..46f088dfd 100644
--- a/src/synth/synth-objtypes.ads
+++ b/src/synth/elab-vhdl_objtypes.ads
@@ -19,15 +19,13 @@
with Types; use Types;
with Areapools; use Areapools;
-with Netlists; use Netlists;
-
with Grt.Types; use Grt.Types;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
with Vhdl.Nodes; use Vhdl.Nodes;
-package Synth.Objtypes is
+package Elab.Vhdl_Objtypes is
type Discrete_Range_Type is record
-- An integer range.
Dir : Direction_Type;
@@ -40,7 +38,10 @@ package Synth.Objtypes is
end record;
-- Return the width of RNG.
- function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width;
+ function Discrete_Range_Width (Rng : Discrete_Range_Type) return Uns32;
+
+ function Build_Discrete_Range_Type
+ (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type;
type Float_Range_Type is record
Dir : Direction_Type;
@@ -52,7 +53,7 @@ package Synth.Objtypes is
Dir : Direction_Type;
Left : Int32;
Right : Int32;
- Len : Width;
+ Len : Uns32;
end record;
type Bound_Array_Type is array (Dim_Type range <>) of Bound_Type;
@@ -129,7 +130,7 @@ package Synth.Objtypes is
-- type with 1 element, a null vector, or a null array).
-- For non synthesizable types (like files or protected type), just
-- use 32.
- W : Width;
+ W : Uns32;
case Kind is
when Type_Bit
@@ -194,11 +195,11 @@ package Synth.Objtypes is
-- Types.
function Create_Discrete_Type (Rng : Discrete_Range_Type;
Sz : Size_Type;
- W : Width)
+ W : Uns32)
return Type_Acc;
function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc;
- function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc)
+ function Create_Vec_Type_By_Length (Len : Uns32; El : Type_Acc)
return Type_Acc;
function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc)
return Type_Acc;
@@ -247,11 +248,11 @@ package Synth.Objtypes is
function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32;
-- Return length of dimension DIM of type T.
- function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width;
+ function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32;
function Is_Matching_Bounds (L, R : Type_Acc) return Boolean;
- function Get_Type_Width (Atype : Type_Acc) return Width;
+ function Get_Type_Width (Atype : Type_Acc) return Uns32;
-- Low-level functions
@@ -293,4 +294,4 @@ package Synth.Objtypes is
-- Also set by init.
Bit0 : Memtyp;
Bit1 : Memtyp;
-end Synth.Objtypes;
+end Elab.Vhdl_Objtypes;
diff --git a/src/synth/elab-vhdl_stmts.adb b/src/synth/elab-vhdl_stmts.adb
new file mode 100644
index 000000000..d3667b0e4
--- /dev/null
+++ b/src/synth/elab-vhdl_stmts.adb
@@ -0,0 +1,231 @@
+-- Elaborate statements
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+
+with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils; use Vhdl.Utils;
+
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Decls; use Elab.Vhdl_Decls;
+with Elab.Vhdl_Insts; use Elab.Vhdl_Insts;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
+
+package body Elab.Vhdl_Stmts is
+ function Elab_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc;
+ Bod : Node;
+ Config : Node;
+ Iterator : Node := Null_Node;
+ Iterator_Val : Valtyp := No_Valtyp)
+ return Synth_Instance_Acc
+ is
+ Decls_Chain : constant Node := Get_Declaration_Chain (Bod);
+ Bod_Inst : Synth_Instance_Acc;
+ begin
+ Bod_Inst := Make_Elab_Instance (Syn_Inst, Bod, Config);
+
+ if Iterator /= Null_Node then
+ -- Add the iterator (for for-generate).
+ Create_Object (Bod_Inst, Iterator, Iterator_Val);
+ end if;
+
+ Elab_Declarations (Bod_Inst, Decls_Chain);
+
+ Elab_Concurrent_Statements
+ (Bod_Inst, Get_Concurrent_Statement_Chain (Bod));
+
+ return Bod_Inst;
+ end Elab_Generate_Statement_Body;
+
+ procedure Elab_For_Generate_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
+ is
+ Iterator : constant Node := Get_Parameter_Specification (Stmt);
+ Bod : constant Node := Get_Generate_Statement_Body (Stmt);
+ Configs : constant Node := Get_Generate_Block_Configuration (Bod);
+ It_Type : constant Node := Get_Declaration_Type (Iterator);
+ Gen_Inst : Synth_Instance_Acc;
+ Sub_Inst : Synth_Instance_Acc;
+ Config : Node;
+ It_Rng : Type_Acc;
+ Val : Valtyp;
+ Ival : Valtyp;
+ Len : Uns32;
+ begin
+ if It_Type /= Null_Node then
+ Synth_Subtype_Indication (Syn_Inst, It_Type);
+ end if;
+
+ -- Initial value.
+ It_Rng := Get_Subtype_Object (Syn_Inst, Get_Type (Iterator));
+ Len := Get_Range_Length (It_Rng.Drange);
+ Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng);
+
+ Gen_Inst := Make_Elab_Generate_Instance
+ (Syn_Inst, Stmt, Configs, Natural (Len));
+
+ Create_Sub_Instance (Syn_Inst, Stmt, Gen_Inst);
+
+ for I in 1 .. Len loop
+ -- Find and apply the config block.
+ declare
+ Spec : Node;
+ begin
+ Config := Configs;
+ while Config /= Null_Node loop
+ Spec := Get_Block_Specification (Config);
+ case Get_Kind (Spec) is
+ when Iir_Kind_Simple_Name =>
+ exit;
+ when others =>
+ Error_Kind ("elab_for_generate_statement", Spec);
+ end case;
+ Config := Get_Prev_Block_Configuration (Config);
+ end loop;
+ Apply_Block_Configuration (Config, Bod);
+ end;
+
+ -- Create a copy of the current iterator value for the generate
+ -- block.
+ Ival := Create_Value_Discrete (Read_Discrete (Val), It_Rng);
+
+ Sub_Inst := Elab_Generate_Statement_Body
+ (Syn_Inst, Bod, Config, Iterator, Ival);
+ Set_Generate_Sub_Instance (Gen_Inst, Positive (I), Sub_Inst);
+
+ Update_Index (It_Rng.Drange, Val);
+ end loop;
+ end Elab_For_Generate_Statement;
+
+ procedure Elab_If_Generate_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
+ is
+ Gen : Node;
+ Bod : Node;
+ Icond : Node;
+ Cond : Valtyp;
+ Config : Node;
+ Sub_Inst : Synth_Instance_Acc;
+ begin
+ Gen := Stmt;
+
+ loop
+ Icond := Get_Condition (Gen);
+ if Icond /= Null_Node then
+ Cond := Exec_Expression (Syn_Inst, Icond);
+ Strip_Const (Cond);
+ else
+ -- It is the else generate.
+ Cond := No_Valtyp;
+ end if;
+ if Cond = No_Valtyp or else Read_Discrete (Cond) = 1 then
+ Bod := Get_Generate_Statement_Body (Gen);
+ Config := Get_Generate_Block_Configuration (Bod);
+
+ Apply_Block_Configuration (Config, Bod);
+ Sub_Inst := Elab_Generate_Statement_Body (Syn_Inst, Bod, Config);
+ Create_Sub_Instance (Syn_Inst, Bod, Sub_Inst);
+ return;
+ end if;
+ Gen := Get_Generate_Else_Clause (Gen);
+ exit when Gen = Null_Node;
+ end loop;
+
+ -- Not generated.
+ Create_Sub_Instance (Syn_Inst, Stmt, null);
+ end Elab_If_Generate_Statement;
+
+ procedure Elab_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node)
+ is
+ Blk_Inst : Synth_Instance_Acc;
+ begin
+ -- No support for guard or header.
+ if Get_Block_Header (Blk) /= Null_Node
+ or else Get_Guard_Decl (Blk) /= Null_Node
+ then
+ raise Internal_Error;
+ end if;
+
+ Apply_Block_Configuration
+ (Get_Block_Block_Configuration (Blk), Blk);
+
+ Blk_Inst := Make_Elab_Instance (Syn_Inst, Blk, Null_Iir);
+ Create_Sub_Instance (Syn_Inst, Blk, Blk_Inst);
+
+ Elab_Declarations (Blk_Inst, Get_Declaration_Chain (Blk));
+ Elab_Concurrent_Statements
+ (Blk_Inst, Get_Concurrent_Statement_Chain (Blk));
+ end Elab_Block_Statement;
+
+ procedure Elab_Concurrent_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is
+ begin
+ case Get_Kind (Stmt) is
+ when Iir_Kinds_Process_Statement =>
+ null;
+ when Iir_Kind_Concurrent_Simple_Signal_Assignment
+ | Iir_Kind_Concurrent_Selected_Signal_Assignment
+ | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+ | Iir_Kind_Concurrent_Assertion_Statement
+ | Iir_Kind_Concurrent_Procedure_Call_Statement
+ | Iir_Kind_Psl_Default_Clock
+ | Iir_Kind_Psl_Restrict_Directive
+ | Iir_Kind_Psl_Assume_Directive
+ | Iir_Kind_Psl_Assert_Directive
+ | Iir_Kind_Psl_Cover_Directive
+ | Iir_Kind_Psl_Declaration =>
+ null;
+ when Iir_Kind_Component_Instantiation_Statement =>
+ if Is_Component_Instantiation (Stmt) then
+ Elab_Component_Instantiation_Statement (Syn_Inst, Stmt);
+ else
+ Elab_Design_Instantiation_Statement (Syn_Inst, Stmt);
+ end if;
+
+ when Iir_Kind_For_Generate_Statement =>
+ Elab_For_Generate_Statement (Syn_Inst, Stmt);
+
+ when Iir_Kind_If_Generate_Statement =>
+ Elab_If_Generate_Statement (Syn_Inst, Stmt);
+
+ when Iir_Kind_Block_Statement =>
+ Elab_Block_Statement (Syn_Inst, Stmt);
+
+ when others =>
+ Error_Kind ("elab_concurrent_statement", Stmt);
+ end case;
+ end Elab_Concurrent_Statement;
+
+ procedure Elab_Concurrent_Statements
+ (Syn_Inst : Synth_Instance_Acc; Chain : Node)
+ is
+ Stmt : Node;
+ begin
+ if Chain = Null_Node then
+ return;
+ end if;
+
+ Stmt := Chain;
+ while Stmt /= Null_Node loop
+ Elab_Concurrent_Statement (Syn_Inst, Stmt);
+ Stmt := Get_Chain (Stmt);
+ end loop;
+ end Elab_Concurrent_Statements;
+end Elab.Vhdl_Stmts;
diff --git a/src/synth/elab-vhdl_stmts.ads b/src/synth/elab-vhdl_stmts.ads
new file mode 100644
index 000000000..4678b092a
--- /dev/null
+++ b/src/synth/elab-vhdl_stmts.ads
@@ -0,0 +1,29 @@
+-- Elaborate statements
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
+package Elab.Vhdl_Stmts is
+ procedure Elab_Concurrent_Statement
+ (Syn_Inst : Synth_Instance_Acc; Stmt : Node);
+
+ procedure Elab_Concurrent_Statements
+ (Syn_Inst : Synth_Instance_Acc; Chain : Node);
+end Elab.Vhdl_Stmts;
diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb
new file mode 100644
index 000000000..1238bec39
--- /dev/null
+++ b/src/synth/elab-vhdl_types.adb
@@ -0,0 +1,562 @@
+-- Create declarations for synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+with Mutils; use Mutils;
+
+with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Std_Package;
+with Vhdl.Ieee.Std_Logic_1164;
+with Vhdl.Evaluation;
+with Vhdl.Errors; use Vhdl.Errors;
+
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
+with Elab.Vhdl_Decls;
+with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;
+
+package body Elab.Vhdl_Types is
+ function Synth_Discrete_Range_Expression
+ (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type
+ is
+ L, R : Valtyp;
+ Lval, Rval : Int64;
+ begin
+ -- Static values.
+ L := Exec_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng));
+ R := Exec_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng));
+ Strip_Const (L);
+ Strip_Const (R);
+
+ if not (Is_Static (L.Val) and Is_Static (R.Val)) then
+ Error_Msg_Elab (+Rng, "limits of range are not constant");
+ Set_Error (Syn_Inst);
+ return (Dir => Get_Direction (Rng),
+ Left => 0,
+ Right => 0,
+ Is_Signed => False);
+ end if;
+
+ Lval := Read_Discrete (L);
+ Rval := Read_Discrete (R);
+ return Build_Discrete_Range_Type (Lval, Rval, Get_Direction (Rng));
+ end Synth_Discrete_Range_Expression;
+
+ function Synth_Float_Range_Expression
+ (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type
+ is
+ L, R : Valtyp;
+ begin
+ -- Static values (so no enable).
+ L := Exec_Expression (Syn_Inst, Get_Left_Limit (Rng));
+ R := Exec_Expression (Syn_Inst, Get_Right_Limit (Rng));
+ return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R));
+ end Synth_Float_Range_Expression;
+
+ function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
+ return Bound_Type
+ is
+ Prefix_Name : constant Iir := Get_Prefix (Attr);
+ Prefix : constant Iir := Strip_Denoting_Name (Prefix_Name);
+ Dim : constant Natural :=
+ Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr);
+ Typ : Type_Acc;
+ Val : Valtyp;
+ begin
+ -- Prefix is an array object or an array subtype.
+ if Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration then
+ -- TODO: does this cover all the cases ?
+ Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix));
+ else
+ Val := Exec_Name (Syn_Inst, Prefix_Name);
+ Typ := Val.Typ;
+ end if;
+
+ return Get_Array_Bound (Typ, Dim_Type (Dim));
+ end Synth_Array_Attribute;
+
+ procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
+ Bound : Node;
+ Rng : out Discrete_Range_Type) is
+ begin
+ case Get_Kind (Bound) is
+ when Iir_Kind_Range_Expression =>
+ Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound);
+ when Iir_Kind_Integer_Subtype_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition =>
+ if Get_Type_Declarator (Bound) /= Null_Node then
+ declare
+ Typ : Type_Acc;
+ begin
+ -- This is a named subtype, so it has been evaluated.
+ Typ := Get_Subtype_Object (Syn_Inst, Bound);
+ Rng := Typ.Drange;
+ end;
+ else
+ Synth_Discrete_Range
+ (Syn_Inst, Get_Range_Constraint (Bound), Rng);
+ end if;
+ when Iir_Kind_Range_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Bound);
+ Rng := Build_Discrete_Range_Type
+ (Int64 (B.Left), Int64 (B.Right), B.Dir);
+ end;
+ when Iir_Kind_Reverse_Range_Array_Attribute =>
+ declare
+ B : Bound_Type;
+ T : Int32;
+ begin
+ B := Synth_Array_Attribute (Syn_Inst, Bound);
+ -- Reverse
+ case B.Dir is
+ when Dir_To =>
+ B.Dir := Dir_Downto;
+ when Dir_Downto =>
+ B.Dir := Dir_To;
+ end case;
+ T := B.Right;
+ B.Right := B.Left;
+ B.Left := T;
+
+ Rng := Build_Discrete_Range_Type
+ (Int64 (B.Left), Int64 (B.Right), B.Dir);
+ end;
+ when Iir_Kinds_Denoting_Name =>
+ -- A discrete subtype name.
+ Synth_Discrete_Range
+ (Syn_Inst, Get_Subtype_Indication (Get_Named_Entity (Bound)),
+ Rng);
+ when others =>
+ Error_Kind ("synth_discrete_range", Bound);
+ end case;
+ end Synth_Discrete_Range;
+
+ function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc;
+ Atype : Node) return Bound_Type
+ is
+ Rng : Discrete_Range_Type;
+ begin
+ Synth_Discrete_Range (Syn_Inst, Atype, Rng);
+ return (Dir => Rng.Dir,
+ Left => Int32 (Rng.Left), Right => Int32 (Rng.Right),
+ Len => Get_Range_Length (Rng));
+ end Synth_Bounds_From_Range;
+
+ procedure Synth_Subtype_Indication_If_Anonymous
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node) is
+ begin
+ if Get_Type_Declarator (Atype) = Null_Node then
+ Synth_Subtype_Indication (Syn_Inst, Atype);
+ end if;
+ end Synth_Subtype_Indication_If_Anonymous;
+
+ function Synth_Subtype_Indication_If_Anonymous
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is
+ begin
+ if Get_Type_Declarator (Atype) = Null_Node then
+ return Synth_Subtype_Indication (Syn_Inst, Atype);
+ else
+ return Get_Subtype_Object (Syn_Inst, Atype);
+ end if;
+ end Synth_Subtype_Indication_If_Anonymous;
+
+ function Synth_Array_Type_Definition
+ (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
+ is
+ El_Type : constant Node := Get_Element_Subtype (Def);
+ Ndims : constant Natural := Get_Nbr_Dimensions (Def);
+ El_Typ : Type_Acc;
+ Typ : Type_Acc;
+ begin
+ Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type);
+ El_Typ := Get_Subtype_Object (Syn_Inst, El_Type);
+
+ if El_Typ.Kind in Type_Nets and then Ndims = 1 then
+ Typ := Create_Unbounded_Vector (El_Typ);
+ else
+ Typ := Create_Unbounded_Array (Dim_Type (Ndims), El_Typ);
+ end if;
+ return Typ;
+ end Synth_Array_Type_Definition;
+
+ function Synth_Record_Type_Definition
+ (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
+ is
+ El_List : constant Node_Flist := Get_Elements_Declaration_List (Def);
+ Rec_Els : Rec_El_Array_Acc;
+ El : Node;
+ El_Type : Node;
+ El_Typ : Type_Acc;
+ begin
+ Rec_Els := Create_Rec_El_Array
+ (Iir_Index32 (Get_Nbr_Elements (El_List)));
+
+ for I in Flist_First .. Flist_Last (El_List) loop
+ El := Get_Nth_Element (El_List, I);
+ El_Type := Get_Type (El);
+ El_Typ := Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type);
+ Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ;
+ end loop;
+
+ if not Is_Fully_Constrained_Type (Def) then
+ return Create_Unbounded_Record (Rec_Els);
+ else
+ return Create_Record_Type (Rec_Els);
+ end if;
+ end Synth_Record_Type_Definition;
+
+ function Synth_Access_Type_Definition
+ (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
+ is
+ Des_Type : constant Node := Get_Designated_Type (Def);
+ Des_Typ : Type_Acc;
+ Typ : Type_Acc;
+ begin
+ Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type);
+ Des_Typ := Get_Subtype_Object (Syn_Inst, Des_Type);
+
+ Typ := Create_Access_Type (Des_Typ);
+ return Typ;
+ end Synth_Access_Type_Definition;
+
+ function Synth_File_Type_Definition
+ (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
+ is
+ File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def));
+ File_Typ : Type_Acc;
+ Typ : Type_Acc;
+ Sig : String_Acc;
+ begin
+ File_Typ := Get_Subtype_Object (Syn_Inst, File_Type);
+
+ if Get_Text_File_Flag (Def)
+ or else
+ Get_Kind (File_Type) in Iir_Kinds_Scalar_Type_And_Subtype_Definition
+ then
+ Sig := null;
+ else
+ declare
+ Sig_Str : String (1 .. Get_File_Signature_Length (File_Type) + 2);
+ Off : Natural := Sig_Str'First;
+ begin
+ Get_File_Signature (File_Type, Sig_Str, Off);
+ Sig_Str (Off + 0) := '.';
+ Sig_Str (Off + 1) := ASCII.NUL;
+ Sig := new String'(Sig_Str);
+ end;
+ end if;
+
+ Typ := Create_File_Type (File_Typ);
+ Typ.File_Signature := Sig;
+
+ return Typ;
+ end Synth_File_Type_Definition;
+
+ function Scalar_Size_To_Size (Def : Node) return Size_Type is
+ begin
+ case Get_Scalar_Size (Def) is
+ when Scalar_8 =>
+ return 1;
+ when Scalar_16 =>
+ return 2;
+ when Scalar_32 =>
+ return 4;
+ when Scalar_64 =>
+ return 8;
+ end case;
+ end Scalar_Size_To_Size;
+
+ procedure Elab_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
+ is
+ Typ : Type_Acc;
+ begin
+ case Get_Kind (Def) is
+ when Iir_Kind_Enumeration_Type_Definition =>
+ if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type
+ or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
+ then
+ Typ := Logic_Type;
+ elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then
+ Typ := Boolean_Type;
+ elsif Def = Vhdl.Std_Package.Bit_Type_Definition then
+ Typ := Bit_Type;
+ else
+ declare
+ Nbr_El : constant Natural :=
+ Get_Nbr_Elements (Get_Enumeration_Literal_List (Def));
+ Rng : Discrete_Range_Type;
+ W : Uns32;
+ begin
+ W := Uns32 (Clog2 (Uns64 (Nbr_El)));
+ Rng := (Dir => Dir_To,
+ Is_Signed => False,
+ Left => 0,
+ Right => Int64 (Nbr_El - 1));
+ Typ := Create_Discrete_Type
+ (Rng, Scalar_Size_To_Size (Def), W);
+ end;
+ end if;
+ when Iir_Kind_Array_Type_Definition =>
+ Typ := Synth_Array_Type_Definition (Syn_Inst, Def);
+ when Iir_Kind_Access_Type_Definition =>
+ Typ := Synth_Access_Type_Definition (Syn_Inst, Def);
+ when Iir_Kind_File_Type_Definition =>
+ Typ := Synth_File_Type_Definition (Syn_Inst, Def);
+ when Iir_Kind_Record_Type_Definition =>
+ Typ := Synth_Record_Type_Definition (Syn_Inst, Def);
+ when Iir_Kind_Protected_Type_Declaration =>
+ -- TODO...
+ Elab.Vhdl_Decls.Elab_Declarations
+ (Syn_Inst, Get_Declaration_Chain (Def));
+ when others =>
+ Vhdl.Errors.Error_Kind ("synth_type_definition", Def);
+ end case;
+ if Typ /= null then
+ Create_Subtype_Object (Syn_Inst, Def, Typ);
+ end if;
+ end Elab_Type_Definition;
+
+ procedure Elab_Anonymous_Type_Definition
+ (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node)
+ is
+ Typ : Type_Acc;
+ begin
+ case Get_Kind (Def) is
+ when Iir_Kind_Integer_Type_Definition
+ | Iir_Kind_Physical_Type_Definition =>
+ declare
+ Cst : constant Node := Get_Range_Constraint (St);
+ L, R : Int64;
+ Rng : Discrete_Range_Type;
+ W : Uns32;
+ begin
+ L := Get_Value (Get_Left_Limit (Cst));
+ R := Get_Value (Get_Right_Limit (Cst));
+ Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst));
+ W := Discrete_Range_Width (Rng);
+ Typ := Create_Discrete_Type
+ (Rng, Scalar_Size_To_Size (Def), W);
+ end;
+ when Iir_Kind_Floating_Type_Definition =>
+ declare
+ Cst : constant Node := Get_Range_Constraint (St);
+ L, R : Fp64;
+ Rng : Float_Range_Type;
+ begin
+ L := Get_Fp_Value (Get_Left_Limit (Cst));
+ R := Get_Fp_Value (Get_Right_Limit (Cst));
+ Rng := (Get_Direction (Cst), L, R);
+ Typ := Create_Float_Type (Rng);
+ end;
+ when Iir_Kind_Array_Type_Definition =>
+ Typ := Synth_Array_Type_Definition (Syn_Inst, Def);
+ when others =>
+ Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def);
+ end case;
+ Create_Subtype_Object (Syn_Inst, Def, Typ);
+ end Elab_Anonymous_Type_Definition;
+
+ function Synth_Discrete_Range_Constraint
+ (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type
+ is
+ Res : Discrete_Range_Type;
+ begin
+ Synth_Discrete_Range (Syn_Inst, Rng, Res);
+ return Res;
+ end Synth_Discrete_Range_Constraint;
+
+ function Synth_Float_Range_Constraint
+ (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is
+ begin
+ case Get_Kind (Rng) is
+ when Iir_Kind_Range_Expression =>
+ -- FIXME: check range.
+ return Synth_Float_Range_Expression (Syn_Inst, Rng);
+ when others =>
+ Vhdl.Errors.Error_Kind ("synth_float_range_constraint", Rng);
+ end case;
+ end Synth_Float_Range_Constraint;
+
+ function Has_Element_Subtype_Indication (Atype : Node) return Boolean is
+ begin
+ return Get_Array_Element_Constraint (Atype) /= Null_Node
+ or else
+ (Get_Resolution_Indication (Atype) /= Null_Node
+ and then
+ (Get_Kind (Get_Resolution_Indication (Atype))
+ = Iir_Kind_Array_Element_Resolution));
+ end Has_Element_Subtype_Indication;
+
+ function Synth_Array_Subtype_Indication
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc
+ is
+ El_Type : constant Node := Get_Element_Subtype (Atype);
+ St_Indexes : constant Node_Flist := Get_Index_Subtype_List (Atype);
+ Ptype : Node;
+ St_El : Node;
+ Btyp : Type_Acc;
+ Etyp : Type_Acc;
+ Bnds : Bound_Array_Acc;
+ begin
+ -- VHDL08
+ if Has_Element_Subtype_Indication (Atype) then
+ -- This subtype has created a new anonymous subtype for the
+ -- element.
+ Synth_Subtype_Indication (Syn_Inst, El_Type);
+ end if;
+
+ if not Get_Index_Constraint_Flag (Atype) then
+ Ptype := Get_Type (Get_Subtype_Type_Mark (Atype));
+ if Get_Element_Subtype (Ptype) = Get_Element_Subtype (Atype) then
+ -- That's an alias.
+ -- FIXME: maybe a resolution function was added?
+ -- FIXME: also handle resolution added in element subtype.
+ return Get_Subtype_Object (Syn_Inst, Ptype);
+ end if;
+ end if;
+
+ Btyp := Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype));
+ case Btyp.Kind is
+ when Type_Unbounded_Vector =>
+ if Get_Index_Constraint_Flag (Atype) then
+ St_El := Get_Index_Type (St_Indexes, 0);
+ return Create_Vector_Type
+ (Synth_Bounds_From_Range (Syn_Inst, St_El), Btyp.Uvec_El);
+ else
+ -- An alias.
+ -- Handle vhdl08 definition of std_logic_vector from
+ -- std_ulogic_vector.
+ return Btyp;
+ end if;
+ when Type_Unbounded_Array =>
+ -- FIXME: partially constrained arrays, subtype in indexes...
+ Etyp := Get_Subtype_Object (Syn_Inst, El_Type);
+ if Get_Index_Constraint_Flag (Atype) then
+ Bnds := Create_Bound_Array
+ (Dim_Type (Get_Nbr_Elements (St_Indexes)));
+ for I in Flist_First .. Flist_Last (St_Indexes) loop
+ St_El := Get_Index_Type (St_Indexes, I);
+ Bnds.D (Dim_Type (I + 1)) :=
+ Synth_Bounds_From_Range (Syn_Inst, St_El);
+ end loop;
+ return Create_Array_Type (Bnds, Etyp);
+ else
+ raise Internal_Error;
+ end if;
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Synth_Array_Subtype_Indication;
+
+ function Synth_Subtype_Indication
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is
+ begin
+ -- TODO: handle aliases directly.
+ case Get_Kind (Atype) is
+ when Iir_Kind_Array_Subtype_Definition =>
+ return Synth_Array_Subtype_Indication (Syn_Inst, Atype);
+ when Iir_Kind_Record_Subtype_Definition =>
+ return Synth_Record_Type_Definition (Syn_Inst, Atype);
+ when Iir_Kind_Integer_Subtype_Definition
+ | Iir_Kind_Physical_Subtype_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition =>
+ declare
+ Btype : constant Type_Acc :=
+ Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype));
+ Rng : Discrete_Range_Type;
+ W : Uns32;
+ begin
+ if Btype.Kind in Type_Nets then
+ -- A subtype of a bit/logic type is still a bit/logic.
+ -- FIXME: bounds.
+ return Btype;
+ else
+ Rng := Synth_Discrete_Range_Constraint
+ (Syn_Inst, Get_Range_Constraint (Atype));
+ W := Discrete_Range_Width (Rng);
+ return Create_Discrete_Type (Rng, Btype.Sz, W);
+ end if;
+ end;
+ when Iir_Kind_Floating_Subtype_Definition =>
+ declare
+ Rng : Float_Range_Type;
+ begin
+ Rng := Synth_Float_Range_Constraint
+ (Syn_Inst, Get_Range_Constraint (Atype));
+ return Create_Float_Type (Rng);
+ end;
+ when others =>
+ Vhdl.Errors.Error_Kind ("synth_subtype_indication", Atype);
+ end case;
+ end Synth_Subtype_Indication;
+
+ procedure Synth_Subtype_Indication
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node)
+ is
+ Typ : Type_Acc;
+ begin
+ Typ := Synth_Subtype_Indication (Syn_Inst, Atype);
+ Create_Subtype_Object (Syn_Inst, Atype, Typ);
+ end Synth_Subtype_Indication;
+
+ function Get_Declaration_Type (Decl : Node) return Node
+ is
+ Ind : constant Node := Get_Subtype_Indication (Decl);
+ Atype : Node;
+ begin
+ if Get_Is_Ref (Decl) or else Ind = Null_Iir then
+ -- A secondary declaration in a list.
+ return Null_Node;
+ end if;
+ Atype := Ind;
+ loop
+ case Get_Kind (Atype) is
+ when Iir_Kinds_Denoting_Name =>
+ Atype := Get_Named_Entity (Atype);
+ when Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Type_Declaration =>
+ -- Type already declared, so already handled.
+ return Null_Node;
+ when Iir_Kind_Array_Subtype_Definition
+ | Iir_Kind_Record_Subtype_Definition
+ | Iir_Kind_Integer_Subtype_Definition
+ | Iir_Kind_Floating_Subtype_Definition
+ | Iir_Kind_Physical_Subtype_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition =>
+ return Atype;
+ when others =>
+ Vhdl.Errors.Error_Kind ("get_declaration_type", Atype);
+ end case;
+ end loop;
+ end Get_Declaration_Type;
+
+ procedure Elab_Declaration_Type
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+ is
+ Atype : constant Node := Get_Declaration_Type (Decl);
+ begin
+ if Atype = Null_Node then
+ -- Already elaborated.
+ return;
+ end if;
+ Synth_Subtype_Indication (Syn_Inst, Atype);
+ end Elab_Declaration_Type;
+end Elab.Vhdl_Types;
diff --git a/src/synth/elab-vhdl_types.ads b/src/synth/elab-vhdl_types.ads
new file mode 100644
index 000000000..30ee6e0ae
--- /dev/null
+++ b/src/synth/elab-vhdl_types.ads
@@ -0,0 +1,62 @@
+-- Create declarations for synthesis.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+
+package Elab.Vhdl_Types is
+ -- Get the type of DECL iff it is standalone (not an already existing
+ -- subtype).
+ function Get_Declaration_Type (Decl : Node) return Node;
+
+ -- True if the element subtype indication of ATYPE needs to be created.
+ function Has_Element_Subtype_Indication (Atype : Node) return Boolean;
+
+ function Synth_Discrete_Range_Expression
+ (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type;
+ function Synth_Float_Range_Expression
+ (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type;
+
+ function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
+ return Bound_Type;
+
+ procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
+ Bound : Node;
+ Rng : out Discrete_Range_Type);
+
+ function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc;
+ Atype : Node) return Bound_Type;
+
+ function Synth_Array_Subtype_Indication
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc;
+
+ procedure Synth_Subtype_Indication
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node);
+ function Synth_Subtype_Indication
+ (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc;
+
+ procedure Elab_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node);
+ procedure Elab_Anonymous_Type_Definition
+ (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node);
+
+ -- Elaborate the type of DECL.
+ procedure Elab_Declaration_Type
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node);
+end Elab.Vhdl_Types;
diff --git a/src/synth/synth-values-debug.adb b/src/synth/elab-vhdl_values-debug.adb
index a6f887f08..8792fe292 100644
--- a/src/synth/synth-values-debug.adb
+++ b/src/synth/elab-vhdl_values-debug.adb
@@ -21,9 +21,7 @@ with Utils_IO; use Utils_IO;
with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Debug;
-
-package body Synth.Values.Debug is
+package body Elab.Vhdl_Values.Debug is
procedure Put_Dir (Dir : Direction_Type) is
begin
case Dir is
@@ -41,7 +39,7 @@ package body Synth.Values.Debug is
Put_Dir (Bnd.Dir);
Put (' ');
Put_Int32 (Bnd.Right);
- Put (" [");
+ Put (" [l=");
Put_Uns32 (Bnd.Len);
Put (']');
end Debug_Bound;
@@ -55,8 +53,9 @@ package body Synth.Values.Debug is
when Type_Vector =>
Put ("vector (");
Debug_Bound (T.Vbound);
- Put (") of ");
+ Put (") of [");
Debug_Typ1 (T.Vec_El);
+ Put ("]");
when Type_Array =>
Put ("arr (");
for I in 1 .. T.Abounds.Ndim loop
@@ -105,7 +104,7 @@ package body Synth.Values.Debug is
Put (" sz=");
Put_Uns32 (Uns32 (T.Sz));
Put (" w=");
- Put_Uns32 (Uns32 (T.W));
+ Put_Uns32 (T.W);
end Debug_Typ1;
procedure Debug_Typ (T : Type_Acc) is
@@ -183,16 +182,27 @@ package body Synth.Values.Debug is
| Value_Const =>
Debug_Memtyp (Get_Memtyp (V));
when Value_Net =>
- Put_Line (" net");
+ Put ("net ");
+ Put_Uns32 (V.Val.N);
+ Put (' ');
+ Debug_Typ1 (V.Typ);
+ New_Line;
+ when Value_Signal =>
+ Put ("signal ");
+ Debug_Typ1 (V.Typ);
+ New_Line;
when Value_Wire =>
- Put (" wire");
- Put_Wire_Id (V.Val.W);
+ Put ("wire ");
+ Put_Uns32 (V.Val.N);
New_Line;
when Value_File =>
Put_Line ("a file");
when Value_Alias =>
- Put_Line ("an alias");
+ Put ("an alias: ");
+ Debug_Typ1 (V.Typ);
+ Put (" of ");
+ Debug_Valtyp ((V.Typ, V.Val.A_Obj));
end case;
end Debug_Valtyp;
-end Synth.Values.Debug;
+end Elab.Vhdl_Values.Debug;
diff --git a/src/synth/synth-values-debug.ads b/src/synth/elab-vhdl_values-debug.ads
index 38e7ce23d..6972a1b3e 100644
--- a/src/synth/synth-values-debug.ads
+++ b/src/synth/elab-vhdl_values-debug.ads
@@ -16,8 +16,8 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-package Synth.Values.Debug is
+package Elab.Vhdl_Values.Debug is
procedure Debug_Valtyp (V : Valtyp);
procedure Debug_Memtyp (M : Memtyp);
procedure Debug_Typ (T : Type_Acc);
-end Synth.Values.Debug;
+end Elab.Vhdl_Values.Debug;
diff --git a/src/synth/synth-values.adb b/src/synth/elab-vhdl_values.adb
index 6f89876b6..90e72f223 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/elab-vhdl_values.adb
@@ -21,9 +21,7 @@ with System;
with Grt.Types; use Grt.Types;
-with Vhdl.Nodes; use Vhdl.Nodes;
-
-package body Synth.Values is
+package body Elab.Vhdl_Values is
function To_Value_Acc is new Ada.Unchecked_Conversion
(System.Address, Value_Acc);
@@ -33,7 +31,8 @@ package body Synth.Values is
when Value_Memory =>
return True;
when Value_Net
- | Value_Wire =>
+ | Value_Wire
+ | Value_Signal =>
return False;
when Value_File =>
return True;
@@ -44,29 +43,6 @@ package body Synth.Values is
end case;
end Is_Static;
- function Is_Static_Val (Val : Value_Acc) return Boolean is
- begin
- case Val.Kind is
- when Value_Memory =>
- return True;
- when Value_Net =>
- return False;
- when Value_Wire =>
- if Get_Kind (Val.W) = Wire_Variable then
- return Is_Static_Wire (Val.W);
- else
- -- A signal does not have static values.
- return False;
- end if;
- when Value_File =>
- return True;
- when Value_Const =>
- return True;
- when Value_Alias =>
- return Is_Static_Val (Val.A_Obj);
- end case;
- end Is_Static_Val;
-
function Strip_Alias_Const (V : Value_Acc) return Value_Acc
is
Res : Value_Acc;
@@ -108,38 +84,34 @@ package body Synth.Values is
return (Mt.Typ, Res);
end Create_Value_Memtyp;
- function Create_Value_Wire (W : Wire_Id) return Value_Acc
+ function Create_Value_Wire (S : Uns32) return Value_Acc
is
- subtype Value_Type_Wire is Value_Type (Values.Value_Wire);
+ subtype Value_Type_Wire is Value_Type (Value_Wire);
function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Wire);
begin
- return To_Value_Acc (Alloc (Current_Pool,
- (Kind => Value_Wire,
- W => W)));
- end Create_Value_Wire;
-
- function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp
- is
- pragma Assert (Wtype /= null);
- begin
- return (Wtype, Create_Value_Wire (W));
+ return To_Value_Acc
+ (Alloc (Current_Pool, (Kind => Value_Wire, N => S)));
end Create_Value_Wire;
- function Create_Value_Net (N : Net) return Value_Acc
+ function Create_Value_Net (S : Uns32) return Value_Acc
is
subtype Value_Type_Net is Value_Type (Value_Net);
function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Net);
begin
return To_Value_Acc
- (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => N)));
+ (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => S)));
end Create_Value_Net;
- function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp
+ function Create_Value_Signal (S : Uns32; Init : Value_Acc) return Value_Acc
is
- pragma Assert (Ntype /= null);
+ subtype Value_Type_Signal is Value_Type (Value_Signal);
+ function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Signal);
begin
- return (Ntype, Create_Value_Net (N));
- end Create_Value_Net;
+ return To_Value_Acc
+ (Alloc (Current_Pool, Value_Type_Signal'(Kind => Value_Signal,
+ S => S,
+ Init => Init)));
+ end Create_Value_Signal;
function Create_Value_Memory (Vtype : Type_Acc) return Valtyp
is
@@ -201,7 +173,7 @@ package body Synth.Values is
return Iir_Index32 (Typ.Vbound.Len);
when Type_Array =>
declare
- Len : Width;
+ Len : Uns32;
begin
Len := 1;
for I in Typ.Abounds.D'Range loop
@@ -230,8 +202,7 @@ package body Synth.Values is
return (Typ, Val);
end Create_Value_Alias;
- function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src)
- return Value_Acc
+ function Create_Value_Const (Val : Value_Acc; Loc : Node) return Value_Acc
is
subtype Value_Type_Const is Value_Type (Value_Const);
function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const);
@@ -241,11 +212,10 @@ package body Synth.Values is
(Kind => Value_Const,
C_Val => Val,
C_Loc => Loc,
- C_Net => No_Net)));
+ C_Net => 0)));
end Create_Value_Const;
- function Create_Value_Const (Val : Valtyp; Loc : Syn_Src)
- return Valtyp is
+ function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp is
begin
return (Val.Typ, Create_Value_Const (Val.Val, Loc));
end Create_Value_Const;
@@ -276,11 +246,13 @@ package body Synth.Values is
Res.Val.Mem (I - 1) := Src.Val.Mem (I - 1);
end loop;
when Value_Net =>
- Res := Create_Value_Net (Src.Val.N, Src.Typ);
+ Res := (Src.Typ, Create_Value_Net (Src.Val.S));
when Value_Wire =>
- Res := Create_Value_Wire (Src.Val.W, Src.Typ);
+ Res := (Src.Typ, Create_Value_Wire (Src.Val.S));
when Value_File =>
Res := Create_Value_File (Src.Typ, Src.Val.File);
+ when Value_Signal =>
+ raise Internal_Error;
when Value_Const =>
raise Internal_Error;
when Value_Alias =>
@@ -493,7 +465,8 @@ package body Synth.Values is
begin
case V.Val.Kind is
when Value_Net
- | Value_Wire =>
+ | Value_Wire
+ | Value_Signal =>
raise Internal_Error;
when Value_Memory =>
return (V.Typ, V.Val.Mem);
@@ -510,4 +483,18 @@ package body Synth.Values is
raise Internal_Error;
end case;
end Get_Memtyp;
-end Synth.Values;
+
+ procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp)
+ is
+ T : Int64;
+ begin
+ T := Read_Discrete (V);
+ case Rng.Dir is
+ when Dir_To =>
+ T := T + 1;
+ when Dir_Downto =>
+ T := T - 1;
+ end case;
+ Write_Discrete (V, T);
+ end Update_Index;
+end Elab.Vhdl_Values;
diff --git a/src/synth/synth-values.ads b/src/synth/elab-vhdl_values.ads
index f5db25da6..047f294ba 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/elab-vhdl_values.ads
@@ -23,14 +23,12 @@ with Areapools; use Areapools;
with Grt.Files_Operations;
-with Netlists; use Netlists;
+with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Memtype; use Synth.Memtype;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
-with Synth.Source; use Synth.Source;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Memtype; use Elab.Memtype;
-package Synth.Values is
+package Elab.Vhdl_Values is
-- Values is how signals and variables are decomposed. This is similar to
-- values in simulation, but simplified (no need to handle files,
-- accesses...)
@@ -44,6 +42,8 @@ package Synth.Values is
-- into a net.
Value_Wire,
+ Value_Signal,
+
-- Any kind of constant value, raw stored in memory.
Value_Memory,
@@ -69,18 +69,20 @@ package Synth.Values is
type Value_Type (Kind : Value_Kind) is record
case Kind is
- when Value_Net =>
- N : Net;
- when Value_Wire =>
- W : Wire_Id;
+ when Value_Net
+ | Value_Wire =>
+ N : Uns32;
+ when Value_Signal =>
+ S : Uns32;
+ Init : Value_Acc;
when Value_Memory =>
Mem : Memory_Ptr;
when Value_File =>
File : File_Index;
when Value_Const =>
C_Val : Value_Acc;
- C_Loc : Syn_Src;
- C_Net : Net;
+ C_Loc : Node;
+ C_Net : Uns32;
when Value_Alias =>
A_Obj : Value_Acc;
A_Typ : Type_Acc; -- The type of A_Obj.
@@ -105,19 +107,17 @@ package Synth.Values is
-- True if VAL is static, ie contains neither nets nor wires.
function Is_Static (Val : Value_Acc) return Boolean;
- -- Can also return true for nets and wires.
- -- Use Get_Static_Discrete to get the value.
- function Is_Static_Val (Val : Value_Acc) return Boolean;
-
function Is_Equal (L, R : Valtyp) return Boolean;
function Create_Value_Memtyp (Mt : Memtyp) return Valtyp;
-- Create a Value_Net.
- function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp;
+ function Create_Value_Net (S : Uns32) return Value_Acc;
+
+ -- Create a Value_Wire.
+ function Create_Value_Wire (S : Uns32) return Value_Acc;
- -- Create a Value_Wire. For a bit wire, RNG must be null.
- function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp;
+ function Create_Value_Signal (S : Uns32; Init : Value_Acc) return Value_Acc;
function Create_Value_Memory (Vtype : Type_Acc) return Valtyp;
function Create_Value_Memory (Mt : Memtyp) return Valtyp;
@@ -138,8 +138,7 @@ package Synth.Values is
function Create_Value_Alias
(Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp;
- function Create_Value_Const (Val : Valtyp; Loc : Syn_Src)
- return Valtyp;
+ function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp;
-- If VAL is a const, replace it by its value.
procedure Strip_Const (Vt : in out Valtyp);
@@ -173,4 +172,7 @@ package Synth.Values is
function Read_Fp64 (Vt : Valtyp) return Fp64;
procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp);
-end Synth.Values;
+
+ procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp);
+
+end Elab.Vhdl_Values;
diff --git a/src/synth/elab.ads b/src/synth/elab.ads
new file mode 100644
index 000000000..8d05336de
--- /dev/null
+++ b/src/synth/elab.ads
@@ -0,0 +1,21 @@
+-- Elaboration root namespace.
+-- Copyright (C) 2021 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+package Elab is
+ pragma Pure;
+end Elab;
diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb
index c920e0ae5..bc1642c07 100644
--- a/src/synth/synth-disp_vhdl.adb
+++ b/src/synth/synth-disp_vhdl.adb
@@ -27,11 +27,11 @@ with Vhdl.Ieee.Std_Logic_1164;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+
with Netlists.Iterators; use Netlists.Iterators;
with Netlists.Disp_Vhdl; use Netlists.Disp_Vhdl;
-with Synth.Objtypes; use Synth.Objtypes;
-
package body Synth.Disp_Vhdl is
procedure Disp_Signal (Desc : Port_Desc) is
begin
diff --git a/src/synth/synth-disp_vhdl.ads b/src/synth/synth-disp_vhdl.ads
index 39706a085..0bfac8068 100644
--- a/src/synth/synth-disp_vhdl.ads
+++ b/src/synth/synth-disp_vhdl.ads
@@ -17,8 +17,8 @@
-- along with this program. If not, see <gnu.org/licenses>.
with Netlists; use Netlists;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
package Synth.Disp_Vhdl is
-- Disp ENT (like the original text) and its content as a wrapper.
diff --git a/src/synth/synth-ieee-numeric_std.adb b/src/synth/synth-ieee-numeric_std.adb
index fd260a59b..0697a7697 100644
--- a/src/synth/synth-ieee-numeric_std.adb
+++ b/src/synth/synth-ieee-numeric_std.adb
@@ -18,7 +18,8 @@
with Types_Utils; use Types_Utils;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
+
with Synth.Errors; use Synth.Errors;
with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164;
diff --git a/src/synth/synth-ieee-numeric_std.ads b/src/synth/synth-ieee-numeric_std.ads
index bad079b76..b3bc9a632 100644
--- a/src/synth/synth-ieee-numeric_std.ads
+++ b/src/synth/synth-ieee-numeric_std.ads
@@ -18,7 +18,7 @@
with Types; use Types;
-with Synth.Objtypes; use Synth.Objtypes;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
with Synth.Source; use Synth.Source;
package Synth.Ieee.Numeric_Std is
diff --git a/src/synth/synth-ieee-std_logic_1164.ads b/src/synth/synth-ieee-std_logic_1164.ads
index c3670882f..33a298f81 100644
--- a/src/synth/synth-ieee-std_logic_1164.ads
+++ b/src/synth/synth-ieee-std_logic_1164.ads
@@ -18,7 +18,7 @@
with Types; use Types;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
package Synth.Ieee.Std_Logic_1164 is
diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb
index 5eba9c8fb..cc52cd0f4 100644
--- a/src/synth/synth-static_oper.adb
+++ b/src/synth/synth-static_oper.adb
@@ -24,17 +24,18 @@ with Grt.Types; use Grt.Types;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Files;
+
with Netlists; use Netlists;
-with Synth.Memtype; use Synth.Memtype;
with Synth.Errors; use Synth.Errors;
with Synth.Source; use Synth.Source;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Vhdl_Oper;
with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164;
with Synth.Ieee.Numeric_Std; use Synth.Ieee.Numeric_Std;
-with Synth.Vhdl_Files;
-with Synth.Values; use Synth.Values;
package body Synth.Static_Oper is
-- As log2(3m) is directly referenced, the program must be linked with -lm
@@ -852,7 +853,7 @@ package body Synth.Static_Oper is
declare
Res : Boolean;
begin
- Res := Synth.Vhdl_Files.Endfile (Param1.Val.File, Expr);
+ Res := Elab.Vhdl_Files.Endfile (Param1.Val.File, Expr);
return Create_Memory_U8 (Boolean'Pos (Res), Boolean_Type);
end;
diff --git a/src/synth/synth-static_oper.ads b/src/synth/synth-static_oper.ads
index 3178c6448..797b73de6 100644
--- a/src/synth/synth-static_oper.ads
+++ b/src/synth/synth-static_oper.ads
@@ -16,8 +16,8 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
with Vhdl.Nodes; use Vhdl.Nodes;
diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb
index fe7e95058..6ba9fda0d 100644
--- a/src/synth/synth-vhdl_aggr.adb
+++ b/src/synth/synth-vhdl_aggr.adb
@@ -26,11 +26,12 @@ with Netlists.Builders; use Netlists.Builders;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+
with Synth.Errors; use Synth.Errors;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
-with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
-with Synth.Vhdl_Decls; use Synth.Vhdl_Decls;
+with Synth.Vhdl_Context; use Synth.Vhdl_Context;
package body Synth.Vhdl_Aggr is
type Stride_Array is array (Dim_Type range <>) of Nat32;
diff --git a/src/synth/synth-vhdl_aggr.ads b/src/synth/synth-vhdl_aggr.ads
index 822c0705d..97e3030fe 100644
--- a/src/synth/synth-vhdl_aggr.ads
+++ b/src/synth/synth-vhdl_aggr.ads
@@ -18,9 +18,9 @@
with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
package Synth.Vhdl_Aggr is
-- Aggr_Type is the type from the context.
diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb
index 4b32b7efd..a01ad9db0 100644
--- a/src/synth/synth-vhdl_context.adb
+++ b/src/synth/synth-vhdl_context.adb
@@ -16,37 +16,36 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-with Ada.Unchecked_Deallocation;
-
+with Ada.Unchecked_Conversion;
+with Tables;
with Types_Utils; use Types_Utils;
-with Vhdl.Errors; use Vhdl.Errors;
-with Vhdl.Utils;
-
with Netlists.Folds; use Netlists.Folds;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Netlists.Locations;
package body Synth.Vhdl_Context is
- function Make_Base_Instance (Base : Base_Instance_Acc)
- return Synth_Instance_Acc
+ package Extra_Tables is new Tables
+ (Table_Component_Type => Extra_Vhdl_Instance_Type,
+ Table_Index_Type => Instance_Id_Type,
+ Table_Low_Bound => First_Instance_Id,
+ Table_Initial => 16);
+
+ procedure Set_Extra (Inst : Synth_Instance_Acc;
+ Extra : Extra_Vhdl_Instance_Type)
is
- Res : Synth_Instance_Acc;
+ Id : constant Instance_Id_Type := Get_Instance_Id (Inst);
begin
- Res := new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects,
- Is_Const => False,
- Is_Error => False,
- Base => Base,
- Name => No_Sname,
- Block_Scope => Global_Info,
- Up_Block => null,
- Uninst_Scope => null,
- Source_Scope => Null_Node,
- Elab_Objects => 0,
- Objects => (others =>
- (Kind => Obj_None)));
- return Res;
+ while Id > Extra_Tables.Last loop
+ Extra_Tables.Append ((Base => null, Name => No_Sname));
+ end loop;
+ Extra_Tables.Table (Id) := Extra;
+ end Set_Extra;
+
+ procedure Make_Base_Instance (Base : Base_Instance_Acc) is
+ begin
+ Set_Extra (Root_Instance, (Base => Base, Name => No_Sname));
end Make_Base_Instance;
procedure Free_Base_Instance is
@@ -55,54 +54,62 @@ package body Synth.Vhdl_Context is
null;
end Free_Base_Instance;
+ function Get_Instance_Extra (Inst : Synth_Instance_Acc)
+ return Extra_Vhdl_Instance_Type is
+ begin
+ return Extra_Tables.Table (Get_Instance_Id (Inst));
+ end Get_Instance_Extra;
+
+ procedure Set_Extra (Inst : Synth_Instance_Acc;
+ Base : Base_Instance_Acc;
+ Name : Sname := No_Sname) is
+ begin
+ Set_Extra (Inst, (Base => Base, Name => Name));
+ end Set_Extra;
+
+ procedure Set_Extra (Inst : Synth_Instance_Acc;
+ Parent : Synth_Instance_Acc;
+ Name : Sname := No_Sname) is
+ begin
+ Set_Extra (Inst, (Base => Get_Instance_Extra (Parent).Base,
+ Name => Name));
+ end Set_Extra;
+
function Make_Instance (Parent : Synth_Instance_Acc;
Blk : Node;
Name : Sname := No_Sname)
return Synth_Instance_Acc
is
- Info : constant Sim_Info_Acc := Get_Info (Blk);
- Scope : Sim_Info_Acc;
Res : Synth_Instance_Acc;
begin
- if Get_Kind (Blk) = Iir_Kind_Architecture_Body then
- -- Architectures are extensions of entities.
- Scope := Get_Info (Vhdl.Utils.Get_Entity (Blk));
- else
- Scope := Info;
- end if;
-
- Res := new Synth_Instance_Type'(Max_Objs => Info.Nbr_Objects,
- Is_Const => False,
- Is_Error => False,
- Base => Parent.Base,
- Name => Name,
- Block_Scope => Scope,
- Up_Block => Parent,
- Uninst_Scope => null,
- Source_Scope => Blk,
- Elab_Objects => 0,
- Objects => (others =>
- (Kind => Obj_None)));
+ Res := Make_Elab_Instance (Parent, Blk, Null_Node);
+ Set_Extra (Res, Parent, Name);
return Res;
end Make_Instance;
procedure Set_Instance_Base (Inst : Synth_Instance_Acc;
+ Base : Base_Instance_Acc) is
+ begin
+ Extra_Tables.Table (Get_Instance_Id (Inst)).Base := Base;
+ end Set_Instance_Base;
+
+ procedure Set_Instance_Base (Inst : Synth_Instance_Acc;
Base : Synth_Instance_Acc) is
begin
- Inst.Base := Base.Base;
+ Set_Instance_Base (Inst, Get_Instance_Extra (Base).Base);
end Set_Instance_Base;
- procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc)
- is
- procedure Deallocate is new Ada.Unchecked_Deallocation
- (Synth_Instance_Type, Synth_Instance_Acc);
+ procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc) is
begin
- Deallocate (Synth_Inst);
+ if Get_Instance_Id (Synth_Inst) = Extra_Tables.Last then
+ Extra_Tables.Decrement_Last;
+ end if;
+ Free_Elab_Instance (Synth_Inst);
end Free_Instance;
procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module)
is
- Prev_Base : constant Base_Instance_Acc := Inst.Base;
+ Prev_Base : constant Base_Instance_Acc := Get_Instance_Extra (Inst).Base;
Base : Base_Instance_Acc;
Self_Inst : Instance;
begin
@@ -114,184 +121,42 @@ package body Synth.Vhdl_Context is
Self_Inst := Create_Self_Instance (M);
pragma Unreferenced (Self_Inst);
- Inst.Base := Base;
+ Set_Instance_Base (Inst, Base);
end Set_Instance_Module;
- function Is_Error (Inst : Synth_Instance_Acc) return Boolean is
- begin
- return Inst.Is_Error;
- end Is_Error;
-
- procedure Set_Error (Inst : Synth_Instance_Acc) is
- begin
- Inst.Is_Error := True;
- end Set_Error;
-
function Get_Instance_Module (Inst : Synth_Instance_Acc) return Module is
begin
- return Inst.Base.Cur_Module;
+ return Extra_Tables.Table (Get_Instance_Id (Inst)).Base.Cur_Module;
end Get_Instance_Module;
- function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node is
- begin
- return Inst.Source_Scope;
- end Get_Source_Scope;
-
function Get_Top_Module (Inst : Synth_Instance_Acc) return Module is
begin
- return Inst.Base.Top_Module;
+ return Extra_Tables.Table (Get_Instance_Id (Inst)).Base.Top_Module;
end Get_Top_Module;
function Get_Sname (Inst : Synth_Instance_Acc) return Sname is
begin
- return Inst.Name;
+ return Extra_Tables.Table (Get_Instance_Id (Inst)).Name;
end Get_Sname;
function Get_Build (Inst : Synth_Instance_Acc)
- return Netlists.Builders.Context_Acc is
- begin
- return Inst.Base.Builder;
- end Get_Build;
-
- function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean is
- begin
- return Inst.Is_Const;
- end Get_Instance_Const;
-
- function Check_Set_Instance_Const (Inst : Synth_Instance_Acc)
- return Boolean is
- begin
- for I in 1 .. Inst.Elab_Objects loop
- if Inst.Objects (I).Kind /= Obj_Subtype then
- return False;
- end if;
- end loop;
- return True;
- end Check_Set_Instance_Const;
-
- procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean) is
- begin
- pragma Assert (not Val or else Check_Set_Instance_Const (Inst));
- Inst.Is_Const := Val;
- end Set_Instance_Const;
-
- procedure Create_Object (Syn_Inst : Synth_Instance_Acc;
- Slot : Object_Slot_Type;
- Num : Object_Slot_Type := 1) is
- begin
- -- Check elaboration order.
- -- Note: this is not done for package since objects from package are
- -- commons (same scope), and package annotation order can be different
- -- from package elaboration order (eg: body).
- if Slot /= Syn_Inst.Elab_Objects + 1
- or else Syn_Inst.Objects (Slot).Kind /= Obj_None
- then
- Error_Msg_Elab ("synth: bad elaboration order of objects");
- raise Internal_Error;
- end if;
- Syn_Inst.Elab_Objects := Slot + Num - 1;
- end Create_Object;
-
- procedure Create_Object_Force
- (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp)
+ return Netlists.Builders.Context_Acc
is
- Info : constant Sim_Info_Acc := Get_Info (Decl);
- begin
- pragma Assert
- (Syn_Inst.Objects (Info.Slot).Kind = Obj_None
- or else Vt = (null, null)
- or else Syn_Inst.Objects (Info.Slot) = (Kind => Obj_Object,
- Obj => No_Valtyp));
- Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt);
- end Create_Object_Force;
-
- procedure Create_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp)
- is
- Info : constant Sim_Info_Acc := Get_Info (Decl);
- begin
- Create_Object (Syn_Inst, Info.Slot, 1);
- Create_Object_Force (Syn_Inst, Decl, Vt);
- end Create_Object;
-
- procedure Create_Subtype_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc)
- is
- pragma Assert (Typ /= null);
- Info : constant Sim_Info_Acc := Get_Info (Decl);
- begin
- Create_Object (Syn_Inst, Info.Slot, 1);
- pragma Assert (Syn_Inst.Objects (Info.Slot).Kind = Obj_None);
- Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Subtype, T_Typ => Typ);
- end Create_Subtype_Object;
-
- procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc;
- Decl : Node;
- Inst : Synth_Instance_Acc;
- Is_Global : Boolean)
- is
- Info : constant Sim_Info_Acc := Get_Info (Decl);
+ Id : constant Instance_Id_Type := Get_Instance_Id (Inst);
+ Base : Base_Instance_Acc;
begin
- if Is_Global then
- pragma Assert (Syn_Inst.Objects (Info.Pkg_Slot).Kind = Obj_None);
- pragma Assert (Syn_Inst.Up_Block = null);
- null;
- else
- pragma Assert (Syn_Inst.Up_Block /= null);
- Create_Object (Syn_Inst, Info.Slot, 1);
+ if Id > Extra_Tables.Last then
+ -- Not yet built.
+ return null;
end if;
- Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance,
- I_Inst => Inst);
- end Create_Package_Object;
- procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc;
- Decl : Node;
- Inst : Synth_Instance_Acc)
- is
- Info : constant Sim_Info_Acc := Get_Info (Decl);
- begin
- pragma Assert (Syn_Inst.Up_Block /= null);
- Create_Object (Syn_Inst, Info.Pkg_Slot, 1);
- Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance,
- I_Inst => Inst);
- end Create_Package_Interface;
-
- function Get_Package_Object
- (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc)
- return Synth_Instance_Acc
- is
- Parent : Synth_Instance_Acc;
- begin
- Parent := Get_Instance_By_Scope (Syn_Inst, Info.Pkg_Parent);
- return Parent.Objects (Info.Pkg_Slot).I_Inst;
- end Get_Package_Object;
-
- function Get_Package_Object
- (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc is
- begin
- return Get_Package_Object (Syn_Inst, Get_Info (Pkg));
- end Get_Package_Object;
-
- procedure Set_Uninstantiated_Scope
- (Syn_Inst : Synth_Instance_Acc; Bod : Node) is
- begin
- Syn_Inst.Uninst_Scope := Get_Info (Bod);
- end Set_Uninstantiated_Scope;
-
- procedure Destroy_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node)
- is
- Info : constant Sim_Info_Acc := Get_Info (Decl);
- Slot : constant Object_Slot_Type := Info.Slot;
- begin
- if Slot /= Syn_Inst.Elab_Objects
- or else Info.Obj_Scope /= Syn_Inst.Block_Scope
- then
- Error_Msg_Elab ("synth: bad destroy order");
+ Base := Extra_Tables.Table (Id).Base;
+ if Base = null then
+ return null;
end if;
- Syn_Inst.Objects (Slot) := (Kind => Obj_None);
- Syn_Inst.Elab_Objects := Slot - 1;
- end Destroy_Object;
+
+ return Base.Builder;
+ end Get_Build;
procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc;
Kind : Wire_Kind;
@@ -312,81 +177,6 @@ package body Synth.Vhdl_Context is
Create_Object (Syn_Inst, Obj, Val);
end Create_Wire_Object;
- function Get_Instance_By_Scope
- (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc)
- return Synth_Instance_Acc is
- begin
- case Scope.Kind is
- when Kind_Block
- | Kind_Frame
- | Kind_Process =>
- declare
- Current : Synth_Instance_Acc;
- begin
- Current := Syn_Inst;
- while Current /= null loop
- if Current.Block_Scope = Scope then
- return Current;
- end if;
- Current := Current.Up_Block;
- end loop;
- raise Internal_Error;
- end;
- when Kind_Package =>
- if Scope.Pkg_Parent = null then
- -- This is a scope for an uninstantiated package.
- declare
- Current : Synth_Instance_Acc;
- begin
- Current := Syn_Inst;
- while Current /= null loop
- if Current.Uninst_Scope = Scope then
- return Current;
- end if;
- Current := Current.Up_Block;
- end loop;
- raise Internal_Error;
- end;
- else
- -- Instantiated package.
- return Get_Package_Object (Syn_Inst, Scope);
- end if;
- when others =>
- raise Internal_Error;
- end case;
- end Get_Instance_By_Scope;
-
- function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc
- is
- Parent : Node;
- begin
- Parent := Get_Parent (Blk);
- if Get_Kind (Parent) = Iir_Kind_Architecture_Body then
- Parent := Vhdl.Utils.Get_Entity (Parent);
- end if;
- return Get_Info (Parent);
- end Get_Parent_Scope;
-
- function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node)
- return Valtyp
- is
- Info : constant Sim_Info_Acc := Get_Info (Obj);
- Obj_Inst : Synth_Instance_Acc;
- begin
- Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope);
- return Obj_Inst.Objects (Info.Slot).Obj;
- end Get_Value;
-
- function Get_Subtype_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc
- is
- Info : constant Sim_Info_Acc := Get_Info (Decl);
- Obj_Inst : Synth_Instance_Acc;
- begin
- Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope);
- return Obj_Inst.Objects (Info.Slot).T_Typ;
- end Get_Subtype_Object;
-
-- Set Is_0 to True iff VEC is 000...
-- Set Is_X to True iff VEC is XXX...
procedure Is_Full (Vec : Logvec_Array;
@@ -529,19 +319,75 @@ package body Synth.Vhdl_Context is
return Get_Partial_Memtyp_Net (Ctxt, Val, 0, Val.Typ.W);
end Get_Memtyp_Net;
+ function To_Net is new Ada.Unchecked_Conversion (Uns32, Net);
+ function To_Uns32 is new Ada.Unchecked_Conversion (Net, Uns32);
+
+ function Get_Value_Net (Val : Value_Acc) return Net is
+ begin
+ return To_Net (Val.N);
+ end Get_Value_Net;
+
+ procedure Set_Value_Net (Val : Value_Acc; N : Net) is
+ begin
+ Val.N := To_Uns32 (N);
+ end Set_Value_Net;
+
+ function Get_Value_Wire (Val : Value_Acc) return Wire_Id
+ is
+ function To_Wire_Id is new Ada.Unchecked_Conversion (Uns32, Wire_Id);
+ begin
+ return To_Wire_Id (Val.N);
+ end Get_Value_Wire;
+
+ procedure Set_Value_Wire (Val : Value_Acc; W : Wire_Id)
+ is
+ function To_Uns32 is new Ada.Unchecked_Conversion (Wire_Id, Uns32);
+ begin
+ Val.N := To_Uns32 (W);
+ end Set_Value_Wire;
+
+ function Create_Value_Wire (W : Wire_Id) return Value_Acc
+ is
+ function To_Uns32 is new Ada.Unchecked_Conversion (Wire_Id, Uns32);
+ begin
+ return Create_Value_Wire (To_Uns32 (W));
+ end Create_Value_Wire;
+
+ function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp
+ is
+ pragma Assert (Wtype /= null);
+ begin
+ return (Wtype, Create_Value_Wire (W));
+ end Create_Value_Wire;
+
+ function Create_Value_Net (N : Net) return Value_Acc
+ is
+ function To_Uns32 is new Ada.Unchecked_Conversion (Net, Uns32);
+ begin
+ return Create_Value_Net (To_Uns32 (N));
+ end Create_Value_Net;
+
+ function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp
+ is
+ pragma Assert (Ntype /= null);
+ begin
+ return (Ntype, Create_Value_Net (N));
+ end Create_Value_Net;
+
function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net is
begin
case Val.Val.Kind is
when Value_Wire =>
- return Get_Current_Value (Ctxt, Val.Val.W);
+ return Get_Current_Value (Ctxt, Get_Value_Wire (Val.Val));
when Value_Net =>
- return Val.Val.N;
+ return Get_Value_Net (Val.Val);
when Value_Alias =>
declare
Res : Net;
begin
if Val.Val.A_Obj.Kind = Value_Wire then
- Res := Get_Current_Value (Ctxt, Val.Val.A_Obj.W);
+ Res := Get_Current_Value
+ (Ctxt, Get_Value_Wire (Val.Val.A_Obj));
return Build2_Extract
(Ctxt, Res, Val.Val.A_Off.Net_Off, Val.Typ.W);
else
@@ -550,16 +396,51 @@ package body Synth.Vhdl_Context is
end if;
end;
when Value_Const =>
- if Val.Val.C_Net = No_Net then
- Val.Val.C_Net := Get_Net (Ctxt, (Val.Typ, Val.Val.C_Val));
- Locations.Set_Location (Get_Net_Parent (Val.Val.C_Net),
- Get_Location (Val.Val.C_Loc));
- end if;
- return Val.Val.C_Net;
+ declare
+ N : Net;
+ begin
+ N := To_Net (Val.Val.C_Net);
+ if N = No_Net then
+ N := Get_Net (Ctxt, (Val.Typ, Val.Val.C_Val));
+ Val.Val.C_Net := To_Uns32 (N);
+ Locations.Set_Location (Get_Net_Parent (N),
+ Get_Location (Val.Val.C_Loc));
+ end if;
+ return N;
+ end;
when Value_Memory =>
return Get_Memtyp_Net (Ctxt, Get_Memtyp (Val));
when others =>
raise Internal_Error;
end case;
end Get_Net;
+
+ function Is_Static_Val (Val : Value_Acc) return Boolean is
+ begin
+ case Val.Kind is
+ when Value_Memory =>
+ return True;
+ when Value_Net
+ | Value_Signal =>
+ return False;
+ when Value_Wire =>
+ declare
+ W : constant Wire_Id := Get_Value_Wire (Val);
+ begin
+ if Get_Kind (W) = Wire_Variable then
+ return Is_Static_Wire (W);
+ else
+ -- A signal does not have static values.
+ return False;
+ end if;
+ end;
+ when Value_File =>
+ return True;
+ when Value_Const =>
+ return True;
+ when Value_Alias =>
+ return Is_Static_Val (Val.A_Obj);
+ end case;
+ end Is_Static_Val;
+
end Synth.Vhdl_Context;
diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads
index 2329c4c0d..df3e83d6a 100644
--- a/src/synth/synth-vhdl_context.ads
+++ b/src/synth/synth-vhdl_context.ads
@@ -18,52 +18,49 @@
with Types; use Types;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
with Netlists; use Netlists;
with Netlists.Builders; use Netlists.Builders;
-with Vhdl.Annotations; use Vhdl.Annotations;
with Vhdl.Nodes; use Vhdl.Nodes;
with Synth.Context; use Synth.Context;
with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
package Synth.Vhdl_Context is
-- Values are stored into Synth_Instance, which is parallel to simulation
-- Block_Instance_Type.
- type Synth_Instance_Type (<>) is limited private;
- type Synth_Instance_Acc is access Synth_Instance_Type;
-
- function Get_Instance_By_Scope
- (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc)
- return Synth_Instance_Acc;
-
- -- Create the first instance.
- function Make_Base_Instance (Base : Base_Instance_Acc)
- return Synth_Instance_Acc;
+ -- Create the root instance.
+ procedure Make_Base_Instance (Base : Base_Instance_Acc);
-- Free the first instance.
procedure Free_Base_Instance;
- -- Create and free the corresponding synth instance.
+ -- Create a synth instance.
+ procedure Set_Extra (Inst : Synth_Instance_Acc;
+ Base : Base_Instance_Acc;
+ Name : Sname := No_Sname);
+
+ procedure Set_Extra (Inst :Synth_Instance_Acc;
+ Parent : Synth_Instance_Acc;
+ Name : Sname := No_Sname);
+
function Make_Instance (Parent : Synth_Instance_Acc;
Blk : Node;
Name : Sname := No_Sname)
return Synth_Instance_Acc;
+ procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc);
+
-- Only useful for subprograms: set the base (which can be different from
-- the parent). Ideally it should be part of Make_Instance, but in most
-- cases they are the same (except sometimes for subprograms).
procedure Set_Instance_Base (Inst : Synth_Instance_Acc;
Base : Synth_Instance_Acc);
- procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc);
-
- function Is_Error (Inst : Synth_Instance_Acc) return Boolean;
- pragma Inline (Is_Error);
-
- procedure Set_Error (Inst : Synth_Instance_Acc);
function Get_Sname (Inst : Synth_Instance_Acc) return Sname;
pragma Inline (Get_Sname);
@@ -79,45 +76,12 @@ package Synth.Vhdl_Context is
-- Start the definition of module M (using INST).
procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module);
- function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean;
- procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean);
-
- -- Get the corresponding source for the scope of the instance.
- function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node;
-
- procedure Create_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
-
- procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc;
- Decl : Node;
- Inst : Synth_Instance_Acc;
- Is_Global : Boolean);
-
- procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc;
- Decl : Node;
- Inst : Synth_Instance_Acc);
-
- procedure Create_Subtype_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc);
-
- -- Force the value of DECL, without checking for elaboration order.
- -- It is for deferred constants.
- procedure Create_Object_Force
- (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp);
-
- procedure Destroy_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node);
-
-- Build the value for object OBJ.
-- KIND must be Wire_Variable or Wire_Signal.
procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc;
Kind : Wire_Kind;
Obj : Node);
- -- Get the value of OBJ.
- function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node)
- return Valtyp;
-
-- Get a net from a scalar/vector value. This will automatically create
-- a net for literals.
function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net;
@@ -125,74 +89,29 @@ package Synth.Vhdl_Context is
(Ctxt : Context_Acc; Val : Memtyp; Off : Uns32; Wd : Width) return Net;
function Get_Memtyp_Net (Ctxt : Context_Acc; Val : Memtyp) return Net;
- function Get_Package_Object
- (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc;
+ -- Can also return true for nets and wires.
+ -- Use Get_Static_Discrete to get the value.
+ function Is_Static_Val (Val : Value_Acc) return Boolean;
- -- Return the type for DECL (a subtype indication).
- function Get_Subtype_Object
- (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc;
+ function Get_Value_Net (Val : Value_Acc) return Net;
+ pragma Inline (Get_Value_Net);
+ procedure Set_Value_Net (Val : Value_Acc; N : Net);
+ pragma Inline (Set_Value_Net);
+ function Get_Value_Wire (Val : Value_Acc) return Wire_Id;
+ pragma Inline (Get_Value_Wire);
+ procedure Set_Value_Wire (Val : Value_Acc; W : Wire_Id);
+ pragma Inline (Set_Value_Wire);
- -- Return the scope of the parent of BLK. Deals with architecture bodies.
- function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc;
+ -- Create a Value_Net.
+ function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp;
- procedure Set_Uninstantiated_Scope
- (Syn_Inst : Synth_Instance_Acc; Bod : Node);
+ -- Create a Value_Wire. For a bit wire, RNG must be null.
+ function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp;
private
- type Obj_Kind is
- (
- Obj_None,
- Obj_Object,
- Obj_Subtype,
- Obj_Instance
- );
-
- type Obj_Type (Kind : Obj_Kind := Obj_None) is record
- case Kind is
- when Obj_None =>
- null;
- when Obj_Object =>
- Obj : Valtyp;
- when Obj_Subtype =>
- T_Typ : Type_Acc;
- when Obj_Instance =>
- I_Inst : Synth_Instance_Acc;
- end case;
- end record;
-
- type Objects_Array is array (Object_Slot_Type range <>) of Obj_Type;
-
- type Synth_Instance_Type (Max_Objs : Object_Slot_Type) is limited record
- Is_Const : Boolean;
-
- -- True if a fatal error has been detected that aborts the synthesis
- -- of this instance.
- Is_Error : Boolean;
-
+ type Extra_Vhdl_Instance_Type is record
Base : Base_Instance_Acc;
-- Name prefix for declarations.
Name : Sname;
-
- -- The corresponding info for this instance.
- -- This is used for lookup.
- Block_Scope : Sim_Info_Acc;
-
- -- The corresponding info the the uninstantiated specification of
- -- an instantiated package. When an object is looked for from the
- -- uninstantiated body, the scope of the uninstantiated specification
- -- is used. And it is different from Block_Scope.
- -- This is used for lookup of uninstantiated specification.
- Uninst_Scope : Sim_Info_Acc;
-
- -- Instance of the parent scope.
- Up_Block : Synth_Instance_Acc;
-
- -- Source construct corresponding to this instance/
- Source_Scope : Node;
-
- Elab_Objects : Object_Slot_Type;
-
- -- Instance for synthesis.
- Objects : Objects_Array (1 .. Max_Objs);
end record;
end Synth.Vhdl_Context;
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb
index e2d130631..8b54c94bd 100644
--- a/src/synth/synth-vhdl_decls.adb
+++ b/src/synth/synth-vhdl_decls.adb
@@ -17,7 +17,6 @@
-- along with this program. If not, see <gnu.org/licenses>.
with Types; use Types;
-with Mutils; use Mutils;
with Std_Names;
with Netlists.Builders; use Netlists.Builders;
@@ -28,45 +27,49 @@ with Netlists.Gates;
with Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package;
-with Vhdl.Ieee.Std_Logic_1164;
+
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Decls; use Elab.Vhdl_Decls;
+with Elab.Vhdl_Files;
with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Vhdl_Stmts;
with Synth.Source; use Synth.Source;
with Synth.Errors; use Synth.Errors;
-with Synth.Vhdl_Files;
-with Synth.Values; use Synth.Values;
+with Synth.Vhdl_Context; use Synth.Vhdl_Context;
package body Synth.Vhdl_Decls is
- procedure Create_Var_Wire
- (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Valtyp)
+ function Create_Var_Wire (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node;
+ Kind : Wire_Kind;
+ Init : Valtyp) return Valtyp
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
- Vt : constant Valtyp := Get_Value (Syn_Inst, Decl);
Value : Net;
Ival : Net;
W : Width;
Name : Sname;
+ Wid : Wire_Id;
begin
- case Vt.Val.Kind is
- when Value_Wire =>
- -- FIXME: get the width directly from the wire ?
- W := Get_Type_Width (Vt.Typ);
- Name := New_Sname_User (Get_Identifier (Decl),
- Get_Sname (Syn_Inst));
- if Init /= No_Valtyp then
- Ival := Get_Net (Ctxt, Init);
- pragma Assert (Get_Width (Ival) = W);
- Value := Build_Isignal (Ctxt, Name, Ival);
- else
- Value := Build_Signal (Ctxt, Name, W);
- end if;
- Set_Location (Value, Decl);
- Set_Wire_Gate (Vt.Val.W, Value);
- when others =>
- raise Internal_Error;
- end case;
+ Wid := Alloc_Wire (Kind, (Decl, Init.Typ));
+
+ -- FIXME: get the width directly from the wire ?
+ W := Get_Type_Width (Init.Typ);
+ Name := New_Sname_User (Get_Identifier (Decl),
+ Get_Sname (Syn_Inst));
+ if Init.Val /= null then
+ Ival := Get_Net (Ctxt, Init);
+ pragma Assert (Get_Width (Ival) = W);
+ Value := Build_Isignal (Ctxt, Name, Ival);
+ else
+ Value := Build_Signal (Ctxt, Name, W);
+ end if;
+ Set_Location (Value, Decl);
+
+ Set_Wire_Gate (Wid, Value);
+ return Create_Value_Wire (Wid, Init.Typ);
end Create_Var_Wire;
function Type_To_Param_Type (Atype : Node) return Param_Type
@@ -119,403 +122,6 @@ package body Synth.Vhdl_Decls is
return Pv;
end Memtyp_To_Pval;
- procedure Synth_Subtype_Indication_If_Anonymous
- (Syn_Inst : Synth_Instance_Acc; Atype : Node) is
- begin
- if Get_Type_Declarator (Atype) = Null_Node then
- Synth_Subtype_Indication (Syn_Inst, Atype);
- end if;
- end Synth_Subtype_Indication_If_Anonymous;
-
- function Synth_Subtype_Indication_If_Anonymous
- (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is
- begin
- if Get_Type_Declarator (Atype) = Null_Node then
- return Synth_Subtype_Indication (Syn_Inst, Atype);
- else
- return Get_Subtype_Object (Syn_Inst, Atype);
- end if;
- end Synth_Subtype_Indication_If_Anonymous;
-
- function Synth_Array_Type_Definition
- (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
- is
- El_Type : constant Node := Get_Element_Subtype (Def);
- Ndims : constant Natural := Get_Nbr_Dimensions (Def);
- El_Typ : Type_Acc;
- Typ : Type_Acc;
- begin
- Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type);
- El_Typ := Get_Subtype_Object (Syn_Inst, El_Type);
-
- if El_Typ.Kind in Type_Nets and then Ndims = 1 then
- Typ := Create_Unbounded_Vector (El_Typ);
- else
- Typ := Create_Unbounded_Array (Dim_Type (Ndims), El_Typ);
- end if;
- return Typ;
- end Synth_Array_Type_Definition;
-
- function Synth_Record_Type_Definition
- (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
- is
- El_List : constant Node_Flist := Get_Elements_Declaration_List (Def);
- Rec_Els : Rec_El_Array_Acc;
- El : Node;
- El_Type : Node;
- El_Typ : Type_Acc;
- begin
- Rec_Els := Create_Rec_El_Array
- (Iir_Index32 (Get_Nbr_Elements (El_List)));
-
- for I in Flist_First .. Flist_Last (El_List) loop
- El := Get_Nth_Element (El_List, I);
- El_Type := Get_Type (El);
- El_Typ := Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type);
- Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ;
- end loop;
-
- if not Is_Fully_Constrained_Type (Def) then
- return Create_Unbounded_Record (Rec_Els);
- else
- return Create_Record_Type (Rec_Els);
- end if;
- end Synth_Record_Type_Definition;
-
- function Synth_Access_Type_Definition
- (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
- is
- Des_Type : constant Node := Get_Designated_Type (Def);
- Des_Typ : Type_Acc;
- Typ : Type_Acc;
- begin
- Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type);
- Des_Typ := Get_Subtype_Object (Syn_Inst, Des_Type);
-
- Typ := Create_Access_Type (Des_Typ);
- return Typ;
- end Synth_Access_Type_Definition;
-
- function Synth_File_Type_Definition
- (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
- is
- File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def));
- File_Typ : Type_Acc;
- Typ : Type_Acc;
- Sig : String_Acc;
- begin
- File_Typ := Get_Subtype_Object (Syn_Inst, File_Type);
-
- if Get_Text_File_Flag (Def)
- or else
- Get_Kind (File_Type) in Iir_Kinds_Scalar_Type_And_Subtype_Definition
- then
- Sig := null;
- else
- declare
- Sig_Str : String (1 .. Get_File_Signature_Length (File_Type) + 2);
- Off : Natural := Sig_Str'First;
- begin
- Get_File_Signature (File_Type, Sig_Str, Off);
- Sig_Str (Off + 0) := '.';
- Sig_Str (Off + 1) := ASCII.NUL;
- Sig := new String'(Sig_Str);
- end;
- end if;
-
- Typ := Create_File_Type (File_Typ);
- Typ.File_Signature := Sig;
-
- return Typ;
- end Synth_File_Type_Definition;
-
- function Scalar_Size_To_Size (Def : Node) return Size_Type is
- begin
- case Get_Scalar_Size (Def) is
- when Scalar_8 =>
- return 1;
- when Scalar_16 =>
- return 2;
- when Scalar_32 =>
- return 4;
- when Scalar_64 =>
- return 8;
- end case;
- end Scalar_Size_To_Size;
-
- procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
- is
- Typ : Type_Acc;
- begin
- case Get_Kind (Def) is
- when Iir_Kind_Enumeration_Type_Definition =>
- if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type
- or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
- then
- Typ := Logic_Type;
- elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then
- Typ := Boolean_Type;
- elsif Def = Vhdl.Std_Package.Bit_Type_Definition then
- Typ := Bit_Type;
- else
- declare
- Nbr_El : constant Natural :=
- Get_Nbr_Elements (Get_Enumeration_Literal_List (Def));
- Rng : Discrete_Range_Type;
- W : Width;
- begin
- W := Uns32 (Clog2 (Uns64 (Nbr_El)));
- Rng := (Dir => Dir_To,
- Is_Signed => False,
- Left => 0,
- Right => Int64 (Nbr_El - 1));
- Typ := Create_Discrete_Type
- (Rng, Scalar_Size_To_Size (Def), W);
- end;
- end if;
- when Iir_Kind_Array_Type_Definition =>
- Typ := Synth_Array_Type_Definition (Syn_Inst, Def);
- when Iir_Kind_Access_Type_Definition =>
- Typ := Synth_Access_Type_Definition (Syn_Inst, Def);
- when Iir_Kind_File_Type_Definition =>
- Typ := Synth_File_Type_Definition (Syn_Inst, Def);
- when Iir_Kind_Record_Type_Definition =>
- Typ := Synth_Record_Type_Definition (Syn_Inst, Def);
- when Iir_Kind_Protected_Type_Declaration =>
- Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Def));
- when others =>
- Vhdl.Errors.Error_Kind ("synth_type_definition", Def);
- end case;
- if Typ /= null then
- Create_Subtype_Object (Syn_Inst, Def, Typ);
- end if;
- end Synth_Type_Definition;
-
- procedure Synth_Anonymous_Type_Definition
- (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node)
- is
- Typ : Type_Acc;
- begin
- case Get_Kind (Def) is
- when Iir_Kind_Integer_Type_Definition
- | Iir_Kind_Physical_Type_Definition =>
- declare
- Cst : constant Node := Get_Range_Constraint (St);
- L, R : Int64;
- Rng : Discrete_Range_Type;
- W : Width;
- begin
- L := Get_Value (Get_Left_Limit (Cst));
- R := Get_Value (Get_Right_Limit (Cst));
- Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst));
- W := Discrete_Range_Width (Rng);
- Typ := Create_Discrete_Type
- (Rng, Scalar_Size_To_Size (Def), W);
- end;
- when Iir_Kind_Floating_Type_Definition =>
- declare
- Cst : constant Node := Get_Range_Constraint (St);
- L, R : Fp64;
- Rng : Float_Range_Type;
- begin
- L := Get_Fp_Value (Get_Left_Limit (Cst));
- R := Get_Fp_Value (Get_Right_Limit (Cst));
- Rng := (Get_Direction (Cst), L, R);
- Typ := Create_Float_Type (Rng);
- end;
- when Iir_Kind_Array_Type_Definition =>
- Typ := Synth_Array_Type_Definition (Syn_Inst, Def);
- when others =>
- Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def);
- end case;
- Create_Subtype_Object (Syn_Inst, Def, Typ);
- end Synth_Anonymous_Type_Definition;
-
- function Synth_Discrete_Range_Constraint
- (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type
- is
- Res : Discrete_Range_Type;
- begin
- Synth_Discrete_Range (Syn_Inst, Rng, Res);
- return Res;
- end Synth_Discrete_Range_Constraint;
-
- function Synth_Float_Range_Constraint
- (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is
- begin
- case Get_Kind (Rng) is
- when Iir_Kind_Range_Expression =>
- -- FIXME: check range.
- return Synth_Float_Range_Expression (Syn_Inst, Rng);
- when others =>
- Vhdl.Errors.Error_Kind ("synth_float_range_constraint", Rng);
- end case;
- end Synth_Float_Range_Constraint;
-
- function Has_Element_Subtype_Indication (Atype : Node) return Boolean is
- begin
- return Get_Array_Element_Constraint (Atype) /= Null_Node
- or else
- (Get_Resolution_Indication (Atype) /= Null_Node
- and then
- (Get_Kind (Get_Resolution_Indication (Atype))
- = Iir_Kind_Array_Element_Resolution));
- end Has_Element_Subtype_Indication;
-
- function Synth_Array_Subtype_Indication
- (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc
- is
- El_Type : constant Node := Get_Element_Subtype (Atype);
- St_Indexes : constant Node_Flist := Get_Index_Subtype_List (Atype);
- Ptype : Node;
- St_El : Node;
- Btyp : Type_Acc;
- Etyp : Type_Acc;
- Bnds : Bound_Array_Acc;
- begin
- -- VHDL08
- if Has_Element_Subtype_Indication (Atype) then
- -- This subtype has created a new anonymous subtype for the
- -- element.
- Synth_Subtype_Indication (Syn_Inst, El_Type);
- end if;
-
- if not Get_Index_Constraint_Flag (Atype) then
- Ptype := Get_Type (Get_Subtype_Type_Mark (Atype));
- if Get_Element_Subtype (Ptype) = Get_Element_Subtype (Atype) then
- -- That's an alias.
- -- FIXME: maybe a resolution function was added?
- -- FIXME: also handle resolution added in element subtype.
- return Get_Subtype_Object (Syn_Inst, Ptype);
- end if;
- end if;
-
- Btyp := Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype));
- case Btyp.Kind is
- when Type_Unbounded_Vector =>
- if Get_Index_Constraint_Flag (Atype) then
- St_El := Get_Index_Type (St_Indexes, 0);
- return Create_Vector_Type
- (Synth_Bounds_From_Range (Syn_Inst, St_El), Btyp.Uvec_El);
- else
- -- An alias.
- -- Handle vhdl08 definition of std_logic_vector from
- -- std_ulogic_vector.
- return Btyp;
- end if;
- when Type_Unbounded_Array =>
- -- FIXME: partially constrained arrays, subtype in indexes...
- Etyp := Get_Subtype_Object (Syn_Inst, El_Type);
- if Get_Index_Constraint_Flag (Atype) then
- Bnds := Create_Bound_Array
- (Dim_Type (Get_Nbr_Elements (St_Indexes)));
- for I in Flist_First .. Flist_Last (St_Indexes) loop
- St_El := Get_Index_Type (St_Indexes, I);
- Bnds.D (Dim_Type (I + 1)) :=
- Synth_Bounds_From_Range (Syn_Inst, St_El);
- end loop;
- return Create_Array_Type (Bnds, Etyp);
- else
- raise Internal_Error;
- end if;
- when others =>
- raise Internal_Error;
- end case;
- end Synth_Array_Subtype_Indication;
-
- function Synth_Subtype_Indication
- (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is
- begin
- -- TODO: handle aliases directly.
- case Get_Kind (Atype) is
- when Iir_Kind_Array_Subtype_Definition =>
- return Synth_Array_Subtype_Indication (Syn_Inst, Atype);
- when Iir_Kind_Record_Subtype_Definition =>
- return Synth_Record_Type_Definition (Syn_Inst, Atype);
- when Iir_Kind_Integer_Subtype_Definition
- | Iir_Kind_Physical_Subtype_Definition
- | Iir_Kind_Enumeration_Subtype_Definition =>
- declare
- Btype : constant Type_Acc :=
- Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype));
- Rng : Discrete_Range_Type;
- W : Width;
- begin
- if Btype.Kind in Type_Nets then
- -- A subtype of a bit/logic type is still a bit/logic.
- -- FIXME: bounds.
- return Btype;
- else
- Rng := Synth_Discrete_Range_Constraint
- (Syn_Inst, Get_Range_Constraint (Atype));
- W := Discrete_Range_Width (Rng);
- return Create_Discrete_Type (Rng, Btype.Sz, W);
- end if;
- end;
- when Iir_Kind_Floating_Subtype_Definition =>
- declare
- Rng : Float_Range_Type;
- begin
- Rng := Synth_Float_Range_Constraint
- (Syn_Inst, Get_Range_Constraint (Atype));
- return Create_Float_Type (Rng);
- end;
- when others =>
- Vhdl.Errors.Error_Kind ("synth_subtype_indication", Atype);
- end case;
- end Synth_Subtype_Indication;
-
- procedure Synth_Subtype_Indication
- (Syn_Inst : Synth_Instance_Acc; Atype : Node)
- is
- Typ : Type_Acc;
- begin
- Typ := Synth_Subtype_Indication (Syn_Inst, Atype);
- Create_Subtype_Object (Syn_Inst, Atype, Typ);
- end Synth_Subtype_Indication;
-
- function Get_Declaration_Type (Decl : Node) return Node
- is
- Ind : constant Node := Get_Subtype_Indication (Decl);
- Atype : Node;
- begin
- if Get_Is_Ref (Decl) or else Ind = Null_Iir then
- -- A secondary declaration in a list.
- return Null_Node;
- end if;
- Atype := Ind;
- loop
- case Get_Kind (Atype) is
- when Iir_Kinds_Denoting_Name =>
- Atype := Get_Named_Entity (Atype);
- when Iir_Kind_Subtype_Declaration
- | Iir_Kind_Type_Declaration =>
- -- Type already declared, so already handled.
- return Null_Node;
- when Iir_Kind_Array_Subtype_Definition
- | Iir_Kind_Record_Subtype_Definition
- | Iir_Kind_Integer_Subtype_Definition
- | Iir_Kind_Floating_Subtype_Definition
- | Iir_Kind_Physical_Subtype_Definition
- | Iir_Kind_Enumeration_Subtype_Definition =>
- return Atype;
- when others =>
- Vhdl.Errors.Error_Kind ("get_declaration_type", Atype);
- end case;
- end loop;
- end Get_Declaration_Type;
-
- procedure Synth_Declaration_Type
- (Syn_Inst : Synth_Instance_Acc; Decl : Node)
- is
- Atype : constant Node := Get_Declaration_Type (Decl);
- begin
- if Atype = Null_Node then
- return;
- end if;
- Synth_Subtype_Indication (Syn_Inst, Atype);
- end Synth_Declaration_Type;
-
procedure Synth_Constant_Declaration (Syn_Inst : Synth_Instance_Acc;
Decl : Node;
Is_Subprg : Boolean;
@@ -529,7 +135,7 @@ package body Synth.Vhdl_Decls is
Cst : Valtyp;
Obj_Type : Type_Acc;
begin
- Synth_Declaration_Type (Syn_Inst, Decl);
+ Elab_Declaration_Type (Syn_Inst, Decl);
if Deferred_Decl = Null_Node
or else Get_Deferred_Declaration_Flag (Decl)
then
@@ -616,7 +222,7 @@ package body Synth.Vhdl_Decls is
| Iir_Kind_Interface_Signal_Declaration =>
V := Get_Value (Syn_Inst, Obj);
pragma Assert (V.Val.Kind = Value_Wire);
- Inst := Get_Net_Parent (Get_Wire_Gate (V.Val.W));
+ Inst := Get_Net_Parent (Get_Wire_Gate (Get_Value_Wire (V.Val)));
when Iir_Kind_Component_Instantiation_Statement =>
-- TODO
return;
@@ -667,59 +273,30 @@ package body Synth.Vhdl_Decls is
Create_Object (Syn_Inst, Value, Val);
-- Unshare (Val, Instance_Pool);
- if not Get_Instance_Const (Syn_Inst) then
- Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val);
- end if;
-
Value := Get_Spec_Chain (Value);
end loop;
end Synth_Attribute_Specification;
- procedure Synth_Subprogram_Declaration
- (Syn_Inst : Synth_Instance_Acc; Subprg : Node)
+ procedure Synth_Concurrent_Attribute_Specification
+ (Syn_Inst : Synth_Instance_Acc; Spec : Node)
is
- Inter : Node;
+ Attr_Decl : constant Node :=
+ Get_Named_Entity (Get_Attribute_Designator (Spec));
+ Value : Node;
+ Val : Valtyp;
begin
- if Is_Second_Subprogram_Specification (Subprg) then
- -- Already handled.
+ if Get_Instance_Const (Syn_Inst) then
return;
end if;
- Inter := Get_Interface_Declaration_Chain (Subprg);
- while Inter /= Null_Node loop
- Synth_Declaration_Type (Syn_Inst, Inter);
- Inter := Get_Chain (Inter);
- end loop;
- end Synth_Subprogram_Declaration;
-
- procedure Synth_Convertible_Declarations (Syn_Inst : Synth_Instance_Acc)
- is
- use Vhdl.Std_Package;
- begin
- Create_Subtype_Object
- (Syn_Inst, Convertible_Integer_Type_Definition,
- Get_Subtype_Object (Syn_Inst, Universal_Integer_Type_Definition));
- Create_Subtype_Object
- (Syn_Inst, Convertible_Real_Type_Definition,
- Get_Subtype_Object (Syn_Inst, Universal_Real_Type_Definition));
- end Synth_Convertible_Declarations;
+ Value := Get_Attribute_Value_Spec_Chain (Spec);
+ while Value /= Null_Iir loop
+ Val := Get_Value (Syn_Inst, Value);
+ Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val);
- function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc;
- Pkg : Node)
- return Synth_Instance_Acc
- is
- Syn_Inst : Synth_Instance_Acc;
- begin
- Syn_Inst := Make_Instance (Parent_Inst, Pkg);
- if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then
- -- Global package.
- Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, True);
- else
- -- Local package: check elaboration order.
- Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, False);
- end if;
- return Syn_Inst;
- end Create_Package_Instance;
+ Value := Get_Spec_Chain (Value);
+ end loop;
+ end Synth_Concurrent_Attribute_Specification;
procedure Synth_Package_Declaration
(Parent_Inst : Synth_Instance_Acc; Pkg : Node)
@@ -731,12 +308,10 @@ package body Synth.Vhdl_Decls is
return;
end if;
- Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg);
+ Syn_Inst := Get_Package_Object (Parent_Inst, Pkg);
+ Set_Extra (Syn_Inst, Parent_Inst, No_Sname);
- Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg));
- if Pkg = Vhdl.Std_Package.Standard_Package then
- Synth_Convertible_Declarations (Syn_Inst);
- end if;
+ Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg));
end Synth_Package_Declaration;
procedure Synth_Package_Body
@@ -751,97 +326,18 @@ package body Synth.Vhdl_Decls is
Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg);
- Synth_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod));
+ Synth_Concurrent_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod));
end Synth_Package_Body;
- procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
- Syn_Inst : Synth_Instance_Acc;
- Inter_Chain : Node;
- Assoc_Chain : Node)
- is
- Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
- Inter : Node;
- Inter_Type : Type_Acc;
- Assoc : Node;
- Assoc_Inter : Node;
- Actual : Node;
- Val : Valtyp;
- begin
- Assoc := Assoc_Chain;
- Assoc_Inter := Inter_Chain;
- while Is_Valid (Assoc) loop
- Inter := Get_Association_Interface (Assoc, Assoc_Inter);
- case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
- when Iir_Kind_Interface_Constant_Declaration =>
- Synth_Declaration_Type (Sub_Inst, Inter);
- Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
-
- case Get_Kind (Assoc) is
- when Iir_Kind_Association_Element_Open =>
- Actual := Get_Default_Value (Inter);
- Val := Synth_Expression_With_Type
- (Sub_Inst, Actual, Inter_Type);
- when Iir_Kind_Association_Element_By_Expression =>
- Actual := Get_Actual (Assoc);
- Val := Synth_Expression_With_Type
- (Syn_Inst, Actual, Inter_Type);
- when others =>
- raise Internal_Error;
- end case;
-
- Val := Synth_Subtype_Conversion
- (Ctxt, Val, Inter_Type, True, Assoc);
-
- if Val = No_Valtyp then
- Set_Error (Sub_Inst);
- elsif not Is_Static (Val.Val) then
- Error_Msg_Synth
- (+Assoc, "value of generic %i must be static", +Inter);
- Val := No_Valtyp;
- Set_Error (Sub_Inst);
- end if;
-
- Create_Object (Sub_Inst, Inter, Val);
-
- when Iir_Kind_Interface_Package_Declaration =>
- declare
- Actual : constant Iir :=
- Strip_Denoting_Name (Get_Actual (Assoc));
- Pkg_Inst : Synth_Instance_Acc;
- begin
- Pkg_Inst := Get_Package_Object (Sub_Inst, Actual);
- Create_Package_Interface (Sub_Inst, Inter, Pkg_Inst);
- end;
-
- when Iir_Kind_Interface_Variable_Declaration
- | Iir_Kind_Interface_File_Declaration
- | Iir_Kind_Interface_Signal_Declaration
- | Iir_Kind_Interface_Quantity_Declaration
- | Iir_Kind_Interface_Terminal_Declaration =>
- raise Internal_Error;
-
- when Iir_Kinds_Interface_Subprogram_Declaration
- | Iir_Kind_Interface_Type_Declaration =>
- raise Internal_Error;
- end case;
-
- Next_Association_Interface (Assoc, Assoc_Inter);
- end loop;
- end Synth_Generics_Association;
-
procedure Synth_Package_Instantiation
(Parent_Inst : Synth_Instance_Acc; Pkg : Node)
is
Bod : constant Node := Get_Instance_Package_Body (Pkg);
Sub_Inst : Synth_Instance_Acc;
begin
- Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg);
-
- Synth_Generics_Association
- (Sub_Inst, Parent_Inst,
- Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg));
+ Sub_Inst := Get_Package_Object (Parent_Inst, Pkg);
- Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg));
+ Synth_Concurrent_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg));
if Bod /= Null_Node then
-- Macro expanded package instantiation.
@@ -855,7 +351,7 @@ package body Synth.Vhdl_Decls is
Set_Uninstantiated_Scope (Sub_Inst, Uninst);
-- Synth declarations of (optional) body.
if Uninst_Bod /= Null_Node then
- Synth_Declarations
+ Synth_Concurrent_Declarations
(Sub_Inst, Get_Declaration_Chain (Uninst_Bod));
end if;
end;
@@ -870,10 +366,11 @@ package body Synth.Vhdl_Decls is
Def : constant Node := Get_Default_Value (Decl);
Decl_Type : constant Node := Get_Type (Decl);
Init : Valtyp;
+ Val : Valtyp;
Obj_Typ : Type_Acc;
Wid : Wire_Id;
begin
- Synth_Declaration_Type (Syn_Inst, Decl);
+ Elab_Declaration_Type (Syn_Inst, Decl);
if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then
Error_Msg_Synth
(+Decl, "protected type variable is not synthesizable");
@@ -910,9 +407,9 @@ package body Synth.Vhdl_Decls is
Init := Unshare (Init, Current_Pool);
Create_Object (Syn_Inst, Decl, Init);
else
- Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
- Create_Var_Wire (Syn_Inst, Decl, Init);
- Wid := Get_Value (Syn_Inst, Decl).Val.W;
+ Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init);
+ Create_Object (Syn_Inst, Decl, Val);
+ Wid := Get_Value_Wire (Val.Val);
if Is_Subprg then
if Is_Static (Init.Val) then
Phi_Assign_Static (Wid, Get_Memtyp (Init));
@@ -924,36 +421,39 @@ package body Synth.Vhdl_Decls is
end if;
end Synth_Variable_Declaration;
+ procedure Synth_Shared_Variable_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node)
+ is
+ Init : Valtyp;
+ Val : Valtyp;
+ begin
+ Init := Get_Value (Syn_Inst, Decl);
+
+ Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init);
+ Mutate_Object (Syn_Inst, Decl, Val);
+ end Synth_Shared_Variable_Declaration;
+
procedure Synth_Signal_Declaration (Syn_Inst : Synth_Instance_Acc;
Decl : Node)
is
- Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
- Def : constant Iir := Get_Default_Value (Decl);
- -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+ Prev : Valtyp;
Init : Valtyp;
- Obj_Typ : Type_Acc;
+ Val : Valtyp;
begin
- Synth_Declaration_Type (Syn_Inst, Decl);
if Get_Kind (Get_Parent (Decl)) = Iir_Kind_Package_Declaration then
Error_Msg_Synth (+Decl, "signals in packages are not supported");
- -- Avoid elaboration error.
- Create_Object (Syn_Inst, Decl, No_Valtyp);
return;
end if;
- Create_Wire_Object (Syn_Inst, Wire_Signal, Decl);
- if Is_Valid (Def) then
- Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
- Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
- Init := Synth_Subtype_Conversion (Ctxt, Init, Obj_Typ, False, Decl);
- if not Is_Static (Init.Val) then
- Error_Msg_Synth (+Decl, "signals cannot be used in default value "
- & "of a signal");
- end if;
+ Prev := Get_Value (Syn_Inst, Decl);
+ if Prev.Val.Init = null then
+ Init := (Prev.Typ, null);
else
- Init := No_Valtyp;
+ Init := (Prev.Typ, Prev.Val.Init);
end if;
- Create_Var_Wire (Syn_Inst, Decl, Init);
+
+ Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Signal, Init);
+ Replace_Signal (Syn_Inst, Decl, Val);
end Synth_Signal_Declaration;
procedure Synth_Object_Alias_Declaration
@@ -983,7 +483,8 @@ package body Synth.Vhdl_Decls is
-- Object is a net if it is not writable. Extract the
-- bits for the alias.
Res := Create_Value_Net
- (Build2_Extract (Ctxt, Base.Val.N, Off.Net_Off, Typ.W),
+ (Build2_Extract (Ctxt,
+ Get_Value_Net (Base.Val), Off.Net_Off, Typ.W),
Typ);
else
Res := Create_Value_Alias (Base, Off, Typ);
@@ -994,6 +495,36 @@ package body Synth.Vhdl_Decls is
Create_Object (Syn_Inst, Decl, Res);
end Synth_Object_Alias_Declaration;
+ procedure Synth_Concurrent_Object_Alias_Declaration
+ (Syn_Inst : Synth_Instance_Acc; Decl : Node)
+ is
+ Val : Valtyp;
+ Aval : Valtyp;
+ Obj : Value_Acc;
+ Base : Node;
+ begin
+ Val := Get_Value (Syn_Inst, Decl);
+ pragma Assert (Val.Val.Kind = Value_Alias);
+ Obj := Val.Val.A_Obj;
+ if Obj.Kind = Value_Signal then
+ -- A signal must have been changed to a wire or a net, but the
+ -- aliases have not been updated. Update here.
+ Base := Get_Base_Name (Get_Name (Decl));
+ Aval := Synth_Expression (Syn_Inst, Base);
+
+ if Aval.Val.Kind = Value_Net then
+ -- Object is a net if it is not writable. Extract the
+ -- bits for the alias.
+ Aval := Create_Value_Net
+ (Build2_Extract (Get_Build (Syn_Inst), Get_Value_Net (Aval.Val),
+ Val.Val.A_Off.Net_Off, Val.Typ.W),
+ Val.Typ);
+ Val.Val.A_Off := (0, 0);
+ end if;
+ Val.Val.A_Obj := Aval.Val;
+ end if;
+ end Synth_Concurrent_Object_Alias_Declaration;
+
procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc;
Decl : Node;
Is_Subprg : Boolean;
@@ -1004,8 +535,15 @@ package body Synth.Vhdl_Decls is
Synth_Variable_Declaration (Syn_Inst, Decl, Is_Subprg);
when Iir_Kind_Interface_Variable_Declaration =>
-- Ignore default value.
- Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
- Create_Var_Wire (Syn_Inst, Decl, No_Valtyp);
+ declare
+ Val : Valtyp;
+ Obj_Typ : Type_Acc;
+ begin
+ Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
+ Val := Create_Var_Wire
+ (Syn_Inst, Decl, Wire_Variable, (Obj_Typ, null));
+ Create_Object (Syn_Inst, Decl, Val);
+ end;
when Iir_Kind_Constant_Declaration =>
Synth_Constant_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type);
when Iir_Kind_Signal_Declaration =>
@@ -1015,7 +553,7 @@ package body Synth.Vhdl_Decls is
Synth_Object_Alias_Declaration (Syn_Inst, Decl);
when Iir_Kind_Procedure_Declaration
| Iir_Kind_Function_Declaration =>
- Synth_Subprogram_Declaration (Syn_Inst, Decl);
+ Elab_Subprogram_Declaration (Syn_Inst, Decl);
when Iir_Kind_Procedure_Body
| Iir_Kind_Function_Body =>
null;
@@ -1028,13 +566,13 @@ package body Synth.Vhdl_Decls is
when Iir_Kind_Attribute_Specification =>
Synth_Attribute_Specification (Syn_Inst, Decl);
when Iir_Kind_Type_Declaration =>
- Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl));
+ Elab_Type_Definition (Syn_Inst, Get_Type_Definition (Decl));
when Iir_Kind_Anonymous_Type_Declaration =>
- Synth_Anonymous_Type_Definition
+ Elab_Anonymous_Type_Definition
(Syn_Inst, Get_Type_Definition (Decl),
Get_Subtype_Definition (Decl));
when Iir_Kind_Subtype_Declaration =>
- Synth_Declaration_Type (Syn_Inst, Decl);
+ Elab_Declaration_Type (Syn_Inst, Decl);
when Iir_Kind_Component_Declaration =>
null;
when Iir_Kind_File_Declaration =>
@@ -1043,7 +581,7 @@ package body Synth.Vhdl_Decls is
Res : Valtyp;
Obj_Typ : Type_Acc;
begin
- F := Synth.Vhdl_Files.Elaborate_File_Declaration
+ F := Elab.Vhdl_Files.Elaborate_File_Declaration
(Syn_Inst, Decl);
Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
Res := Create_Value_File (Obj_Typ, F);
@@ -1067,7 +605,7 @@ package body Synth.Vhdl_Decls is
end Synth_Declaration;
procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc;
- Decls : Iir;
+ Decls : Node;
Is_Subprg : Boolean := False)
is
Decl : Node;
@@ -1093,6 +631,7 @@ package body Synth.Vhdl_Decls is
Gate : Instance;
Drv : Net;
Def_Val : Net;
+ W : Wire_Id;
begin
Vt := Get_Value (Syn_Inst, Decl);
if Vt = No_Valtyp then
@@ -1105,9 +644,11 @@ package body Synth.Vhdl_Decls is
return;
end if;
- Finalize_Assignment (Get_Build (Syn_Inst), Vt.Val.W);
+ W := Get_Value_Wire (Vt.Val);
+
+ Finalize_Assignment (Get_Build (Syn_Inst), W);
- Gate_Net := Get_Wire_Gate (Vt.Val.W);
+ Gate_Net := Get_Wire_Gate (W);
Gate := Get_Net_Parent (Gate_Net);
case Get_Id (Gate) is
when Id_Signal
@@ -1147,7 +688,7 @@ package body Synth.Vhdl_Decls is
Connect (Get_Input (Gate, 0), Def_Val);
end if;
- Free_Wire (Vt.Val.W);
+ Free_Wire (W);
end Finalize_Signal;
procedure Finalize_Declaration
@@ -1203,10 +744,10 @@ package body Synth.Vhdl_Decls is
end Finalize_Declaration;
procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
- Decls : Iir;
+ Decls : Node;
Is_Subprg : Boolean := False)
is
- Decl : Iir;
+ Decl : Node;
begin
Decl := Decls;
while Is_Valid (Decl) loop
@@ -1215,4 +756,50 @@ package body Synth.Vhdl_Decls is
Decl := Get_Chain (Decl);
end loop;
end Finalize_Declarations;
+
+ procedure Synth_Concurrent_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node) is
+ begin
+ case Get_Kind (Decl) is
+ when Iir_Kind_Signal_Declaration =>
+ Synth_Signal_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Variable_Declaration =>
+ Synth_Shared_Variable_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Constant_Declaration
+ | Iir_Kind_Function_Declaration
+ | Iir_Kind_Function_Body
+ | Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Procedure_Body
+ | Iir_Kind_Type_Declaration
+ | Iir_Kind_Anonymous_Type_Declaration
+ | Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Component_Declaration
+ | Iir_Kind_File_Declaration
+ | Iir_Kind_Attribute_Declaration
+ | Iir_Kind_Configuration_Specification
+ | Iir_Kind_Psl_Default_Clock
+ | Iir_Kind_Non_Object_Alias_Declaration
+ | Iir_Kind_Use_Clause =>
+ -- Fully handled during elaboration.
+ null;
+ when Iir_Kind_Object_Alias_Declaration =>
+ Synth_Concurrent_Object_Alias_Declaration (Syn_Inst, Decl);
+ when Iir_Kind_Attribute_Specification =>
+ Synth_Concurrent_Attribute_Specification (Syn_Inst, Decl);
+ when others =>
+ Vhdl.Errors.Error_Kind ("synth_concurrent_declaration", Decl);
+ end case;
+ end Synth_Concurrent_Declaration;
+
+ procedure Synth_Concurrent_Declarations (Syn_Inst : Synth_Instance_Acc;
+ Decls : Node)
+ is
+ Decl : Node;
+ begin
+ Decl := Decls;
+ while Decl /= Null_Node loop
+ Synth_Concurrent_Declaration (Syn_Inst, Decl);
+ Decl := Get_Chain (Decl);
+ end loop;
+ end Synth_Concurrent_Declarations;
end Synth.Vhdl_Decls;
diff --git a/src/synth/synth-vhdl_decls.ads b/src/synth/synth-vhdl_decls.ads
index fa1569430..5ad59853e 100644
--- a/src/synth/synth-vhdl_decls.ads
+++ b/src/synth/synth-vhdl_decls.ads
@@ -18,9 +18,10 @@
with Vhdl.Nodes; use Vhdl.Nodes;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+
with Netlists; use Netlists;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
-with Synth.Objtypes; use Synth.Objtypes;
package Synth.Vhdl_Decls is
-- Return the Param_Type for ATYPE.
@@ -29,23 +30,7 @@ package Synth.Vhdl_Decls is
-- Convert MT to a Pval.
function Memtyp_To_Pval (Mt : Memtyp) return Pval;
- -- Get the type of DECL iff it is standalone (not an already existing
- -- subtype).
- function Get_Declaration_Type (Decl : Node) return Node;
-
- -- True if the element subtype indication of ATYPE needs to be created.
- function Has_Element_Subtype_Indication (Atype : Node) return Boolean;
-
- function Synth_Array_Subtype_Indication
- (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc;
-
- procedure Synth_Subtype_Indication
- (Syn_Inst : Synth_Instance_Acc; Atype : Node);
- function Synth_Subtype_Indication
- (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc;
-
- -- Elaborate the type of DECL.
- procedure Synth_Declaration_Type
+ procedure Synth_Object_Alias_Declaration
(Syn_Inst : Synth_Instance_Acc; Decl : Node);
procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc;
@@ -54,14 +39,19 @@ package Synth.Vhdl_Decls is
Last_Type : in out Node);
procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc;
- Decls : Iir;
+ Decls : Node;
Is_Subprg : Boolean := False);
+ procedure Synth_Concurrent_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node);
+ procedure Synth_Concurrent_Declarations (Syn_Inst : Synth_Instance_Acc;
+ Decls : Node);
+
procedure Finalize_Declaration (Syn_Inst : Synth_Instance_Acc;
- Decl : Iir;
+ Decl : Node;
Is_Subprg : Boolean);
procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
- Decls : Iir;
+ Decls : Node;
Is_Subprg : Boolean := False);
procedure Synth_Package_Declaration
@@ -69,11 +59,6 @@ package Synth.Vhdl_Decls is
procedure Synth_Package_Body
(Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node);
- procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
- Syn_Inst : Synth_Instance_Acc;
- Inter_Chain : Node;
- Assoc_Chain : Node);
-
procedure Synth_Package_Instantiation
(Parent_Inst : Synth_Instance_Acc; Pkg : Node);
end Synth.Vhdl_Decls;
diff --git a/src/synth/synth-vhdl_environment.ads b/src/synth/synth-vhdl_environment.ads
index e9bf6129f..1a65b2a07 100644
--- a/src/synth/synth-vhdl_environment.ads
+++ b/src/synth/synth-vhdl_environment.ads
@@ -23,10 +23,10 @@ with Netlists.Builders;
with Vhdl.Nodes;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+
with Synth.Environment;
with Synth.Environment.Debug;
-with Synth.Objtypes; use Synth.Objtypes;
--- with Synth_Vhdl.Context;
package Synth.Vhdl_Environment is
@@ -52,7 +52,7 @@ package Synth.Vhdl_Environment is
package Env is new Synth.Environment
(Decl_Type => Decl_Type,
- Static_Type => Standard.Synth.Objtypes.Memtyp,
+ Static_Type => Elab.Vhdl_Objtypes.Memtyp,
Get_Width => Get_Bitwidth,
Is_Equal => Is_Equal,
Static_To_Net => Memtyp_To_Net,
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index 1b0030b2c..2717d5eec 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -39,15 +39,17 @@ with Netlists.Folds; use Netlists.Folds;
with Netlists.Utils; use Netlists.Utils;
with Netlists.Locations;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Heap; use Elab.Vhdl_Heap;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Debugger;
+
with Synth.Errors; use Synth.Errors;
with Synth.Vhdl_Environment;
-with Synth.Vhdl_Decls;
with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
with Synth.Vhdl_Oper; use Synth.Vhdl_Oper;
-with Synth.Vhdl_Heap; use Synth.Vhdl_Heap;
-with Synth.Debugger;
with Synth.Vhdl_Aggr;
+with Synth.Vhdl_Context; use Synth.Vhdl_Context;
with Grt.Types;
with Grt.To_Strings;
@@ -67,7 +69,8 @@ package body Synth.Vhdl_Expr is
when Value_Const =>
return Get_Memtyp (V);
when Value_Wire =>
- return Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W);
+ return Synth.Vhdl_Environment.Env.Get_Static_Wire
+ (Get_Value_Wire (V.Val));
when Value_Alias =>
declare
Res : Memtyp;
@@ -89,7 +92,8 @@ package body Synth.Vhdl_Expr is
return Read_Discrete (Get_Memtyp (V));
when Value_Wire =>
return Read_Discrete
- (Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W));
+ (Synth.Vhdl_Environment.Env.Get_Static_Wire
+ (Get_Value_Wire (V.Val)));
when others =>
raise Internal_Error;
end case;
@@ -107,15 +111,19 @@ package body Synth.Vhdl_Expr is
| Value_Memory =>
return Read_Discrete (Get_Memtyp (V)) >= 0;
when Value_Net =>
- N := V.Val.N;
+ N := Get_Value_Net (V.Val);
when Value_Wire =>
- if Get_Kind (V.Val.W) = Wire_Variable
- and then Is_Static_Wire (V.Val.W)
- then
- return Read_Discrete (Get_Static_Wire (V.Val.W)) >= 0;
- else
- return False;
- end if;
+ declare
+ W : constant Wire_Id := Get_Value_Wire (V.Val);
+ begin
+ if Get_Kind (W) = Wire_Variable
+ and then Is_Static_Wire (W)
+ then
+ return Read_Discrete (Get_Static_Wire (W)) >= 0;
+ else
+ return False;
+ end if;
+ end;
when others =>
raise Internal_Error;
end case;
@@ -429,206 +437,6 @@ package body Synth.Vhdl_Expr is
N := Arr (Arr'First);
end Concat_Array;
- function Build_Discrete_Range_Type
- (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type is
- begin
- return (Dir => Dir,
- Left => L,
- Right => R,
- Is_Signed => L < 0 or R < 0);
- end Build_Discrete_Range_Type;
-
- function Synth_Discrete_Range_Expression
- (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type
- is
- L, R : Valtyp;
- Lval, Rval : Int64;
- begin
- -- Static values.
- L := Synth_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng));
- R := Synth_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng));
- Strip_Const (L);
- Strip_Const (R);
-
- if not (Is_Static (L.Val) and Is_Static (R.Val)) then
- Error_Msg_Synth (+Rng, "limits of range are not constant");
- Set_Error (Syn_Inst);
- return (Dir => Get_Direction (Rng),
- Left => 0,
- Right => 0,
- Is_Signed => False);
- end if;
-
- Lval := Read_Discrete (L);
- Rval := Read_Discrete (R);
- return Build_Discrete_Range_Type (Lval, Rval, Get_Direction (Rng));
- end Synth_Discrete_Range_Expression;
-
- function Synth_Float_Range_Expression
- (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type
- is
- L, R : Valtyp;
- begin
- -- Static values (so no enable).
- L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng));
- R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng));
- return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R));
- end Synth_Float_Range_Expression;
-
- -- Return the type of EXPR without evaluating it.
- function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
- return Type_Acc is
- begin
- case Get_Kind (Expr) is
- when Iir_Kinds_Object_Declaration =>
- declare
- Val : constant Valtyp := Get_Value (Syn_Inst, Expr);
- begin
- return Val.Typ;
- end;
- when Iir_Kind_Simple_Name =>
- return Synth_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr));
- when Iir_Kind_Slice_Name =>
- declare
- Pfx_Typ : Type_Acc;
- Pfx_Bnd : Bound_Type;
- El_Typ : Type_Acc;
- Res_Bnd : Bound_Type;
- Sl_Voff : Net;
- Sl_Off : Value_Offsets;
- begin
- Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
- Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ);
- Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ,
- Res_Bnd, Sl_Voff, Sl_Off);
-
- if Sl_Voff /= No_Net then
- raise Internal_Error;
- end if;
- return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd);
- end;
- when Iir_Kind_Indexed_Name =>
- declare
- Pfx_Typ : Type_Acc;
- begin
- Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
- return Get_Array_Element (Pfx_Typ);
- end;
- when Iir_Kind_Selected_Element =>
- declare
- Idx : constant Iir_Index32 :=
- Get_Element_Position (Get_Named_Entity (Expr));
- Pfx_Typ : Type_Acc;
- begin
- Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
- return Pfx_Typ.Rec.E (Idx + 1).Typ;
- end;
-
- when Iir_Kind_Implicit_Dereference
- | Iir_Kind_Dereference =>
- declare
- Val : Valtyp;
- Res : Valtyp;
- begin
- -- Maybe do not dereference it if its type is known ?
- Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr));
- Res := Vhdl_Heap.Synth_Dereference (Read_Access (Val));
- return Res.Typ;
- end;
-
- when Iir_Kind_String_Literal8 =>
- -- TODO: the value should be computed (once) and its type
- -- returned.
- return Synth.Vhdl_Decls.Synth_Subtype_Indication
- (Syn_Inst, Get_Type (Expr));
-
- when others =>
- Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr);
- end case;
- return null;
- end Synth_Type_Of_Object;
-
- function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
- return Bound_Type
- is
- Prefix_Name : constant Iir := Get_Prefix (Attr);
- Prefix : constant Iir := Strip_Denoting_Name (Prefix_Name);
- Dim : constant Natural :=
- Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr);
- Typ : Type_Acc;
- Val : Valtyp;
- begin
- -- Prefix is an array object or an array subtype.
- if Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration then
- -- TODO: does this cover all the cases ?
- Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix));
- else
- Val := Synth_Expression_With_Basetype (Syn_Inst, Prefix_Name);
- Typ := Val.Typ;
- end if;
-
- return Get_Array_Bound (Typ, Dim_Type (Dim));
- end Synth_Array_Attribute;
-
- procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
- Bound : Node;
- Rng : out Discrete_Range_Type) is
- begin
- case Get_Kind (Bound) is
- when Iir_Kind_Range_Expression =>
- Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound);
- when Iir_Kind_Integer_Subtype_Definition
- | Iir_Kind_Enumeration_Subtype_Definition =>
- if Get_Type_Declarator (Bound) /= Null_Node then
- declare
- Typ : Type_Acc;
- begin
- -- This is a named subtype, so it has been evaluated.
- Typ := Get_Subtype_Object (Syn_Inst, Bound);
- Rng := Typ.Drange;
- end;
- else
- Synth_Discrete_Range
- (Syn_Inst, Get_Range_Constraint (Bound), Rng);
- end if;
- when Iir_Kind_Range_Array_Attribute =>
- declare
- B : Bound_Type;
- begin
- B := Synth_Array_Attribute (Syn_Inst, Bound);
- Rng := Build_Discrete_Range_Type
- (Int64 (B.Left), Int64 (B.Right), B.Dir);
- end;
- when Iir_Kind_Reverse_Range_Array_Attribute =>
- declare
- B : Bound_Type;
- T : Int32;
- begin
- B := Synth_Array_Attribute (Syn_Inst, Bound);
- -- Reverse
- case B.Dir is
- when Dir_To =>
- B.Dir := Dir_Downto;
- when Dir_Downto =>
- B.Dir := Dir_To;
- end case;
- T := B.Right;
- B.Right := B.Left;
- B.Left := T;
-
- Rng := Build_Discrete_Range_Type
- (Int64 (B.Left), Int64 (B.Right), B.Dir);
- end;
- when Iir_Kinds_Denoting_Name =>
- -- A discrete subtype name.
- Synth_Discrete_Range
- (Syn_Inst, Get_Subtype_Indication (Get_Named_Entity (Bound)),
- Rng);
- when others =>
- Error_Kind ("synth_discrete_range", Bound);
- end case;
- end Synth_Discrete_Range;
-
function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc;
Atype : Node;
Dim : Dim_Type) return Bound_Type
@@ -660,17 +468,6 @@ package body Synth.Vhdl_Expr is
end if;
end Synth_Array_Bounds;
- function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc;
- Atype : Node) return Bound_Type
- is
- Rng : Discrete_Range_Type;
- begin
- Synth_Discrete_Range (Syn_Inst, Atype, Rng);
- return (Dir => Rng.Dir,
- Left => Int32 (Rng.Left), Right => Int32 (Rng.Right),
- Len => Get_Range_Length (Rng));
- end Synth_Bounds_From_Range;
-
function Synth_Bounds_From_Length (Atype : Node; Len : Int32)
return Bound_Type
is
@@ -737,9 +534,9 @@ package body Synth.Vhdl_Expr is
begin
case Val.Val.Kind is
when Value_Wire =>
- return Create_Value_Wire (Val.Val.W, Ntype);
+ return Create_Value_Wire (Get_Value_Wire (Val.Val), Ntype);
when Value_Net =>
- return Create_Value_Net (Val.Val.N, Ntype);
+ return Create_Value_Net (Get_Value_Net (Val.Val), Ntype);
when Value_Alias =>
return Create_Value_Alias
((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype);
@@ -884,6 +681,18 @@ package body Synth.Vhdl_Expr is
end case;
end Synth_Subtype_Conversion;
+ function Synth_Subtype_Conversion (Syn_Inst : Synth_Instance_Acc;
+ Vt : Valtyp;
+ Dtype : Type_Acc;
+ Bounds : Boolean;
+ Loc : Source.Syn_Src)
+ return Valtyp
+ is
+ Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ begin
+ return Synth_Subtype_Conversion (Ctxt, Vt, Dtype, Bounds, Loc);
+ end Synth_Subtype_Conversion;
+
function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
return Valtyp
is
@@ -1076,7 +885,7 @@ package body Synth.Vhdl_Expr is
Val : Valtyp;
begin
Val := Synth_Expression (Syn_Inst, Get_Prefix (Name));
- return Vhdl_Heap.Synth_Dereference (Read_Access (Val));
+ return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));
end;
when others =>
Error_Kind ("synth_name", Name);
@@ -1093,7 +902,7 @@ package body Synth.Vhdl_Expr is
begin
if not In_Bounds (Bnd, Int32 (Idx)) then
Error_Msg_Synth (+Loc, "index not within bounds");
- Synth.Debugger.Debug_Error (Syn_Inst, Loc);
+ Elab.Debugger.Debug_Error (Syn_Inst, Loc);
return (0, 0);
end if;
@@ -1522,7 +1331,7 @@ package body Synth.Vhdl_Expr is
or else not In_Bounds (Pfx_Bnd, Int32 (R))
then
Error_Msg_Synth (+Name, "index not within bounds");
- Synth.Debugger.Debug_Error (Syn_Inst, Expr);
+ Elab.Debugger.Debug_Error (Syn_Inst, Expr);
Off := (0, 0);
return;
end if;
@@ -2247,7 +2056,7 @@ package body Synth.Vhdl_Expr is
and then Get_Static_Discrete (Left) = Val
then
-- Short-circuit when the left operand determines the result.
- return Create_Value_Discrete (Val, Boolean_Type);
+ return Create_Value_Discrete (Val, Typ);
end if;
Strip_Const (Left);
@@ -2262,21 +2071,21 @@ package body Synth.Vhdl_Expr is
and then Get_Static_Discrete (Right) = Val
then
-- If the right operand can determine the result, return it.
- return Create_Value_Discrete (Val, Boolean_Type);
+ return Create_Value_Discrete (Val, Typ);
end if;
-- Return a static value if both operands are static.
-- Note: we know the value of left if it is not constant.
if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then
Val := Get_Static_Discrete (Right);
- return Create_Value_Discrete (Val, Boolean_Type);
+ return Create_Value_Discrete (Val, Typ);
end if;
-- Non-static result.
N := Build_Dyadic (Ctxt, Id,
Get_Net (Ctxt, Left), Get_Net (Ctxt, Right));
Set_Location (N, Expr);
- return Create_Value_Net (N, Boolean_Type);
+ return Create_Value_Net (N, Typ);
end Synth_Short_Circuit;
function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc;
@@ -2353,13 +2162,16 @@ package body Synth.Vhdl_Expr is
| Iir_Kind_Selected_Name
| Iir_Kind_Interface_Signal_Declaration -- For PSL.
| Iir_Kind_Signal_Declaration -- For PSL.
+ | Iir_Kind_Object_Alias_Declaration
| Iir_Kind_Implicit_Dereference
| Iir_Kind_Dereference =>
declare
Res : Valtyp;
begin
Res := Synth_Name (Syn_Inst, Expr);
- if Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory then
+ if Res.Typ /= null
+ and then Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory
+ then
-- This is a null object. As nothing can be done about it,
-- returns 0.
return Create_Value_Memtyp (Create_Memory_Zero (Res.Typ));
@@ -2565,7 +2377,7 @@ package body Synth.Vhdl_Expr is
T : Type_Acc;
Acc : Heap_Index;
begin
- T := Synth.Vhdl_Decls.Synth_Subtype_Indication
+ T := Synth_Subtype_Indication
(Syn_Inst, Get_Subtype_Indication (Expr));
Acc := Allocate_By_Type (T);
return Create_Value_Access (Acc, Expr_Type);
diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads
index c6726732e..7081aef95 100644
--- a/src/synth/synth-vhdl_expr.ads
+++ b/src/synth/synth-vhdl_expr.ads
@@ -23,13 +23,14 @@ with Types; use Types;
with PSL.Types;
with Vhdl.Nodes; use Vhdl.Nodes;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
with Netlists; use Netlists;
with Netlists.Builders; use Netlists.Builders;
with Synth.Source;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
package Synth.Vhdl_Expr is
-- Perform a subtype conversion. Check constraints.
@@ -40,6 +41,13 @@ package Synth.Vhdl_Expr is
Loc : Source.Syn_Src)
return Valtyp;
+ function Synth_Subtype_Conversion (Syn_Inst : Synth_Instance_Acc;
+ Vt : Valtyp;
+ Dtype : Type_Acc;
+ Bounds : Boolean;
+ Loc : Source.Syn_Src)
+ return Valtyp;
+
-- For a static value V, return the value.
function Get_Static_Discrete (V : Valtyp) return Int64;
@@ -93,24 +101,10 @@ package Synth.Vhdl_Expr is
function Synth_PSL_Expression
(Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net;
- function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc;
- Atype : Node) return Bound_Type;
-
function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc;
Atype : Node;
Dim : Dim_Type) return Bound_Type;
- function Build_Discrete_Range_Type
- (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type;
- function Synth_Discrete_Range_Expression
- (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type;
- function Synth_Float_Range_Expression
- (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type;
-
- procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
- Bound : Node;
- Rng : out Discrete_Range_Type);
-
procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc;
Name : Node;
Pfx_Bnd : Bound_Type;
@@ -127,13 +121,7 @@ package Synth.Vhdl_Expr is
Voff : out Net;
Off : out Value_Offsets);
- -- Return the type of EXPR (an object) without evaluating it (except when
- -- needed, like bounds of a slice).
- function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
- return Type_Acc;
-
-- Conversion to logic vector.
-
type Digit_Index is new Natural;
type Logvec_Array is array (Digit_Index range <>) of Logic_32;
type Logvec_Array_Acc is access Logvec_Array;
diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb
index 1297c71b9..5394834ab 100644
--- a/src/synth/synth-vhdl_insts.adb
+++ b/src/synth/synth-vhdl_insts.adb
@@ -21,7 +21,6 @@ with GNAT.SHA1;
with Types; use Types;
with Types_Utils; use Types_Utils;
with Name_Table;
-with Libraries;
with Hash; use Hash;
with Dyn_Tables;
with Interning;
@@ -34,24 +33,27 @@ with Netlists.Builders; use Netlists.Builders;
with Netlists.Concats;
with Netlists.Folds;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Errors;
with Vhdl.Ieee.Math_Real;
-with Synth.Memtype; use Synth.Memtype;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Files;
+with Elab.Debugger;
+
with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
with Synth.Vhdl_Decls; use Synth.Vhdl_Decls;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Source; use Synth.Source;
-with Synth.Debugger;
-with Synth.Vhdl_Files;
with Synth.Errors;
+with Synth.Vhdl_Context; use Synth.Vhdl_Context;
package body Synth.Vhdl_Insts is
- Root_Instance : Synth_Instance_Acc;
+ Global_Base_Instance : Base_Instance_Acc;
function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is
begin
@@ -202,6 +204,7 @@ package body Synth.Vhdl_Insts is
Hash_Const (C, Val.A_Obj, Typ);
when Value_Net
| Value_Wire
+ | Value_Signal
| Value_File =>
raise Internal_Error;
end case;
@@ -335,35 +338,6 @@ package body Synth.Vhdl_Insts is
return New_Sname_User (Get_Encoded_Name_Id (Decl, Enc), No_Sname);
end Create_Inter_Name;
- procedure Copy_Object_Subtype (Syn_Inst : Synth_Instance_Acc;
- Inter_Type : Node;
- Proto_Inst : Synth_Instance_Acc)
- is
- Inter_Typ : Type_Acc;
- begin
- case Get_Kind (Inter_Type) is
- when Iir_Kind_Array_Subtype_Definition =>
- if Synth.Vhdl_Decls.Has_Element_Subtype_Indication (Inter_Type)
- then
- Copy_Object_Subtype
- (Syn_Inst, Get_Element_Subtype (Inter_Type), Proto_Inst);
- end if;
- when others =>
- null;
- end case;
- Inter_Typ := Get_Subtype_Object (Proto_Inst, Inter_Type);
- Create_Subtype_Object (Syn_Inst, Inter_Type, Inter_Typ);
- end Copy_Object_Subtype;
-
- procedure Build_Object_Subtype (Syn_Inst : Synth_Instance_Acc;
- Inter : Node;
- Proto_Inst : Synth_Instance_Acc) is
- begin
- if Get_Declaration_Type (Inter) /= Null_Node then
- Copy_Object_Subtype (Syn_Inst, Get_Type (Inter), Proto_Inst);
- end if;
- end Build_Object_Subtype;
-
-- Return the number of ports for a type. A record type create one
-- port per immediate subelement. Sub-records are not expanded.
function Count_Nbr_Ports (Typ : Type_Acc) return Port_Nbr is
@@ -442,8 +416,6 @@ package body Synth.Vhdl_Insts is
is
Decl : constant Node := Params.Decl;
Arch : constant Node := Params.Arch;
- Imp : Node;
- Syn_Inst : Synth_Instance_Acc;
Inter : Node;
Inter_Typ : Type_Acc;
Nbr_Inputs : Port_Nbr;
@@ -453,28 +425,10 @@ package body Synth.Vhdl_Insts is
Val : Valtyp;
Id : Module_Id;
begin
- if Get_Kind (Params.Decl) = Iir_Kind_Component_Declaration then
- pragma Assert (Params.Arch = Null_Node);
- pragma Assert (Params.Config = Null_Node);
- Imp := Params.Decl;
- else
- pragma Assert
- (Get_Kind (Params.Config) = Iir_Kind_Block_Configuration);
- Imp := Params.Arch;
- end if;
-
- -- Create the instance.
- Syn_Inst := Make_Instance (Root_Instance, Imp, No_Sname);
-
-- Copy values for generics.
Inter := Get_Generic_Chain (Decl);
Nbr_Params := 0;
while Inter /= Null_Node loop
- -- Bounds or range of the type.
- Build_Object_Subtype (Syn_Inst, Inter, Params.Syn_Inst);
-
- -- Object.
- Create_Object (Syn_Inst, Inter, Get_Value (Params.Syn_Inst, Inter));
Nbr_Params := Nbr_Params + 1;
Inter := Get_Chain (Inter);
end loop;
@@ -484,12 +438,6 @@ package body Synth.Vhdl_Insts is
Nbr_Inputs := 0;
Nbr_Outputs := 0;
while Is_Valid (Inter) loop
- -- Copy the type from PARAMS if needed. The subtype indication of
- -- the port may reference objects that aren't anymore reachable
- -- (particularly if it is a port of a component). So the subtype
- -- cannot be regularly elaborated.
- -- Also, for unconstrained subtypes, we need the constraint.
- Build_Object_Subtype (Syn_Inst, Inter, Params.Syn_Inst);
Inter_Typ := Get_Value (Params.Syn_Inst, Inter).Typ;
case Mode_To_Port_Kind (Get_Mode (Inter)) is
@@ -501,7 +449,7 @@ package body Synth.Vhdl_Insts is
Val := Create_Value_Wire (No_Wire_Id, Inter_Typ);
Nbr_Outputs := Nbr_Outputs + Count_Nbr_Ports (Inter_Typ);
end case;
- Create_Object (Syn_Inst, Inter, Val);
+ Replace_Signal (Params.Syn_Inst, Inter, Val);
Inter := Get_Chain (Inter);
end loop;
@@ -552,7 +500,7 @@ package body Synth.Vhdl_Insts is
Nbr_Outputs := 0;
while Is_Valid (Inter) loop
Pkind := Mode_To_Port_Kind (Get_Mode (Inter));
- Vt := Get_Value (Syn_Inst, Inter);
+ Vt := Get_Value (Params.Syn_Inst, Inter);
case Pkind is
when Port_In =>
@@ -572,10 +520,12 @@ package body Synth.Vhdl_Insts is
Set_Ports_Desc (Cur_Module, Inports, Outports);
end;
+ Set_Extra (Params.Syn_Inst, Global_Base_Instance, No_Sname);
+
return Inst_Object'(Decl => Decl,
Arch => Arch,
Config => Params.Config,
- Syn_Inst => Syn_Inst,
+ Syn_Inst => Params.Syn_Inst,
M => Cur_Module,
Encoding => Params.Encoding);
end Build;
@@ -980,92 +930,18 @@ package body Synth.Vhdl_Insts is
end if;
end Synth_Instantiate_Module;
- function Synth_Port_Association_Type (Sub_Inst : Synth_Instance_Acc;
- Syn_Inst : Synth_Instance_Acc;
- Inter : Node;
- Assoc : Node) return Type_Acc is
- begin
- if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
- -- TODO
- -- Find the association for this interface
- -- * if individual assoc: get type
- -- * if whole assoc: get type from object.
- if Assoc = Null_Node then
- raise Internal_Error;
- end if;
- case Get_Kind (Assoc) is
- when Iir_Kinds_Association_Element_By_Actual =>
- return Synth_Type_Of_Object (Syn_Inst, Get_Actual (Assoc));
- when others =>
- raise Internal_Error;
- end case;
- else
- Synth_Declaration_Type (Sub_Inst, Inter);
- return Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
- end if;
- end Synth_Port_Association_Type;
-
- procedure Synth_Ports_Association_Type (Sub_Inst : Synth_Instance_Acc;
- Syn_Inst : Synth_Instance_Acc;
- Inter_Chain : Node;
- Assoc_Chain : Node)
- is
- Inter : Node;
- Assoc : Node;
- Assoc_Inter : Node;
- Val : Valtyp;
- Inter_Typ : Type_Acc;
- begin
- Assoc := Assoc_Chain;
- Assoc_Inter := Inter_Chain;
- while Is_Valid (Assoc) loop
- Inter := Get_Association_Interface (Assoc, Assoc_Inter);
- if Get_Whole_Association_Flag (Assoc) then
- Inter_Typ := Synth_Port_Association_Type
- (Sub_Inst, Syn_Inst, Inter, Assoc);
- case Mode_To_Port_Kind (Get_Mode (Inter)) is
- when Port_In =>
- Val := Create_Value_Net (No_Net, Inter_Typ);
- when Port_Out
- | Port_Inout =>
- Val := Create_Value_Wire (No_Wire_Id, Inter_Typ);
- end case;
- Create_Object (Sub_Inst, Inter, Val);
- end if;
- Next_Association_Interface (Assoc, Assoc_Inter);
- end loop;
- end Synth_Ports_Association_Type;
-
procedure Synth_Direct_Instantiation_Statement
(Syn_Inst : Synth_Instance_Acc;
Stmt : Node;
+ Sub_Inst : Synth_Instance_Acc;
Ent : Node;
Arch : Node;
Config : Node)
is
- Sub_Inst : Synth_Instance_Acc;
Inst_Obj : Inst_Object;
Inst : Instance;
Enc : Name_Encoding;
begin
- -- Elaborate generic + map aspect
- Sub_Inst := Make_Instance
- (Syn_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname));
-
- Synth_Generics_Association (Sub_Inst, Syn_Inst,
- Get_Generic_Chain (Ent),
- Get_Generic_Map_Aspect_Chain (Stmt));
-
- -- Elaborate port types.
- Synth_Ports_Association_Type (Sub_Inst, Syn_Inst,
- Get_Port_Chain (Ent),
- Get_Port_Map_Aspect_Chain (Stmt));
-
- if Is_Error (Sub_Inst) then
- -- TODO: Free it?
- return;
- end if;
-
if Arch /= Null_Node then
-- For whiteboxes: append parameters or/and hash.
Enc := Name_Hash;
@@ -1085,8 +961,8 @@ package body Synth.Vhdl_Insts is
Syn_Inst => Sub_Inst,
Encoding => Enc));
- -- TODO: free sub_inst.
+ -- Do the instantiation.
Inst := New_Instance
(Get_Instance_Module (Syn_Inst),
Inst_Obj.M,
@@ -1104,43 +980,26 @@ package body Synth.Vhdl_Insts is
procedure Synth_Design_Instantiation_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
- Aspect : constant Iir := Get_Instantiated_Unit (Stmt);
- Arch : Node;
- Ent : Node;
- Config : Node;
+ Sub_Inst : constant Synth_Instance_Acc :=
+ Get_Sub_Instance (Syn_Inst, Stmt);
+ Arch : constant Node := Get_Source_Scope (Sub_Inst);
+ Ent : constant Node := Get_Entity (Arch);
+ Config : constant Node := Get_Instance_Config (Sub_Inst);
begin
- -- Load configured entity + architecture
- case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is
- when Iir_Kind_Entity_Aspect_Entity =>
- Arch := Get_Architecture (Aspect);
- if Arch = Null_Node then
- Arch := Libraries.Get_Latest_Architecture (Get_Entity (Aspect));
- else
- Arch := Strip_Denoting_Name (Arch);
- end if;
- Config := Get_Library_Unit
- (Get_Default_Configuration_Declaration (Arch));
- when Iir_Kind_Entity_Aspect_Configuration =>
- Config := Get_Configuration (Aspect);
- Arch := Get_Block_Specification (Get_Block_Configuration (Config));
- when Iir_Kind_Entity_Aspect_Open =>
- return;
- end case;
- Config := Get_Block_Configuration (Config);
- Ent := Get_Entity (Arch);
-
Synth_Direct_Instantiation_Statement
- (Syn_Inst, Stmt, Ent, Arch, Config);
+ (Syn_Inst, Stmt, Sub_Inst, Ent, Arch, Config);
end Synth_Design_Instantiation_Statement;
procedure Synth_Blackbox_Instantiation_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
+ Sub_Inst : constant Synth_Instance_Acc :=
+ Get_Sub_Instance (Syn_Inst, Stmt);
Comp : constant Node :=
Get_Named_Entity (Get_Instantiated_Unit (Stmt));
begin
Synth_Direct_Instantiation_Statement
- (Syn_Inst, Stmt, Comp, Null_Node, Null_Node);
+ (Syn_Inst, Stmt, Sub_Inst, Comp, Null_Node, Null_Node);
end Synth_Blackbox_Instantiation_Statement;
procedure Create_Component_Wire (Ctxt : Context_Acc;
@@ -1155,12 +1014,13 @@ package body Synth.Vhdl_Insts is
case Val.Val.Kind is
when Value_Wire =>
-- Create a gate for the output, so that it could be read.
- Val.Val.W := Alloc_Wire (Wire_Output, (Inter, Bit_Type));
+ Set_Value_Wire
+ (Val.Val, Alloc_Wire (Wire_Output, (Inter, Bit_Type)));
W := Get_Type_Width (Val.Typ);
Value := Build_Signal
(Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W);
Set_Location (Value, Loc);
- Set_Wire_Gate (Val.Val.W, Value);
+ Set_Wire_Gate (Get_Value_Wire (Val.Val), Value);
when others =>
raise Internal_Error;
end case;
@@ -1170,12 +1030,13 @@ package body Synth.Vhdl_Insts is
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ Comp_Inst : constant Synth_Instance_Acc :=
+ Get_Sub_Instance (Syn_Inst, Stmt);
+ Config : constant Node := Get_Instance_Config (Comp_Inst);
Component : constant Node :=
Get_Named_Entity (Get_Instantiated_Unit (Stmt));
- Config : constant Node := Get_Component_Configuration (Stmt);
Bind : constant Node := Get_Binding_Indication (Config);
Aspect : constant Node := Get_Entity_Aspect (Bind);
- Comp_Inst : Synth_Instance_Acc;
Ent : Node;
Arch : Node;
@@ -1185,7 +1046,6 @@ package body Synth.Vhdl_Insts is
Inst : Instance;
Inst_Name : Sname;
begin
- pragma Assert (Get_Component_Configuration (Stmt) /= Null_Node);
pragma Assert (Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity);
Push_Phi;
@@ -1193,15 +1053,7 @@ package body Synth.Vhdl_Insts is
Inst_Name := New_Sname_User (Get_Identifier (Stmt),
Get_Sname (Syn_Inst));
- -- Create the sub-instance for the component
- -- Elaborate generic + map aspect
- Comp_Inst := Make_Instance
- (Syn_Inst, Component,
- New_Sname_User (Get_Identifier (Component), No_Sname));
-
- Synth_Generics_Association (Comp_Inst, Syn_Inst,
- Get_Generic_Chain (Component),
- Get_Generic_Map_Aspect_Chain (Stmt));
+ Set_Extra (Comp_Inst, Syn_Inst, Inst_Name);
-- Create objects for the inputs and the outputs of the component,
-- assign inputs (that's nets) and create wires for outputs.
@@ -1218,9 +1070,8 @@ package body Synth.Vhdl_Insts is
while Is_Valid (Assoc) loop
if Get_Whole_Association_Flag (Assoc) then
Inter := Get_Association_Interface (Assoc, Assoc_Inter);
-
- Inter_Typ := Synth_Port_Association_Type
- (Comp_Inst, Syn_Inst, Inter, Assoc);
+ Val := Get_Value (Comp_Inst, Inter);
+ Inter_Typ := Val.Typ;
case Mode_To_Port_Kind (Get_Mode (Inter)) is
when Port_In =>
@@ -1234,46 +1085,25 @@ package body Synth.Vhdl_Insts is
(Get_Build (Syn_Inst), Assoc_Inter, Val, Inst_Name,
Assoc);
end case;
- Create_Object (Comp_Inst, Assoc_Inter, Val);
+ Replace_Signal (Comp_Inst, Assoc_Inter, Val);
end if;
Next_Association_Interface (Assoc, Assoc_Inter);
end loop;
end;
- -- Extract entity/architecture instantiated by the component.
- case Get_Kind (Aspect) is
- when Iir_Kind_Entity_Aspect_Entity =>
- Ent := Get_Entity (Aspect);
- Arch := Get_Architecture (Aspect);
- when others =>
- Vhdl.Errors.Error_Kind
- ("Synth_Component_Instantiation_Statement(2)", Aspect);
- end case;
+ Sub_Inst := Get_Component_Instance (Comp_Inst);
+ Arch := Get_Source_Scope (Sub_Inst);
+ Ent := Get_Entity (Arch);
+ Sub_Config := Get_Instance_Config (Sub_Inst);
if Get_Kind (Ent) = Iir_Kind_Foreign_Module then
-- TODO.
raise Internal_Error;
end if;
- if Arch = Null_Node then
- Arch := Libraries.Get_Latest_Architecture (Ent);
- else
- Arch := Get_Named_Entity (Arch);
- end if;
- Sub_Config := Get_Library_Unit
- (Get_Default_Configuration_Declaration (Arch));
- Sub_Config := Get_Block_Configuration (Sub_Config);
-
-- Elaborate generic + map aspect for the entity instance.
- Sub_Inst := Make_Instance
- (Comp_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname));
- Synth_Generics_Association (Sub_Inst, Comp_Inst,
- Get_Generic_Chain (Ent),
- Get_Generic_Map_Aspect_Chain (Bind));
-
- Synth_Ports_Association_Type (Sub_Inst, Comp_Inst,
- Get_Port_Chain (Ent),
- Get_Port_Map_Aspect_Chain (Bind));
+ Set_Extra (Sub_Inst,
+ Comp_Inst, New_Sname_User (Get_Identifier (Ent), No_Sname));
-- Search if corresponding module has already been used.
-- If not create a new module
@@ -1387,17 +1217,13 @@ package body Synth.Vhdl_Insts is
procedure Synth_Top_Entity (Base : Base_Instance_Acc;
Design_Unit : Node;
Encoding : Name_Encoding;
- Inst : out Synth_Instance_Acc)
+ Syn_Inst : Synth_Instance_Acc)
is
Lib_Unit : constant Node := Get_Library_Unit (Design_Unit);
Arch : Node;
Entity : Node;
Config : Node;
- Syn_Inst : Synth_Instance_Acc;
- Inter : Node;
- Inter_Typ : Type_Acc;
Inst_Obj : Inst_Object;
- Val : Valtyp;
begin
-- Extract architecture from design.
case Get_Kind (Lib_Unit) is
@@ -1414,60 +1240,22 @@ package body Synth.Vhdl_Insts is
end case;
Entity := Get_Entity (Arch);
- Root_Instance := Make_Base_Instance (Base);
+ Make_Base_Instance (Base);
+
+ Global_Base_Instance := Base;
Insts_Interning.Init;
if Flags.Flag_Debug_Init then
- Synth.Debugger.Debug_Init (Arch);
+ Elab.Debugger.Debug_Init (Arch);
end if;
-- Dependencies first.
Synth_Dependencies (Root_Instance, Get_Design_Unit (Entity));
Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch));
- Syn_Inst := Make_Instance
- (Root_Instance, Arch,
- New_Sname_User (Get_Identifier (Entity), No_Sname));
-
- -- Compute generics.
- Inter := Get_Generic_Chain (Entity);
- while Is_Valid (Inter) loop
- Synth_Declaration_Type (Syn_Inst, Inter);
- declare
- Val : Valtyp;
- Inter_Typ : Type_Acc;
- begin
- Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter));
- Val := Synth_Expression_With_Type
- (Syn_Inst, Get_Default_Value (Inter), Inter_Typ);
- pragma Assert (Is_Static (Val.Val));
- Create_Object (Syn_Inst, Inter, Val);
- end;
- Inter := Get_Chain (Inter);
- end loop;
-
- -- Elaborate port types.
- -- FIXME: what about unconstrained ports ? Get the type from the
- -- association.
- Inter := Get_Port_Chain (Entity);
- while Is_Valid (Inter) loop
- if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
- -- TODO
- raise Internal_Error;
- end if;
- Synth_Declaration_Type (Syn_Inst, Inter);
- Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter));
- case Mode_To_Port_Kind (Get_Mode (Inter)) is
- when Port_In =>
- Val := Create_Value_Net (No_Net, Inter_Typ);
- when Port_Out
- | Port_Inout =>
- Val := Create_Value_Wire (No_Wire_Id, Inter_Typ);
- end case;
- Create_Object (Syn_Inst, Inter, Val);
- Inter := Get_Chain (Inter);
- end loop;
+ Set_Extra
+ (Syn_Inst, Base, New_Sname_User (Get_Identifier (Entity), No_Sname));
-- Search if corresponding module has already been used.
-- If not create a new module
@@ -1480,16 +1268,20 @@ package body Synth.Vhdl_Insts is
Config => Get_Block_Configuration (Config),
Syn_Inst => Syn_Inst,
Encoding => Encoding));
- Inst := Inst_Obj.Syn_Inst;
+ pragma Unreferenced (Inst_Obj);
end Synth_Top_Entity;
procedure Create_Input_Wire (Syn_Inst : Synth_Instance_Acc;
Self_Inst : Instance;
Idx : in out Port_Idx;
- Val : Valtyp) is
+ Val : Valtyp)
+ is
+ N : Net;
begin
pragma Assert (Val.Val.Kind = Value_Net);
- Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Val.Val.N);
+ N := Get_Value_Net (Val.Val);
+ Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, N);
+ Set_Value_Net (Val.Val, N);
end Create_Input_Wire;
procedure Create_Output_Wire (Syn_Inst : Synth_Instance_Acc;
@@ -1511,7 +1303,7 @@ package body Synth.Vhdl_Insts is
pragma Assert (Val.Val.Kind = Value_Wire);
-- Create a gate for the output, so that it could be read.
- Val.Val.W := Alloc_Wire (Wire_Output, (Inter, Val.Typ));
+ Set_Value_Wire (Val.Val, Alloc_Wire (Wire_Output, (Inter, Val.Typ)));
-- pragma Assert (Desc.W = Get_Type_Width (Val.Typ));
if Default /= Null_Node then
@@ -1548,76 +1340,21 @@ package body Synth.Vhdl_Insts is
Vout := Value;
end if;
Set_Location (Value, Inter);
- Set_Wire_Gate (Val.Val.W, Value);
+ Set_Wire_Gate (Get_Value_Wire (Val.Val), Value);
Inst_Input_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Vout);
end Create_Output_Wire;
- procedure Apply_Block_Configuration (Cfg : Node; Blk : Node)
- is
- Item : Node;
- begin
- -- Be sure CFG applies to BLK.
- pragma Assert (Get_Block_From_Block_Specification
- (Get_Block_Specification (Cfg)) = Blk);
-
- -- Clear_Instantiation_Configuration (Blk);
-
- Item := Get_Configuration_Item_Chain (Cfg);
- while Item /= Null_Node loop
- case Get_Kind (Item) is
- when Iir_Kind_Component_Configuration =>
- declare
- List : constant Iir_Flist :=
- Get_Instantiation_List (Item);
- El : Node;
- Inst : Node;
- begin
- for I in Flist_First .. Flist_Last (List) loop
- El := Get_Nth_Element (List, I);
- Inst := Get_Named_Entity (El);
- pragma Assert
- (Get_Kind (Inst)
- = Iir_Kind_Component_Instantiation_Statement);
- pragma Assert
- (Get_Component_Configuration (Inst) = Null_Node);
- Set_Component_Configuration (Inst, Item);
- end loop;
- end;
- when Iir_Kind_Block_Configuration =>
- declare
- Sub_Blk : constant Node := Get_Block_From_Block_Specification
- (Get_Block_Specification (Item));
- begin
- case Get_Kind (Sub_Blk) is
- when Iir_Kind_Generate_Statement_Body =>
- -- Linked chain.
- Set_Prev_Block_Configuration
- (Item, Get_Generate_Block_Configuration (Sub_Blk));
- Set_Generate_Block_Configuration (Sub_Blk, Item);
- when Iir_Kind_Block_Statement =>
- Set_Block_Block_Configuration (Sub_Blk, Item);
- when others =>
- Vhdl.Errors.Error_Kind
- ("apply_block_configuration(blk)", Sub_Blk);
- end case;
- end;
- when others =>
- Vhdl.Errors.Error_Kind ("apply_block_configuration", Item);
- end case;
- Item := Get_Chain (Item);
- end loop;
- end Apply_Block_Configuration;
-
- procedure Synth_Verification_Units
- (Syn_Inst : Synth_Instance_Acc; Parent : Node)
+ procedure Synth_Verification_Units (Syn_Inst : Synth_Instance_Acc)
is
+ Extra : Synth_Instance_Acc;
Unit : Node;
begin
- Unit := Get_Bound_Vunit_Chain (Parent);
- while Unit /= Null_Node loop
- Synth_Verification_Unit (Syn_Inst, Unit);
- Unit := Get_Bound_Vunit_Chain (Unit);
+ Extra := Get_First_Extra_Instance (Syn_Inst);
+ while Extra /= null loop
+ Unit := Get_Source_Scope (Extra);
+ Synth_Verification_Unit (Extra, Unit, Syn_Inst);
+ Extra := Get_Next_Extra_Instance (Syn_Inst);
end loop;
end Synth_Verification_Units;
@@ -1643,7 +1380,7 @@ package body Synth.Vhdl_Insts is
-- Save the current architecture, so that files can be open using a
-- path relative to the architecture filename.
- Synth.Vhdl_Files.Set_Design_Unit (Arch);
+ Elab.Vhdl_Files.Set_Design_Unit (Arch);
Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch));
@@ -1671,9 +1408,9 @@ package body Synth.Vhdl_Insts is
-- Apply configuration.
-- FIXME: what about inner block configuration ?
pragma Assert (Get_Kind (Inst.Config) = Iir_Kind_Block_Configuration);
- Apply_Block_Configuration (Inst.Config, Arch);
- Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
+ -- Entity
+ Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
if not Is_Error (Syn_Inst) then
Synth_Concurrent_Statements
(Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
@@ -1683,8 +1420,10 @@ package body Synth.Vhdl_Insts is
Synth_Attribute_Values (Syn_Inst, Entity);
end if;
+ -- Architecture
if not Is_Error (Syn_Inst) then
- Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
+ Synth_Concurrent_Declarations
+ (Syn_Inst, Get_Declaration_Chain (Arch));
end if;
if not Is_Error (Syn_Inst) then
Synth_Concurrent_Statements
@@ -1695,13 +1434,12 @@ package body Synth.Vhdl_Insts is
Synth_Attribute_Values (Syn_Inst, Arch);
end if;
+ -- Vunits
if not Is_Error (Syn_Inst) then
- Synth_Verification_Units (Syn_Inst, Entity);
- end if;
- if not Is_Error (Syn_Inst) then
- Synth_Verification_Units (Syn_Inst, Arch);
+ Synth_Verification_Units (Syn_Inst);
end if;
+ -- Finalize
Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity));
diff --git a/src/synth/synth-vhdl_insts.ads b/src/synth/synth-vhdl_insts.ads
index c280475a6..ae7fd715d 100644
--- a/src/synth/synth-vhdl_insts.ads
+++ b/src/synth/synth-vhdl_insts.ads
@@ -16,10 +16,11 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
with Vhdl.Nodes; use Vhdl.Nodes;
with Synth.Context; use Synth.Context;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
with Synth.Flags; use Synth.Flags;
package Synth.Vhdl_Insts is
@@ -27,16 +28,11 @@ package Synth.Vhdl_Insts is
procedure Synth_Top_Entity (Base : Base_Instance_Acc;
Design_Unit : Node;
Encoding : Name_Encoding;
- Inst : out Synth_Instance_Acc);
+ Syn_Inst : Synth_Instance_Acc);
-- Synthesize the top entity and all the sub-modules.
procedure Synth_All_Instances;
- -- Apply block configuration CFG to BLK.
- -- Must be done before synthesis of BLK.
- -- The synthesis of BLK will clear all configuration of it.
- procedure Apply_Block_Configuration (Cfg : Node; Blk : Node);
-
procedure Synth_Design_Instantiation_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node);
procedure Synth_Blackbox_Instantiation_Statement
diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb
index d7d73bcec..c576f2fee 100644
--- a/src/synth/synth-vhdl_oper.adb
+++ b/src/synth/synth-vhdl_oper.adb
@@ -32,12 +32,15 @@ with Netlists.Builders; use Netlists.Builders;
with Netlists.Folds; use Netlists.Folds;
with Netlists.Utils;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+
with Synth.Errors; use Synth.Errors;
with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Source;
with Synth.Static_Oper; use Synth.Static_Oper;
+with Synth.Vhdl_Context; use Synth.Vhdl_Context;
package body Synth.Vhdl_Oper is
procedure Set_Location (N : Net; Loc : Node)
diff --git a/src/synth/synth-vhdl_oper.ads b/src/synth/synth-vhdl_oper.ads
index 7efa711d9..3ae73df3d 100644
--- a/src/synth/synth-vhdl_oper.ads
+++ b/src/synth/synth-vhdl_oper.ads
@@ -18,9 +18,9 @@
with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
package Synth.Vhdl_Oper is
function Synth_Predefined_Function_Call
diff --git a/src/synth/synth-vhdl_static_proc.adb b/src/synth/synth-vhdl_static_proc.adb
index 462896451..5dc31318b 100644
--- a/src/synth/synth-vhdl_static_proc.adb
+++ b/src/synth/synth-vhdl_static_proc.adb
@@ -18,10 +18,11 @@
with Vhdl.Errors; use Vhdl.Errors;
-with Synth.Values; use Synth.Values;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+with Elab.Vhdl_Heap;
+with Elab.Vhdl_Files; use Elab.Vhdl_Files;
+
with Synth.Errors; use Synth.Errors;
-with Synth.Vhdl_Files; use Synth.Vhdl_Files;
-with Synth.Vhdl_Heap;
package body Synth.Vhdl_Static_Proc is
@@ -33,7 +34,7 @@ package body Synth.Vhdl_Static_Proc is
begin
Val := Read_Access (Param);
if Val /= Null_Heap_Index then
- Synth.Vhdl_Heap.Synth_Deallocate (Val);
+ Elab.Vhdl_Heap.Synth_Deallocate (Val);
Write_Access (Param.Val.Mem, Null_Heap_Index);
end if;
end Synth_Deallocate;
diff --git a/src/synth/synth-vhdl_static_proc.ads b/src/synth/synth-vhdl_static_proc.ads
index 4fceb6c9d..c7bedbcce 100644
--- a/src/synth/synth-vhdl_static_proc.ads
+++ b/src/synth/synth-vhdl_static_proc.ads
@@ -16,7 +16,8 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
with Vhdl.Nodes; use Vhdl.Nodes;
package Synth.Vhdl_Static_Proc is
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index 81394abdb..989942244 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -41,16 +41,20 @@ with PSL.Nodes;
with PSL.Subsets;
with PSL.NFAs;
-with Synth.Memtype; use Synth.Memtype;
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Heap;
+with Elab.Vhdl_Types; use Elab.Vhdl_Types;
+with Elab.Vhdl_Expr;
+with Elab.Debugger;
+
with Synth.Errors; use Synth.Errors;
with Synth.Vhdl_Decls; use Synth.Vhdl_Decls;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Vhdl_Insts; use Synth.Vhdl_Insts;
with Synth.Source;
with Synth.Vhdl_Static_Proc;
-with Synth.Vhdl_Heap;
with Synth.Flags;
-with Synth.Debugger;
+with Synth.Vhdl_Context; use Synth.Vhdl_Context;
with Netlists.Builders; use Netlists.Builders;
with Netlists.Folds; use Netlists.Folds;
@@ -244,7 +248,8 @@ package body Synth.Vhdl_Stmts is
if Dest_Off /= (0, 0) and then Dest_Dyn.Voff /= No_Net then
raise Internal_Error;
end if;
- Dest_Base := Vhdl_Heap.Synth_Dereference (Read_Access (Dest_Base));
+ Dest_Base := Elab.Vhdl_Heap.Synth_Dereference
+ (Read_Access (Dest_Base));
Dest_Typ := Dest_Base.Typ;
when others =>
@@ -320,7 +325,7 @@ package body Synth.Vhdl_Stmts is
while Choice /= Null_Node loop
pragma Assert (Get_Kind (Choice) = Iir_Kind_Choice_By_None);
El := Get_Associated_Expr (Choice);
- El_Typ := Synth_Type_Of_Object (Syn_Inst, El);
+ El_Typ := Elab.Vhdl_Expr.Exec_Type_Of_Object (Syn_Inst, El);
Bnd := Get_Array_Bound (El_Typ, 1);
Len := Len + Bnd.Len;
Choice := Get_Chain (Choice);
@@ -487,6 +492,7 @@ package body Synth.Vhdl_Stmts is
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
V : Valtyp;
+ W : Wire_Id;
begin
V := Synth_Subtype_Conversion (Ctxt, Val, Target.Targ_Type, False, Loc);
pragma Unreferenced (Val);
@@ -507,19 +513,19 @@ package body Synth.Vhdl_Stmts is
end if;
if Target.Obj.Val.Kind = Value_Wire then
+ W := Get_Value_Wire (Target.Obj.Val);
if Is_Static (V.Val)
and then V.Typ.Sz = Target.Obj.Typ.Sz
then
pragma Assert (Target.Off = (0, 0));
- Phi_Assign_Static
- (Target.Obj.Val.W, Unshare (Get_Memtyp (V)));
+ Phi_Assign_Static (W, Unshare (Get_Memtyp (V)));
else
if V.Typ.W = 0 then
-- Forget about null wires.
return;
end if;
- Phi_Assign_Net (Ctxt, Target.Obj.Val.W,
- Get_Net (Ctxt, V), Target.Off.Net_Off);
+ Phi_Assign_Net
+ (Ctxt, W, Get_Net (Ctxt, V), Target.Off.Net_Off);
end if;
else
if not Is_Static (V.Val) then
@@ -535,16 +541,16 @@ package body Synth.Vhdl_Stmts is
when Target_Memory =>
declare
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ W : constant Wire_Id := Get_Value_Wire (Target.Mem_Obj.Val);
N : Net;
begin
N := Get_Current_Assign_Value
- (Ctxt, Target.Mem_Obj.Val.W,
+ (Ctxt, W,
Target.Mem_Dyn.Pfx_Off.Net_Off, Target.Mem_Dyn.Pfx_Typ.W);
N := Build_Dyn_Insert (Ctxt, N, Get_Net (Ctxt, V),
Target.Mem_Dyn.Voff, Target.Mem_Doff);
Set_Location (N, Loc);
- Phi_Assign_Net (Ctxt, Target.Mem_Obj.Val.W, N,
- Target.Mem_Dyn.Pfx_Off.Net_Off);
+ Phi_Assign_Net (Ctxt, W, N, Target.Mem_Dyn.Pfx_Off.Net_Off);
end;
end case;
end Synth_Assignment;
@@ -1910,6 +1916,7 @@ package body Synth.Vhdl_Stmts is
Assoc_Inter : Node;
Val : Valtyp;
Nbr_Inout : Natural;
+ W : Wire_Id;
begin
Nbr_Inout := 0;
pragma Assert (Init.Kind = Association_Function);
@@ -1928,8 +1935,9 @@ package body Synth.Vhdl_Stmts is
-- Free wire used for out/inout interface variables.
if Val.Val.Kind = Value_Wire then
- Phi_Discard_Wires (Val.Val.W, No_Wire_Id);
- Free_Wire (Val.Val.W);
+ W := Get_Value_Wire (Val.Val);
+ Phi_Discard_Wires (W, No_Wire_Id);
+ Free_Wire (W);
end if;
end if;
@@ -2136,8 +2144,10 @@ package body Synth.Vhdl_Stmts is
Areapools.Mark (Area_Mark, Instance_Pool.all);
Up_Inst := Get_Instance_By_Scope (Syn_Inst, Get_Parent_Scope (Imp));
- Sub_Inst := Make_Instance (Up_Inst, Bod, New_Internal_Name (Ctxt));
- Set_Instance_Base (Sub_Inst, Syn_Inst);
+ Sub_Inst := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node);
+ if Ctxt /= null then
+ Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
+ end if;
Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos);
@@ -2145,7 +2155,7 @@ package body Synth.Vhdl_Stmts is
Res := No_Valtyp;
else
if not Is_Func then
- if Get_Purity_State (Imp) /= Pure then
+ if Ctxt /= null and then Get_Purity_State (Imp) /= Pure then
Set_Instance_Const (Sub_Inst, False);
end if;
end if;
@@ -2164,8 +2174,8 @@ package body Synth.Vhdl_Stmts is
Set_Error (Syn_Inst);
end if;
- if Debugger.Flag_Need_Debug then
- Debugger.Debug_Leave (Sub_Inst);
+ if Elab.Debugger.Flag_Need_Debug then
+ Elab.Debugger.Debug_Leave (Sub_Inst);
end if;
Free_Instance (Sub_Inst);
@@ -2214,7 +2224,11 @@ package body Synth.Vhdl_Stmts is
Sub_Inst : Synth_Instance_Acc;
begin
Areapools.Mark (Area_Mark, Instance_Pool.all);
- Sub_Inst := Make_Instance (Syn_Inst, Imp, New_Internal_Name (Ctxt));
+ Sub_Inst := Make_Elab_Instance (Syn_Inst, Imp, Null_Node);
+
+ if Ctxt /= null then
+ Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
+ end if;
Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos);
@@ -2247,20 +2261,6 @@ package body Synth.Vhdl_Stmts is
end case;
end Synth_Procedure_Call;
- procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp)
- is
- T : Int64;
- begin
- T := Read_Discrete (V);
- case Rng.Dir is
- when Dir_To =>
- T := T + 1;
- when Dir_Downto =>
- T := T - 1;
- end case;
- Write_Discrete (V, T);
- end Update_Index;
-
-- Return True iff WID is a static wire and its value is V.
function Is_Static_Bit (Wid : Wire_Id; V : Ghdl_U8) return Boolean
is
@@ -2876,6 +2876,7 @@ package body Synth.Vhdl_Stmts is
if Sev_V >= Flags.Severity_Level then
Error_Msg_Synth (+Stmt, "error due to assertion failure");
+ Elab.Debugger.Debug_Error (Syn_Inst, Stmt);
end if;
end Synth_Static_Report;
@@ -2962,8 +2963,8 @@ package body Synth.Vhdl_Stmts is
& Natural'Image (Line));
end;
end if;
- if Synth.Debugger.Flag_Need_Debug then
- Synth.Debugger.Debug_Break (C.Inst, Stmt);
+ if Elab.Debugger.Flag_Need_Debug then
+ Elab.Debugger.Debug_Break (C.Inst, Stmt);
end if;
case Get_Kind (Stmt) is
@@ -3205,34 +3206,25 @@ package body Synth.Vhdl_Stmts is
is
use Areapools;
Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
- Blk_Inst : Synth_Instance_Acc;
+ Blk_Inst : constant Synth_Instance_Acc :=
+ Get_Sub_Instance (Syn_Inst, Blk);
+ Decls_Chain : constant Node := Get_Declaration_Chain (Blk);
Blk_Sname : Sname;
M : Areapools.Mark_Type;
begin
- -- No support for guard or header.
- if Get_Block_Header (Blk) /= Null_Node
- or else Get_Guard_Decl (Blk) /= Null_Node
- then
- raise Internal_Error;
- end if;
-
- Apply_Block_Configuration
- (Get_Block_Block_Configuration (Blk), Blk);
-
Blk_Sname := New_Sname_User (Get_Identifier (Blk), Get_Sname (Syn_Inst));
- Blk_Inst := Make_Instance (Syn_Inst, Blk, Blk_Sname);
+ Set_Extra (Blk_Inst, Syn_Inst, Blk_Sname);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
- Synth_Declarations (Blk_Inst, Get_Declaration_Chain (Blk));
+ Synth_Concurrent_Declarations (Blk_Inst, Decls_Chain);
Synth_Concurrent_Statements
(Blk_Inst, Get_Concurrent_Statement_Chain (Blk));
Synth_Attribute_Values (Blk_Inst, Blk);
- Finalize_Declarations (Blk_Inst, Get_Declaration_Chain (Blk));
+ Finalize_Declarations (Blk_Inst, Decls_Chain);
- Free_Instance (Blk_Inst);
Release (M, Proc_Pool);
Instance_Pool := Prev_Instance_Pool;
end Synth_Block_Statement;
@@ -3514,37 +3506,25 @@ package body Synth.Vhdl_Stmts is
end Synth_Psl_Assert_Directive;
procedure Synth_Generate_Statement_Body
- (Syn_Inst : Synth_Instance_Acc;
- Bod : Node;
- Name : Sname;
- Iterator : Node := Null_Node;
- Iterator_Val : Valtyp := No_Valtyp)
+ (Syn_Inst : Synth_Instance_Acc; Bod : Node)
is
use Areapools;
Decls_Chain : constant Node := Get_Declaration_Chain (Bod);
Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
- Bod_Inst : Synth_Instance_Acc;
M : Areapools.Mark_Type;
begin
- Bod_Inst := Make_Instance (Syn_Inst, Bod, Name);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
- if Iterator /= Null_Node then
- -- Add the iterator (for for-generate).
- Create_Object (Bod_Inst, Iterator, Iterator_Val);
- end if;
-
- Synth_Declarations (Bod_Inst, Decls_Chain);
+ Synth_Concurrent_Declarations (Syn_Inst, Decls_Chain);
Synth_Concurrent_Statements
- (Bod_Inst, Get_Concurrent_Statement_Chain (Bod));
+ (Syn_Inst, Get_Concurrent_Statement_Chain (Bod));
- Synth_Attribute_Values (Bod_Inst, Bod);
+ Synth_Attribute_Values (Syn_Inst, Bod);
- Finalize_Declarations (Bod_Inst, Decls_Chain);
+ Finalize_Declarations (Syn_Inst, Decls_Chain);
- Free_Instance (Bod_Inst);
Release (M, Proc_Pool);
Instance_Pool := Prev_Instance_Pool;
end Synth_Generate_Statement_Body;
@@ -3552,34 +3532,17 @@ package body Synth.Vhdl_Stmts is
procedure Synth_If_Generate_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
- Gen : Node;
- Bod : Node;
- Icond : Node;
- Cond : Valtyp;
+ Sub_Inst : Synth_Instance_Acc;
Name : Sname;
- Config : Node;
begin
- Gen := Stmt;
+ Sub_Inst := Get_Sub_Instance (Syn_Inst, Stmt);
+ if Sub_Inst = null then
+ return;
+ end if;
+
Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst));
- loop
- Icond := Get_Condition (Gen);
- if Icond /= Null_Node then
- Cond := Synth_Expression (Syn_Inst, Icond);
- Strip_Const (Cond);
- else
- -- It is the else generate.
- Cond := No_Valtyp;
- end if;
- if Cond = No_Valtyp or else Read_Discrete (Cond) = 1 then
- Bod := Get_Generate_Statement_Body (Gen);
- Config := Get_Generate_Block_Configuration (Bod);
- Apply_Block_Configuration (Config, Bod);
- Synth_Generate_Statement_Body (Syn_Inst, Bod, Name);
- exit;
- end if;
- Gen := Get_Generate_Else_Clause (Gen);
- exit when Gen = Null_Node;
- end loop;
+ Set_Extra (Sub_Inst, Syn_Inst, Name);
+ Synth_Generate_Statement_Body (Sub_Inst, Get_Source_Scope (Sub_Inst));
end Synth_If_Generate_Statement;
procedure Synth_For_Generate_Statement
@@ -3587,48 +3550,26 @@ package body Synth.Vhdl_Stmts is
is
Iterator : constant Node := Get_Parameter_Specification (Stmt);
Bod : constant Node := Get_Generate_Statement_Body (Stmt);
- Configs : constant Node := Get_Generate_Block_Configuration (Bod);
- It_Type : constant Node := Get_Declaration_Type (Iterator);
- Config : Node;
It_Rng : Type_Acc;
- Val : Valtyp;
+ Sub_Inst : Synth_Instance_Acc;
+ Gen_Inst : Synth_Instance_Acc;
Name : Sname;
Lname : Sname;
begin
- if It_Type /= Null_Node then
- Synth_Subtype_Indication (Syn_Inst, It_Type);
- end if;
-
- -- Initial value.
It_Rng := Get_Subtype_Object (Syn_Inst, Get_Type (Iterator));
- Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng);
+ Gen_Inst := Get_Sub_Instance (Syn_Inst, Stmt);
Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst));
+ Set_Extra (Gen_Inst, Syn_Inst, Name);
- while In_Range (It_Rng.Drange, Read_Discrete (Val)) loop
- -- Find and apply the config block.
- declare
- Spec : Node;
- begin
- Config := Configs;
- while Config /= Null_Node loop
- Spec := Get_Block_Specification (Config);
- case Get_Kind (Spec) is
- when Iir_Kind_Simple_Name =>
- exit;
- when others =>
- Error_Kind ("synth_for_generate_statement", Spec);
- end case;
- Config := Get_Prev_Block_Configuration (Config);
- end loop;
- Apply_Block_Configuration (Config, Bod);
- end;
-
+ for I in 1 .. Get_Range_Length (It_Rng.Drange) loop
-- FIXME: get position ?
- Lname := New_Sname_Version (Uns32 (Read_Discrete (Val)), Name);
+ Lname := New_Sname_Version (Uns32 (I), Name);
+
+ Sub_Inst := Get_Generate_Sub_Instance (Gen_Inst, Positive (I));
+ Set_Extra (Sub_Inst, Gen_Inst, Lname);
- Synth_Generate_Statement_Body (Syn_Inst, Bod, Lname, Iterator, Val);
- Update_Index (It_Rng.Drange, Val);
+ Synth_Generate_Statement_Body (Sub_Inst, Bod);
end loop;
end Synth_For_Generate_Statement;
@@ -3663,10 +3604,14 @@ package body Synth.Vhdl_Stmts is
when Iir_Kind_Component_Instantiation_Statement =>
if Is_Component_Instantiation (Stmt) then
declare
+ Comp_Inst : constant Synth_Instance_Acc :=
+ Get_Sub_Instance (Syn_Inst, Stmt);
Comp_Config : constant Node :=
- Get_Component_Configuration (Stmt);
+ Get_Instance_Config (Comp_Inst);
begin
- if Get_Binding_Indication (Comp_Config) = Null_Node then
+ if Comp_Config = Null_Node
+ or else Get_Binding_Indication (Comp_Config) = Null_Node
+ then
-- Not bound.
Synth_Blackbox_Instantiation_Statement (Syn_Inst, Stmt);
else
@@ -3766,7 +3711,7 @@ package body Synth.Vhdl_Stmts is
N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W);
Set_Location (N, Val);
- Add_Conc_Assign (Base.Val.W, N, 0);
+ Add_Conc_Assign (Get_Value_Wire (Base.Val), N, 0);
end;
end Synth_Attribute_Formal;
@@ -3803,27 +3748,22 @@ package body Synth.Vhdl_Stmts is
end loop;
end Synth_Attribute_Values;
- procedure Synth_Verification_Unit
- (Syn_Inst : Synth_Instance_Acc; Unit : Node)
+ procedure Synth_Verification_Unit (Syn_Inst : Synth_Instance_Acc;
+ Unit : Node;
+ Parent_Inst : Synth_Instance_Acc)
is
use Areapools;
Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
- Unit_Inst : Synth_Instance_Acc;
Unit_Sname : Sname;
M : Areapools.Mark_Type;
Item : Node;
- Last_Type : Node;
begin
Unit_Sname := New_Sname_User (Get_Identifier (Unit),
Get_Sname (Syn_Inst));
- Unit_Inst := Make_Instance (Syn_Inst, Unit, Unit_Sname);
+ Set_Extra (Syn_Inst, Parent_Inst, Unit_Sname);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
- Apply_Block_Configuration
- (Get_Verification_Block_Configuration (Unit), Unit);
-
- Last_Type := Null_Node;
Item := Get_Vunit_Item_Chain (Unit);
while Item /= Null_Node loop
case Get_Kind (Item) is
@@ -3831,13 +3771,13 @@ package body Synth.Vhdl_Stmts is
| Iir_Kind_Psl_Declaration =>
null;
when Iir_Kind_Psl_Assert_Directive =>
- Synth_Psl_Assert_Directive (Unit_Inst, Item);
+ Synth_Psl_Assert_Directive (Syn_Inst, Item);
when Iir_Kind_Psl_Assume_Directive =>
- Synth_Psl_Assume_Directive (Unit_Inst, Item);
+ Synth_Psl_Assume_Directive (Syn_Inst, Item);
when Iir_Kind_Psl_Restrict_Directive =>
- Synth_Psl_Restrict_Directive (Unit_Inst, Item);
+ Synth_Psl_Restrict_Directive (Syn_Inst, Item);
when Iir_Kind_Psl_Cover_Directive =>
- Synth_Psl_Cover_Directive (Unit_Inst, Item);
+ Synth_Psl_Cover_Directive (Syn_Inst, Item);
when Iir_Kind_Signal_Declaration
| Iir_Kind_Constant_Declaration
| Iir_Kind_Function_Declaration
@@ -3846,21 +3786,21 @@ package body Synth.Vhdl_Stmts is
| Iir_Kind_Procedure_Body
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Attribute_Specification =>
- Synth_Declaration (Unit_Inst, Item, False, Last_Type);
+ Synth_Concurrent_Declaration (Syn_Inst, Item);
when Iir_Kinds_Concurrent_Signal_Assignment
| Iir_Kinds_Process_Statement
| Iir_Kinds_Generate_Statement
| Iir_Kind_Block_Statement
| Iir_Kind_Concurrent_Procedure_Call_Statement
| Iir_Kind_Component_Instantiation_Statement =>
- Synth_Concurrent_Statement (Unit_Inst, Item);
+ Synth_Concurrent_Statement (Syn_Inst, Item);
when others =>
Error_Kind ("synth_verification_unit", Item);
end case;
Item := Get_Chain (Item);
end loop;
- Synth_Attribute_Values (Unit_Inst, Unit);
+ Synth_Attribute_Values (Syn_Inst, Unit);
-- Finalize
Item := Get_Vunit_Item_Chain (Unit);
@@ -3888,14 +3828,13 @@ package body Synth.Vhdl_Stmts is
| Iir_Kind_Procedure_Body
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Attribute_Specification =>
- Finalize_Declaration (Unit_Inst, Item, False);
+ Finalize_Declaration (Syn_Inst, Item, False);
when others =>
Error_Kind ("synth_verification_unit(2)", Item);
end case;
Item := Get_Chain (Item);
end loop;
- Free_Instance (Unit_Inst);
Release (M, Proc_Pool);
Instance_Pool := Prev_Instance_Pool;
end Synth_Verification_Unit;
diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads
index 9621a7c9f..a7a2c719c 100644
--- a/src/synth/synth-vhdl_stmts.ads
+++ b/src/synth/synth-vhdl_stmts.ads
@@ -19,11 +19,12 @@
with Types; use Types;
with Vhdl.Nodes; use Vhdl.Nodes;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
with Netlists; use Netlists;
-with Synth.Objtypes; use Synth.Objtypes;
-with Synth.Values; use Synth.Values;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
package Synth.Vhdl_Stmts is
@@ -90,12 +91,9 @@ package Synth.Vhdl_Stmts is
procedure Synth_Attribute_Values
(Syn_Inst : Synth_Instance_Acc; Unit : Node);
- procedure Synth_Verification_Unit
- (Syn_Inst : Synth_Instance_Acc; Unit : Node);
-
- -- For iterators.
- procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp);
-
+ procedure Synth_Verification_Unit (Syn_Inst : Synth_Instance_Acc;
+ Unit : Node;
+ Parent_Inst : Synth_Instance_Acc);
private
-- There are 2 execution mode:
-- * static: it is like simulation, all the inputs are known, neither
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index d10d431d5..57d20df13 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -23,12 +23,10 @@ with Netlists.Cleanup;
with Netlists.Memories;
with Netlists.Expands;
-with Synth.Objtypes;
-with Synth.Vhdl_Insts; use Synth.Vhdl_Insts;
-
+with Elab.Vhdl_Values.Debug;
+pragma Unreferenced (Elab.Vhdl_Values.Debug);
-with Synth.Values.Debug;
-pragma Unreferenced (Synth.Values.Debug);
+with Synth.Vhdl_Insts; use Synth.Vhdl_Insts;
package body Synthesis is
function Make_Base_Instance return Base_Instance_Acc
@@ -47,17 +45,14 @@ package body Synthesis is
return Base;
end Make_Base_Instance;
- procedure Synth_Design (Design : Node;
- Encoding : Name_Encoding;
- M : out Module;
- Inst : out Synth_Instance_Acc)
+ function Synth_Design (Design : Iir;
+ Inst : Synth_Instance_Acc;
+ Encoding : Name_Encoding) return Module
is
Base : Base_Instance_Acc;
begin
Base := Make_Base_Instance;
- Synth.Objtypes.Init;
-
case Iir_Kinds_Design_Unit (Get_Kind (Design)) is
when Iir_Kind_Foreign_Module =>
if Synth_Top_Foreign = null then
@@ -71,11 +66,10 @@ package body Synthesis is
Synth.Vhdl_Insts.Synth_All_Instances;
if Errorout.Nbr_Errors > 0 then
- M := No_Module;
- return;
+ return No_Module;
end if;
- M := Base.Top_Module;
+ return Base.Top_Module;
end Synth_Design;
procedure Instance_Passes (Ctxt : Context_Acc; M : Module) is
diff --git a/src/synth/synthesis.ads b/src/synth/synthesis.ads
index 59688832e..30523c21d 100644
--- a/src/synth/synthesis.ads
+++ b/src/synth/synthesis.ads
@@ -22,15 +22,15 @@ with Vhdl.Nodes; use Vhdl.Nodes;
with Netlists; use Netlists;
with Netlists.Builders; use Netlists.Builders;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
with Synth.Context; use Synth.Context;
-with Synth.Vhdl_Context; use Synth.Vhdl_Context;
with Synth.Flags; use Synth.Flags;
package Synthesis is
- procedure Synth_Design (Design : Iir;
- Encoding : Name_Encoding;
- M : out Module;
- Inst : out Synth_Instance_Acc);
+ function Synth_Design (Design : Iir;
+ Inst : Synth_Instance_Acc;
+ Encoding : Name_Encoding) return Module;
-- Run cleanup/memory extraction/expand passes on M.
procedure Instance_Passes (Ctxt : Context_Acc; M : Module);