From c2c33f8ddce23c5234805c3ba4f6d1064b6c1364 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Fri, 30 Sep 2016 20:21:44 +0200
Subject: Add Eval_Attribute_Parameter_Or_1
---
src/vhdl/evaluation.adb | 23 +++++++++++++++++++----
src/vhdl/evaluation.ads | 3 +++
src/vhdl/sem_names.adb | 20 +++++++++++++-------
src/vhdl/translate/trans-chap14.adb | 2 +-
4 files changed, 36 insertions(+), 12 deletions(-)
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index e681ee651..8bcc6ff9e 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -1460,11 +1460,24 @@ package body Evaluation is
return Build_Overflow (Orig);
end Eval_Dyadic_Operator;
+ -- Get the parameter of an attribute, or 1 if doesn't exist.
+ function Eval_Attribute_Parameter_Or_1 (Attr : Iir) return Natural
+ is
+ Parameter : constant Iir := Get_Parameter (Attr);
+ begin
+ if Is_Null (Parameter) or else Is_Error (Parameter) then
+ return 1;
+ else
+ return Natural (Get_Value (Parameter));
+ end if;
+ end Eval_Attribute_Parameter_Or_1;
+
-- Evaluate any array attribute, return the type for the prefix.
function Eval_Array_Attribute (Attr : Iir) return Iir
is
Prefix : Iir;
Prefix_Type : Iir;
+ Dim : Natural;
begin
Prefix := Get_Prefix (Attr);
case Get_Kind (Prefix) is
@@ -1488,8 +1501,9 @@ package body Evaluation is
if Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition then
Error_Kind ("eval_array_attribute(2)", Prefix_Type);
end if;
- return Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type),
- Natural (Get_Value (Get_Parameter (Attr)) - 1));
+
+ Dim := Eval_Attribute_Parameter_Or_1 (Attr);
+ return Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type), Dim - 1);
end Eval_Array_Attribute;
function Eval_Integer_Image (Val : Iir_Int64; Orig : Iir) return Iir
@@ -2782,6 +2796,7 @@ package body Evaluation is
declare
Prefix : Iir;
Res : Iir;
+ Dim : Natural;
begin
Prefix := Get_Prefix (Expr);
if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition
@@ -2793,9 +2808,9 @@ package body Evaluation is
-- Unconstrained object.
return Null_Iir;
end if;
+ Dim := Eval_Attribute_Parameter_Or_1 (Expr);
Expr := Get_Nth_Element
- (Get_Index_Subtype_List (Prefix),
- Natural (Eval_Pos (Get_Parameter (Expr))) - 1);
+ (Get_Index_Subtype_List (Prefix), Dim - 1);
if Kind = Iir_Kind_Reverse_Range_Array_Attribute then
Expr := Eval_Static_Range (Expr);
diff --git a/src/vhdl/evaluation.ads b/src/vhdl/evaluation.ads
index b4f145e70..29ab8e799 100644
--- a/src/vhdl/evaluation.ads
+++ b/src/vhdl/evaluation.ads
@@ -45,6 +45,9 @@ package Evaluation is
-- Constraint_Error.
function Get_Physical_Value (Expr : Iir) return Iir_Int64;
+ -- Get the parameter of an attribute, or 1 if doesn't exist.
+ function Eval_Attribute_Parameter_Or_1 (Attr : Iir) return Natural;
+
-- Evaluate the locally static expression EXPR (without checking that EXPR
-- is locally static). Return a literal or an aggregate, without setting
-- the origin, and do not modify EXPR. This can be used only to get the
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 793df93e1..fdee1c1e2 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -920,17 +920,18 @@ package body Sem_Names is
-- value of which must not exceed the dimensionality of A. If omitted,
-- it defaults to 1.
if Param = Null_Iir then
- Parameter := Universal_Integer_One;
+ Parameter := Null_Iir;
else
Parameter := Sem_Expression
(Param, Universal_Integer_Type_Definition);
- if Parameter = Null_Iir then
- Parameter := Universal_Integer_One;
- else
+ if Parameter /= Null_Iir then
if Get_Expr_Staticness (Parameter) /= Locally then
Error_Msg_Sem (+Parameter, "parameter must be locally static");
- Parameter := Universal_Integer_One;
end if;
+ else
+ -- Don't forget there is a parameter, so the attribute cannot
+ -- be reanalyzed with a default parameter.
+ Parameter := Error_Mark;
end if;
end if;
@@ -953,11 +954,16 @@ package body Sem_Names is
Indexes_List : constant Iir_List :=
Get_Index_Subtype_List (Prefix_Type);
begin
- Dim := Get_Value (Parameter);
+ if Is_Null (Parameter)
+ or else Get_Expr_Staticness (Parameter) /= Locally
+ then
+ Dim := 1;
+ else
+ Dim := Get_Value (Parameter);
+ end if;
if Dim < 1 or else Dim > Iir_Int64 (Get_Nbr_Elements (Indexes_List))
then
Error_Msg_Sem (+Attr, "parameter value out of bound");
- Parameter := Universal_Integer_One;
Dim := 1;
end if;
Index_Type := Get_Index_Type (Indexes_List, Natural (Dim - 1));
diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb
index 190953058..ac1933a27 100644
--- a/src/vhdl/translate/trans-chap14.adb
+++ b/src/vhdl/translate/trans-chap14.adb
@@ -45,7 +45,7 @@ package body Trans.Chap14 is
-- Prefix is an object.
Arr := Chap6.Translate_Name (Prefix, Mode_Value);
end if;
- Dim := Natural (Get_Value (Get_Parameter (Expr)));
+ Dim := Eval_Attribute_Parameter_Or_1 (Expr);
return Chap3.Get_Array_Range (Arr, Get_Type (Prefix), Dim);
end Translate_Array_Attribute_To_Range;
--
cgit v1.2.3