-- Iir to ortho translator.
-- Copyright (C) 2002 - 2014 Tristan Gingold
--
-- GHDL 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, or (at your option) any later
-- version.
--
-- GHDL 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 GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO;
with Name_Table;
with Iirs_Utils; use Iirs_Utils;
with Iir_Chains; use Iir_Chains;
with Std_Package; use Std_Package;
with Errorout; use Errorout;
with Flags; use Flags;
with Canon;
with Evaluation; use Evaluation;
with Trans.Chap3;
with Trans.Chap4;
with Trans.Chap6;
with Trans.Chap8;
with Trans.Chap14;
with Trans.Rtis;
with Trans_Decls; use Trans_Decls;
with Trans.Helpers2; use Trans.Helpers2;
with Trans.Foreach_Non_Composite;
package body Trans.Chap7 is
use Trans.Helpers;
procedure Copy_Range (Dest : Mnode; Src : Mnode);
function Is_Static_Constant (Decl : Iir_Constant_Declaration) return Boolean
is
Expr : constant Iir := Get_Default_Value (Decl);
Atype : Iir;
Info : Iir;
begin
if Expr = Null_Iir
or else Get_Kind (Expr) = Iir_Kind_Overflow_Literal
then
-- Deferred constant.
return False;
end if;
if Get_Expr_Staticness (Decl) = Locally then
return True;
end if;
-- Only aggregates are handled.
if Get_Kind (Expr) /= Iir_Kind_Aggregate then
return False;
end if;
Atype := Get_Type (Decl);
-- Bounds must be known (and static).
if Get_Type_Staticness (Atype) /= Locally then
return False;
end if;
-- Currently, only array aggregates are handled.
if Get_Kind (Get_Base_Type (Atype)) /= Iir_Kind_Array_Type_Definition
then
return False;
end if;
-- Aggregate elements must be locally static.
-- Note: this does not yet handled aggregates of aggregates.
if Get_Value_Staticness (Expr) /= Locally then
return False;
end if;
Info := Get_Aggregate_Info (Expr);
while Info /= Null_Iir loop
if Get_Aggr_Dynamic_Flag (Info) then
raise Internal_Error;
end if;
-- Currently, only positionnal aggregates are handled.
if Get_Aggr_Named_Flag (Info) then
return False;
end if;
-- Currently, others choice are not handled.
if Get_Aggr_Others_Flag (Info) then
return False;
end if;
Info := Get_Sub_Aggregate_Info (Info);
end loop;
return True;
end Is_Static_Constant;
procedure Translate_Static_String_Literal_Inner
(List : in out O_Array_Aggr_List;
Str : Iir;
El_Type : Iir)
is
use Name_Table;
Literal_List : constant Iir_List :=
Get_Enumeration_Literal_List (Get_Base_Type (El_Type));
Len : constant Nat32 := Get_String_Length (Str);
Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Str);
Lit : Iir;
begin
for I in 1 .. Len loop
Lit := Find_Name_In_List (Literal_List, Get_Identifier (Ptr (I)));
New_Array_Aggr_El (List, Get_Ortho_Expr (Lit));
end loop;
end Translate_Static_String_Literal_Inner;
procedure Translate_Static_Bit_String_Literal_Inner
(List : in out O_Array_Aggr_List;
Lit : Iir_Bit_String_Literal;
El_Type : Iir)
is
pragma Unreferenced (El_Type);
L_0 : constant O_Cnode := Get_Ortho_Expr (Get_Bit_String_0 (Lit));
L_1 : constant O_Cnode := Get_Ortho_Expr (Get_Bit_String_1 (Lit));
Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Lit);
Len : constant Nat32 := Get_String_Length (Lit);
V : O_Cnode;
begin
for I in 1 .. Len loop
case Ptr (I) is
when '0' =>
V := L_0;
when '1' =>
V := L_1;
when others =>
raise Internal_Error;
end case;
New_Array_Aggr_El (List, V);
end loop;
end Translate_Static_Bit_String_Literal_Inner;
procedure Translate_Static_Aggregate_1 (List : in out O_Array_Aggr_List;
Aggr : Iir;
Info : Iir;
El_Type : Iir)
is
N_Info : constant Iir := Get_Sub_Aggregate_Info (Info);
Assoc : Iir;
Sub : Iir;
begin
case Get_Kind (Aggr) is
when Iir_Kind_Aggregate =>
Assoc := Get_Association_Choices_Chain (Aggr);
while Assoc /= Null_Iir loop
Sub := Get_Associated_Expr (Assoc);
case Get_Kind (Assoc) is
when Iir_Kind_Choice_By_None =>
if N_Info = Null_Iir then
New_Array_Aggr_El
(List, Translate_Static_Expression (Sub, El_Type));
else
Translate_Static_Aggregate_1
(List, Sub, N_Info, El_Type);
end if;
when others =>
Error_Kind ("translate_static_aggregate_1(2)", Assoc);
end case;
Assoc := Get_Chain (Assoc);
end loop;
when Iir_Kind_String_Literal =>
if N_Info /= Null_Iir then
raise Internal_Error;
end if;
Translate_Static_String_Literal_Inner (List, Aggr, El_Type);
when Iir_Kind_Bit_String_Literal =>
if N_Info /= Null_Iir then
raise Internal_Error;
end if;
Translate_Static_Bit_String_Literal_Inner (List, Aggr, El_Type);
when others =>
Error_Kind ("translate_static_aggregate_1", Aggr);
end case;
end Translate_Static_Aggregate_1;
function Translate_Static_Aggregate (Aggr : Iir) return O_Cnode
is
Aggr_Type : constant Iir := Get_Type (Aggr);
El_Type : constant Iir := Get_Element_Subtype (Aggr_Type);
List : O_Array_Aggr_List;
Res : O_Cnode;
begin
Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
Translate_Static_Aggregate_1
(List, Aggr, Get_Aggregate_Info (Aggr), El_Type);
Finish_Array_Aggr (List, Res);
return Res;
end Translate_Static_Aggregate;
function Translate_Static_Simple_Aggregate (Aggr : Iir) return O_Cnode
is
Aggr_Type : constant Iir := Get_Type (Aggr);
El_List : constant Iir_List := Get_Simple_Aggregate_List (Aggr);
El_Type : constant Iir := Get_Element_Subtype (Aggr_Type);
El : Iir;
List : O_Array_Aggr_List;
Res : O_Cnode;
begin
Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
for I in Natural loop
El := Get_Nth_Element (El_List, I);
exit when El = Null_Iir;
New_Array_Aggr_El
(List, Translate_Static_Expression (El, El_Type));
end loop;
Finish_Array_Aggr (List, Res);
return Res;
end Translate_Static_Simple_Aggregate;
function Translate_Static_String_Literal (Str : Iir) return O_Cnode
is
use Name_Table;
Lit_Type : constant Iir := Get_Type (Str);
Element_Type : constant Iir := Get_Element_Subtype (Lit_Type);
Arr_Type : O_Tnode;
List : O_Array_Aggr_List;
Res : O_Cnode;
begin
Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True);
Arr_Type := Get_Ortho_Type (Lit_Type, Mode_Value);
Start_Array_Aggr (List, Arr_Type);
Translate_Static_String_Literal_Inner (List, Str, Element_Type);
Finish_Array_Aggr (List, Res);
return Res;
end Translate_Static_String_Literal;
-- Create a variable (constant) for string or bit string literal STR.
-- The type of the literal element is ELEMENT_TYPE, and the ortho type
-- of the string (a constrained array type) is STR_TYPE.
function Create_String_Literal_Var_Inner
(Str : Iir; Element_Type : Iir; Str_Type : O_Tnode) return Var_Type
is
use Name_Table;
Val_Aggr : O_Array_Aggr_List;
Res : O_Cnode;
begin
Start_Array_Aggr (Val_Aggr, Str_Type);
case Get_Kind (Str) is
when Iir_Kind_String_Literal =>
Translate_Static_String_Literal_Inner
(Val_Aggr, Str, Element_Type);
when Iir_Kind_Bit_String_Literal =>
Translate_Static_Bit_String_Literal_Inner
(Val_Aggr, Str, Element_Type);
when others =>
raise Internal_Error;
end case;
Finish_Array_Aggr (Val_Aggr, Res);
return Create_Global_Const
(Create_Uniq_Identifier, Str_Type, O_Storage_Private, Res);
end Create_String_Literal_Var_Inner;
-- Create a variable (constant) for string or bit string literal STR.
function Create_String_Literal_Var (Str : Iir) return Var_Type
is
use Name_Table;
Str_Type : constant Iir := Get_Type (Str);
Arr_Type : O_Tnode;
begin
-- Create the string value.
Arr_Type := New_Constrained_Array_Type
(Get_Info (Str_Type).T.Base_Type (Mode_Value),
New_Unsigned_Literal (Ghdl_Index_Type,
Unsigned_64 (Get_String_Length (Str))));
return Create_String_Literal_Var_Inner
(Str, Get_Element_Subtype (Str_Type), Arr_Type);
end Create_String_Literal_Var;
-- Some strings literal have an unconstrained array type,
-- eg: 'image of constant. Its type is not constrained
-- because it is not so in VHDL!
function Translate_Non_Static_String_Literal (Str : Iir) return O_Enode
is
use Name_Table;
Lit_Type : constant Iir := Get_Type (Str);
Type_Info : constant Type_Info_Acc := Get_Info (Lit_Type);
Index_Type : constant Iir := Get_Index_Type (Lit_Type, 0);
Index_Type_Info : constant Type_Info_Acc := Get_Info (Index_Type);
Bound_Aggr : O_Record_Aggr_List;
Index_Aggr : O_Record_Aggr_List;
Res_Aggr : O_Record_Aggr_List;
Res : O_Cnode;
Len : Int32;
Val : Var_Type;
Bound : Var_Type;
R : O_Enode;
begin
-- Create the string value.
Len := Get_String_Length (Str);
Val := Create_String_Literal_Var (Str);
if Type_Info.Type_Mode = Type_Mode_Fat_Array then
-- Create the string bound.
Start_Record_Aggr (Bound_Aggr, Type_Info.T.Bounds_Type);
Start_Record_Aggr (Index_Aggr, Index_Type_Info.T.Range_Type);
New_Record_Aggr_El
(Index_Aggr,
New_Signed_Literal
(Index_Type_Info.Ortho_Type (Mode_Value), 0));
New_Record_Aggr_El
(Index_Aggr,
New_Signed_Literal (Index_Type_Info.Ortho_Type (Mode_Value),
Integer_64 (Len - 1)));
New_Record_Aggr_El
(Index_Aggr, Ghdl_Dir_To_Node);
New_Record_Aggr_El
(Index_Aggr,
New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Len)));
Finish_Record_Aggr (Index_Aggr, Res);
New_Record_Aggr_El (Bound_Aggr, Res);
Finish_Record_Aggr (Bound_Aggr, Res);
Bound := Create_Global_Const
(Create_Uniq_Identifier, Type_Info.T.Bounds_Type,
O_Storage_Private, Res);
-- The descriptor.
Start_Record_Aggr (Res_Aggr, Type_Info.Ortho_Type (Mode_Value));
New_Record_Aggr_El
(Res_Aggr,
New_Global_Address (Get_Var_Label (Val),
Type_Info.T.Base_Ptr_Type (Mode_Value)));
New_Record_Aggr_El
(Res_Aggr,
New_Global_Address (Get_Var_Label (Bound),
Type_Info.T.Bounds_Ptr_Type));
Finish_Record_Aggr (Res_Aggr, Res);
Val := Create_Global_Const
(Create_Uniq_Identifier, Type_Info.Ortho_Type (Mode_Value),
O_Storage_Private, Res);
elsif Type_Info.Type_Mode = Type_Mode_Array then
-- Type of string literal isn't statically known; check the
-- length.
Chap6.Check_Bound_Error
(New_Compare_Op
(ON_Neq,
New_Lit (New_Index_Lit (Unsigned_64 (Len))),
Chap3.Get_Array_Type_Length (Lit_Type),
Ghdl_Bool_Type),
Str, 1);
else
raise Internal_Error;
end if;
R := New_Address (Get_Var (Val),
Type_Info.Ortho_Ptr_Type (Mode_Value));
return R;
end Translate_Non_Static_String_Literal;
-- Only for Strings of STD.Character.
function Translate_Static_String (Str_Type : Iir; Str_Ident : Name_Id)
return O_Cnode
is
use Name_Table;
Literal_List : Iir_List;
Lit : Iir;
List : O_Array_Aggr_List;
Res : O_Cnode;
begin
Chap3.Translate_Anonymous_Type_Definition (Str_Type, True);
Start_Array_Aggr (List, Get_Ortho_Type (Str_Type, Mode_Value));
Literal_List := Get_Enumeration_Literal_List (Character_Type_Definition);
Image (Str_Ident);
for I in 1 .. Name_Length loop
Lit := Get_Nth_Element (Literal_List,
Character'Pos (Name_Buffer (I)));
New_Array_Aggr_El (List, Get_Ortho_Expr (Lit));
end loop;
Finish_Array_Aggr (List, Res);
return Res;
end Translate_Static_String;
function Translate_Static_Bit_String_Literal (Lit : Iir_Bit_String_Literal)
return O_Cnode
is
Lit_Type : constant Iir := Get_Type (Lit);
Res : O_Cnode;
List : O_Array_Aggr_List;
begin
Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True);
Start_Array_Aggr (List, Get_Ortho_Type (Lit_Type, Mode_Value));
Translate_Static_Bit_String_Literal_Inner (List, Lit, Lit_Type);
Finish_Array_Aggr (List, Res);
return Res;
end Translate_Static_Bit_String_Literal;
function Translate_String_Literal (Str : Iir) return O_Enode
is
Str_Type : constant Iir := Get_Type (Str);
Var : Var_Type;
Info : Type_Info_Acc;
Res : O_Cnode;
R : O_Enode;
begin
if Get_Constraint_State (Str_Type) = Fully_Constrained
and then Get_Type_Staticness (Get_Index_Type (Str_Type, 0)) = Locally
then
Chap3.Create_Array_Subtype (Str_Type, True);
case Get_Kind (Str) is
when Iir_Kind_String_Literal =>
Res := Translate_Static_String_Literal (Str);
when Iir_Kind_Bit_String_Literal =>
Res := Translate_Static_Bit_String_Literal (Str);
when Iir_Kind_Simple_Aggregate =>
Res := Translate_Static_Simple_Aggregate (Str);
when Iir_Kind_Simple_Name_Attribute =>
Res := Translate_Static_String
(Get_Type (Str), Get_Simple_Name_Identifier (Str));
when others =>
raise Internal_Error;
end case;
Info := Get_Info (Str_Type);
Var := Create_Global_Const
(Create_Uniq_Identifier, Info.Ortho_Type (Mode_Value),
O_Storage_Private, Res);
R := New_Address (Get_Var (Var), Info.Ortho_Ptr_Type (Mode_Value));
return R;
else
return Translate_Non_Static_String_Literal (Str);
end if;
end Translate_String_Literal;
function Translate_Static_Implicit_Conv
(Expr : O_Cnode; Expr_Type : Iir; Res_Type : Iir) return O_Cnode
is
Expr_Info : Type_Info_Acc;
Res_Info : Type_Info_Acc;
Val : Var_Type;
Res : O_Cnode;
List : O_Record_Aggr_List;
Bound : Var_Type;
begin
if Res_Type = Expr_Type then
return Expr;
end if;
if Get_Kind (Expr_Type) /= Iir_Kind_Array_Subtype_Definition then
raise Internal_Error;
end if;
if Get_Kind (Res_Type) = Iir_Kind_Array_Subtype_Definition then
return Expr;
end if;
if Get_Kind (Res_Type) /= Iir_Kind_Array_Type_Definition then
raise Internal_Error;
end if;
Expr_Info := Get_Info (Expr_Type);
Res_Info := Get_Info (Res_Type);
Val := Create_Global_Const
(Create_Uniq_Identifier, Expr_Info.Ortho_Type (Mode_Value),
O_Storage_Private, Expr);
Bound := Expr_Info.T.Array_Bounds;
if Bound = Null_Var then
Bound := Create_Global_Const
(Create_Uniq_Identifier, Expr_Info.T.Bounds_Type,
O_Storage_Private,
Chap3.Create_Static_Array_Subtype_Bounds (Expr_Type));
Expr_Info.T.Array_Bounds := Bound;
end if;
Start_Record_Aggr (List, Res_Info.Ortho_Type (Mode_Value));
New_Record_Aggr_El
(List, New_Global_Address (Get_Var_Label (Val),
Res_Info.T.Base_Ptr_Type (Mode_Value)));
New_Record_Aggr_El
(List, New_Global_Address (Get_Var_Label (Bound),
Expr_Info.T.Bounds_Ptr_Type));
Finish_Record_Aggr (List, Res);
return Res;
end Translate_Static_Implicit_Conv;
function Translate_Numeric_Literal (Expr : Iir; Res_Type : O_Tnode)
return O_Cnode is
begin
case Get_Kind (Expr) is
when Iir_Kind_Integer_Literal =>
return New_Signed_Literal
(Res_Type, Integer_64 (Get_Value (Expr)));
when Iir_Kind_Enumeration_Literal =>
return Get_Ortho_Expr (Get_Enumeration_Decl (Expr));
when Iir_Kind_Floating_Point_Literal =>
return New_Float_Literal
(Res_Type, IEEE_Float_64 (Get_Fp_Value (Expr)));
when Iir_Kind_Physical_Int_Literal
| Iir_Kind_Physical_Fp_Literal
| Iir_Kind_Unit_Declaration =>
return New_Signed_Literal
(Res_Type, Integer_64 (Get_Physical_Value (Expr)));
when others =>
Error_Kind ("translate_numeric_literal", Expr);
end case;
exception
when Constraint_Error =>
-- Can be raised by Get_Physical_Unit_Value because of the kludge
-- on staticness.
Error_Msg_Elab ("numeric literal not in range", Expr);
return New_Signed_Literal (Res_Type, 0);
end Translate_Numeric_Literal;
function Translate_Numeric_Literal (Expr : Iir; Res_Type : Iir)
return O_Cnode
is
Expr_Type : constant Iir := Get_Type (Expr);
Expr_Otype : O_Tnode;
Tinfo : Type_Info_Acc;
begin
Tinfo := Get_Info (Expr_Type);
if Res_Type /= Null_Iir then
Expr_Otype := Get_Ortho_Type (Res_Type, Mode_Value);
else
if Tinfo = null then
-- FIXME: this is a working kludge, in the case where EXPR_TYPE
-- is a subtype which was not yet translated.
-- (eg: evaluated array attribute)
Tinfo := Get_Info (Get_Base_Type (Expr_Type));
end if;
Expr_Otype := Tinfo.Ortho_Type (Mode_Value);
end if;
return Translate_Numeric_Literal (Expr, Expr_Otype);
end Translate_Numeric_Literal;
function Translate_Static_Expression (Expr : Iir; Res_Type : Iir)
return O_Cnode
is
Expr_Type : constant Iir := Get_Type (Expr);
begin
case Get_Kind (Expr) is
when Iir_Kind_Integer_Literal
| Iir_Kind_Enumeration_Literal
| Iir_Kind_Floating_Point_Literal
| Iir_Kind_Physical_Int_Literal
| Iir_Kind_Unit_Declaration
| Iir_Kind_Physical_Fp_Literal =>
return Translate_Numeric_Literal (Expr, Res_Type);
when Iir_Kind_String_Literal =>
return Translate_Static_Implicit_Conv
(Translate_Static_String_Literal (Expr), Expr_Type, Res_Type);
when Iir_Kind_Bit_String_Literal =>
return Translate_Static_Implicit_Conv
(Translate_Static_Bit_String_Literal (Expr),
Expr_Type, Res_Type);
when Iir_Kind_Simple_Aggregate =>
return Translate_Static_Implicit_Conv
(Translate_Static_Simple_Aggregate (Expr),
Expr_Type, Res_Type);
when Iir_Kind_Aggregate =>
return Translate_Static_Implicit_Conv
(Translate_Static_Aggregate (Expr), Expr_Type, Res_Type);
when Iir_Kinds_Denoting_Name =>
return Translate_Static_Expression
(Get_Named_Entity (Expr), Res_Type);
when others =>
Error_Kind ("translate_static_expression", Expr);
end case;
end Translate_Static_Expression;
function Translate_Static_Range_Left
(Expr : Iir; Range_Type : Iir := Null_Iir) return O_Cnode
is
Bound : constant Iir := Get_Left_Limit (Expr);
Left : O_Cnode;
begin
Left := Chap7.Translate_Static_Expression (Bound, Range_Type);
-- if Range_Type /= Null_Iir
-- and then Get_Type (Bound) /= Range_Type then
-- Left := New_Convert_Ov
-- (Left, Get_Ortho_Type (Range_Type, Mode_Value));
-- end if;
return Left;
end Translate_Static_Range_Left;
function Translate_Static_Range_Right
(Expr : Iir; Range_Type : Iir := Null_Iir) return O_Cnode
is
Right : O_Cnode;
begin
Right := Chap7.Translate_Static_Expression (Get_Right_Limit (Expr),
Range_Type);
-- if Range_Type /= Null_Iir then
-- Right := New_Convert_Ov
-- (Right, Get_Ortho_Type (Range_Type, Mode_Value));
-- end if;
return Right;
end Translate_Static_Range_Right;
function Translate_Static_Range_Dir (Expr : Iir) return O_Cnode is
begin
case Get_Direction (Expr) is
when Iir_To =>
return Ghdl_Dir_To_Node;
when Iir_Downto =>
return Ghdl_Dir_Downto_Node;
end case;
end Translate_Static_Range_Dir;
function Translate_Static_Range_Length (Expr : Iir) return O_Cnode
is
Ulen : Unsigned_64;
begin
Ulen := Unsigned_64 (Eval_Discrete_Range_Length (Expr));
return New_Unsigned_Literal (Ghdl_Index_Type, Ulen);
end Translate_Static_Range_Length;
function Translate_Range_Expression_Left
(Expr : Iir; Range_Type : Iir := Null_Iir) return O_Enode
is
Left : O_Enode;
begin
Left := Chap7.Translate_Expression (Get_Left_Limit (Expr));
if Range_Type /= Null_Iir then
Left := New_Convert_Ov (Left,
Get_Ortho_Type (Range_Type, Mode_Value));
end if;
return Left;
end Translate_Range_Expression_Left;
function Translate_Range_Expression_Right
(Expr : Iir; Range_Type : Iir := Null_Iir) return O_Enode
is
Right : O_Enode;
begin
Right := Chap7.Translate_Expression (Get_Right_Limit (Expr));
if Range_Type /= Null_Iir then
Right := New_Convert_Ov (Right,
Get_Ortho_Type (Range_Type, Mode_Value));
end if;
return Right;
end Translate_Range_Expression_Right;
-- Compute the length of LEFT DIR (to/downto) RIGHT.
function Compute_Range_Length
(Left : O_Enode; Right : O_Enode; Dir : Iir_Direction) return O_Enode
is
Rng_Type : constant O_Tnode := Ghdl_I32_Type;
L : constant O_Enode := New_Convert_Ov (Left, Rng_Type);
R : constant O_Enode := New_Convert_Ov (Right, Rng_Type);
Val : O_Enode;
Tmp : O_Dnode;
Res : O_Dnode;
If_Blk : O_If_Block;
begin
case Dir is
when Iir_To =>
Val := New_Dyadic_Op (ON_Sub_Ov, R, L);
when Iir_Downto =>
Val := New_Dyadic_Op (ON_Sub_Ov, L, R);
end case;
Res := Create_Temp (Ghdl_Index_Type);
Open_Temp;
Tmp := Create_Temp (Rng_Type);
New_Assign_Stmt (New_Obj (Tmp), Val);
Start_If_Stmt
(If_Blk,
New_Compare_Op (ON_Lt, New_Obj_Value (Tmp),
New_Lit (New_Signed_Literal (Rng_Type, 0)),
Ghdl_Bool_Type));
Init_Var (Res);
New_Else_Stmt (If_Blk);
Val := New_Convert_Ov (New_Obj_Value (Tmp), Ghdl_Index_Type);
Val := New_Dyadic_Op (ON_Add_Ov, Val, New_Lit (Ghdl_Index_1));
New_Assign_Stmt (New_Obj (Res), Val);
Finish_If_Stmt (If_Blk);
Close_Temp;
return New_Obj_Value (Res);
end Compute_Range_Length;
function Translate_Range_Expression_Length (Expr : Iir) return O_Enode
is
Left, Right : O_Enode;
begin
if Get_Expr_Staticness (Expr) = Locally then
return New_Lit (Translate_Static_Range_Length (Expr));
else
Left := Chap7.Translate_Expression (Get_Left_Limit (Expr));
Right := Chap7.Translate_Expression (Get_Right_Limit (Expr));
return Compute_Range_Length (Left, Right, Get_Direction (Expr));
end if;
end Translate_Range_Expression_Length;