From e1af0a762a6df2e2630b504e782740ba77e323af Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Tue, 26 Jan 2016 05:37:01 +0100
Subject: simul: fix attribute specification, noop type conversion, indiv sig
assoc.
---
src/vhdl/simulate/annotations.adb | 2 ++
src/vhdl/simulate/elaboration.adb | 4 ++++
src/vhdl/simulate/elaboration.ads | 5 ++++-
src/vhdl/simulate/execution.adb | 24 ++++++++++++++++++------
src/vhdl/simulate/iir_values.adb | 13 +++++++++----
5 files changed, 37 insertions(+), 11 deletions(-)
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb
index b28290366..333a8c8f3 100644
--- a/src/vhdl/simulate/annotations.adb
+++ b/src/vhdl/simulate/annotations.adb
@@ -634,6 +634,8 @@ package body Annotations is
begin
Value := Get_Attribute_Value_Spec_Chain (Decl);
while Value /= Null_Iir loop
+ Annotate_Anonymous_Type_Definition
+ (Block_Info, Get_Type (Value));
Create_Object_Info (Block_Info, Value);
Value := Get_Spec_Chain (Value);
end loop;
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index b05f62565..525d471ab 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -471,6 +471,8 @@ package body Elaboration is
when others =>
raise Internal_Error;
end case;
+ when Init_Value_Signal =>
+ Res := Create_Signal_Value (null);
end case;
when Iir_Kind_Array_Subtype_Definition =>
@@ -2367,6 +2369,8 @@ package body Elaboration is
begin
Value := Get_Attribute_Value_Spec_Chain (Decl);
while Value /= Null_Iir loop
+ Elaborate_Subtype_Indication_If_Anonymous
+ (Instance, Get_Type (Value));
-- 2. The expression is evaluated to determine the value
-- of the attribute.
-- It is an error if the value of the expression does not
diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads
index d63702adf..013a7fbcc 100644
--- a/src/vhdl/simulate/elaboration.ads
+++ b/src/vhdl/simulate/elaboration.ads
@@ -111,7 +111,10 @@ package Elaboration is
Init_Value_Default,
-- Undefined. The caller doesn't care as it will overwrite the value.
- Init_Value_Any);
+ Init_Value_Any,
+
+ -- Create signal placeholder. Only for individual associations.
+ Init_Value_Signal);
-- Create a value for type DECL.
function Create_Value_For_Type
diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb
index f4104f299..c58e03984 100644
--- a/src/vhdl/simulate/execution.adb
+++ b/src/vhdl/simulate/execution.adb
@@ -1647,9 +1647,8 @@ package body Execution is
Array_Type: constant Iir := Get_Type (Str);
Index_Types : constant Iir_List := Get_Index_Subtype_List (Array_Type);
begin
- if Get_Nbr_Elements (Index_Types) /= 1 then
- raise Internal_Error; -- array must be unidimensional
- end if;
+ -- Array must be unidimensional.
+ pragma Assert (Get_Nbr_Elements (Index_Types) = 1);
Res := String_To_Enumeration_Array_1
(Str, Get_Element_Subtype (Array_Type));
@@ -2255,7 +2254,15 @@ package body Execution is
end case;
when Iir_Kind_Enumeration_Type_Definition
| Iir_Kind_Enumeration_Subtype_Definition =>
- -- must be same type.
+ -- Must be same type.
+ null;
+ when Iir_Kind_Physical_Type_Definition
+ | Iir_Kind_Physical_Subtype_Definition =>
+ -- Same type.
+ null;
+ when Iir_Kind_Record_Type_Definition
+ | Iir_Kind_Record_Subtype_Definition =>
+ -- Same type.
null;
when Iir_Kind_Array_Type_Definition =>
-- LRM93 7.3.5
@@ -3444,8 +3451,13 @@ package body Execution is
when Iir_Kind_Association_Element_By_Individual =>
-- Directly create the whole value on the instance pool, as its
-- life is longer than the statement.
- Last_Individual := Create_Value_For_Type
- (Out_Block, Get_Actual_Type (Assoc), Init_Value_Any);
+ if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
+ Last_Individual := Create_Value_For_Type
+ (Out_Block, Get_Actual_Type (Assoc), Init_Value_Signal);
+ else
+ Last_Individual := Create_Value_For_Type
+ (Out_Block, Get_Actual_Type (Assoc), Init_Value_Any);
+ end if;
Last_Individual :=
Unshare (Last_Individual, Instance_Pool);
Elaboration.Create_Object (Subprg_Block, Inter);
diff --git a/src/vhdl/simulate/iir_values.adb b/src/vhdl/simulate/iir_values.adb
index fb0dab057..c79ac8fff 100644
--- a/src/vhdl/simulate/iir_values.adb
+++ b/src/vhdl/simulate/iir_values.adb
@@ -262,8 +262,10 @@ package body Iir_Values is
Dest.File := Src.File;
when Iir_Value_Protected =>
Dest.Prot := Src.Prot;
- when Iir_Value_Signal
- | Iir_Value_Range
+ when Iir_Value_Signal =>
+ pragma Assert (Dest.Sig = null);
+ Dest.Sig := Src.Sig;
+ when Iir_Value_Range
| Iir_Value_Quantity
| Iir_Value_Terminal =>
raise Internal_Error;
@@ -637,8 +639,11 @@ package body Iir_Values is
when Iir_Value_Protected =>
return Create_Protected_Value (Src.Prot);
- when Iir_Value_Signal
- | Iir_Value_Quantity
+ when Iir_Value_Signal =>
+ pragma Assert (Src.Sig = null);
+ return Create_Signal_Value (Src.Sig);
+
+ when Iir_Value_Quantity
| Iir_Value_Terminal =>
raise Internal_Error;
end case;
--
cgit v1.2.3