-- Interpreted simulation
-- Copyright (C) 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 GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Unchecked_Conversion;
with Ada.Text_IO; use Ada.Text_IO;
with System;
with Grt.Types; use Grt.Types;
with Flags; use Flags;
with Errorout; use Errorout;
with Std_Package;
with Evaluation;
with Iirs_Utils; use Iirs_Utils;
with Annotations; use Annotations;
with Name_Table;
with File_Operation;
with Debugger; use Debugger;
with Std_Names;
with Str_Table;
with Files_Map;
with Iir_Chains; use Iir_Chains;
with Simulation; use Simulation;
with Grt.Astdio;
with Grt.Stdio;
with Grt.Options;
with Grt.Vstrings;
with Grt_Interface;
with Grt.Values;
with Grt.Errors;
with Grt.Std_Logic_1164;
package body Execution is
function Execute_Function_Call
(Block: Block_Instance_Acc; Expr: Iir; Imp : Iir)
return Iir_Value_Literal_Acc;
procedure Finish_Sequential_Statements
(Proc : Process_State_Acc; Complex_Stmt : Iir);
procedure Init_Sequential_Statements
(Proc : Process_State_Acc; Complex_Stmt : Iir);
procedure Update_Next_Statement (Proc : Process_State_Acc);
-- Display a message when an assertion has failed.
procedure Execute_Failed_Assertion (Report : String;
Severity : Natural;
Stmt: Iir);
function Get_Instance_By_Scope
(Instance: Block_Instance_Acc; Scope: Scope_Type)
return Block_Instance_Acc
is
Current: Block_Instance_Acc := Instance;
begin
case Scope.Kind is
when Scope_Kind_Frame =>
while Current /= null loop
if Current.Block_Scope = Scope then
return Current;
end if;
Current := Current.Up_Block;
end loop;
raise Internal_Error;
when Scope_Kind_Package =>
-- Global scope (packages)
return Package_Instances (Scope.Pkg_Index);
when Scope_Kind_Component =>
pragma Assert (Current_Component /= null);
return Current_Component;
when Scope_Kind_None =>
raise Internal_Error;
when Scope_Kind_Pkg_Inst =>
raise Internal_Error;
end case;
end Get_Instance_By_Scope;
function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir)
return Block_Instance_Acc is
begin
return Get_Instance_By_Scope (Instance, Get_Info (Decl).Obj_Scope);
end Get_Instance_For_Slot;
procedure Create_Right_Bound_From_Length
(Bounds : Iir_Value_Literal_Acc; Len : Iir_Index32)
is
begin
pragma Assert (Bounds.Right = null);
case Bounds.Left.Kind is
when Iir_Value_E32 =>
declare
R : Ghdl_E32;
begin
case Bounds.Dir is
when Iir_To =>
R := Bounds.Left.E32 + Ghdl_E32 (Len - 1);
when Iir_Downto =>
R := Bounds.Left.E32 - Ghdl_E32 (Len - 1);
end case;
Bounds.Right := Create_E32_Value (R);
end;
when Iir_Value_I64 =>
declare
R : Ghdl_I64;
begin
case Bounds.Dir is
when Iir_To =>
R := Bounds.Left.I64 + Ghdl_I64 (Len - 1);
when Iir_Downto =>
R := Bounds.Left.I64 - Ghdl_I64 (Len - 1);
end case;
Bounds.Right := Create_I64_Value (R);
end;
when others =>
raise Internal_Error;
end case;
end Create_Right_Bound_From_Length;
function Create_Bounds_From_Length (Block : Block_Instance_Acc;
Atype : Iir;
Len : Iir_Index32)
return Iir_Value_Literal_Acc
is
Res : Iir_Value_Literal_Acc;
Index_Bounds : Iir_Value_Literal_Acc;
begin
Index_Bounds := Execute_Bounds (Block, Atype);
Res := Create_Range_Value (Left => Index_Bounds.Left,
Right => null,
Dir => Index_Bounds.Dir,
Length => Len);
if Len = 0 then
-- Special case.
Res.Right := Res.Left;
case Res.Left.Kind is
when Iir_Value_I64 =>
case Index_Bounds.Dir is
when Iir_To =>
Res.Left := Create_I64_Value (Res.Right.I64 + 1);
when Iir_Downto =>
Res.Left := Create_I64_Value (Res.Right.I64 - 1);
end case;
when others =>
raise Internal_Error;
end case;
else
Create_Right_Bound_From_Length (Res, Len);
end if;
return Res;
end Create_Bounds_From_Length;
function Execute_High_Limit (Bounds : Iir_Value_Literal_Acc)
return Iir_Value_Literal_Acc is
begin
if Bounds.Dir = Iir_To then
return Bounds.Right;
else
return Bounds.Left;
end if;
end Execute_High_Limit;
function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc)
return Iir_Value_Literal_Acc is
begin
if Bounds.Dir = Iir_To then
return Bounds.Left;
else
return Bounds.Right;
end if;
end Execute_Low_Limit;
function Execute_Left_Limit (Bounds : Iir_Value_Literal_Acc)
return Iir_Value_Literal_Acc is
begin
return Bounds.Left;
end Execute_Left_Limit;
function Execute_Right_Limit (Bounds : Iir_Value_Literal_Acc)
return Iir_Value_Literal_Acc is
begin
return Bounds.Right;
end Execute_Right_Limit;
function Execute_Length (Bounds : Iir_Value_Literal_Acc)
return Iir_Value_Literal_Acc is
begin
return Create_I64_Value (Ghdl_I64 (Bounds.Length));
end Execute_Length;
function Create_Enum_Value (Pos : Natural; Etype : Iir)
return Iir_Value_Literal_Acc
is
Base_Type : constant Iir := Get_Base_Type (Etype);
Mode : constant Iir_Value_Kind :=
Get_Info (Base_Type).Scalar_Mode;
begin
case Mode is
when Iir_Value_E32 =>
return Create_E32_Value (Ghdl_E32 (Pos));
when Iir_Value_B1 =>
return Create_B1_Value (Ghdl_B1'Val (Pos));
when others =>
raise Internal_Error;
end case;
end Create_Enum_Value;
function String_To_Iir_Value (Str : String) return Iir_Value_Literal_Acc
is
Res : Iir_Value_Literal_Acc;
begin
Res := Create_Array_Value (Str'Length, 1);
Res.Bounds.D (1) := Create_Range_Value
(Create_I64_Value (1),
Create_I64_Value (Str'Length),
Iir_To);
for I in Str'Range loop
Res.Val_Array.V (1 + Iir_Index32 (I - Str'First)) :=
Create_E32_Value (Character'Pos (Str (I)));
end loop;
return Res;
end String_To_Iir_Value;
function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc;
Expr_Type : Iir)
return String
is
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.Vstrings.To_String (Str, Last, Val.F64);
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.Vstrings.To_String (Str, First, Val.I64);
return Str (First .. Str'Last);
end;
when Iir_Kind_Enumeration_Type_Definition
| Iir_Kind_Enumeration_Subtype_Definition =>
declare
Lits : constant Iir_List :=
Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type));
Pos : Natural;
begin
case Val.Kind is
when Iir_Value_B1 =>
Pos := Ghdl_B1'Pos (Val.B1);
when Iir_Value_E32 =>
Pos := Ghdl_E32'Pos (Val.E32);
when others =>
raise Internal_Error;
end case;
return Name_Table.Image
(Get_Identifier (Get_Nth_Element (Lits, Pos)));
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.Vstrings.To_String (Str, First, Val.I64);
return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id);
end;
when others =>
Error_Kind ("execute_image_attribute", Expr_Type);
end case;
end Execute_Image_Attribute;
function Execute_Shift_Operator (Left : Iir_Value_Literal_Acc;
Count : Ghdl_I64;
Expr : Iir)
return Iir_Value_Literal_Acc
is
Func : constant Iir_Predefined_Shift_Functions :=
Get_Implicit_Definition (Get_Implementation (Expr));
Cnt : Iir_Index32;
Len : constant Iir_Index32 := Left.Bounds.D (1).Length;
Dir_Left : Boolean;
P : Iir_Index32;
Res : Iir_Value_Literal_Acc;
E : Iir_Value_Literal_Acc;
begin
-- LRM93 7.2.3
-- That is, if R is 0 or if L is a null array, the return value is L.
if Count = 0 or else Len = 0 then
return Left;
end if;
case Func is
when Iir_Predefined_Array_Sll
| Iir_Predefined_Array_Sla
| Iir_Predefined_Array_Rol =>
Dir_Left := True;
when Iir_Predefined_Array_Srl
| Iir_Predefined_Array_Sra
| Iir_Predefined_Array_Ror =>
Dir_Left := False;
end case;
if Count < 0 then
Cnt := Iir_Index32 (-Count);
Dir_Left := not Dir_Left;
else
Cnt := Iir_Index32 (Count);
end if;
case Func is
when Iir_Predefined_Array_Sll
| Iir_Predefined_Array_Srl =>
E := Create_Enum_Value
(0, Get_Element_Subtype (Get_Base_Type (Get_Type (Expr))));
when Iir_Predefined_Array_Sla
| Iir_Predefined_Array_Sra =>
if Dir_Left then
E := Left.Val_Array.V (Len);
else
E := Left.Val_Array.V (1);
end if;
when Iir_Predefined_Array_Rol
| Iir_Predefined_Array_Ror =>
Cnt := Cnt mod Len;
if not Dir_Left then
Cnt := (Len - Cnt) mod Len;
end if;
end case;
Res := Create_Array_Value (1);
Res.Bounds.D (1) := Left.Bounds.D (1);
Create_Array_Data (Res, Len);
P := 1;
case Func is
when Iir_Predefined_Array_Sll
| Iir_Predefined_Array_Srl
| Iir_Predefined_Array_Sla
| Iir_Predefined_Array_Sra =>
if Dir_Left then
if Cnt < Len then
for I in Cnt .. Len - 1 loop
Res.Val_Array.V (P) := Left.Val_Array.V (I + 1);
P := P + 1;
end loop;
else
Cnt := Len;
end if;
for I in 0 .. Cnt - 1 loop
Res.Val_Array.V (P) := E;
P := P + 1;
end loop;
else
if Cnt > Len then
Cnt := Len;
end if;
for I in 0 .. Cnt - 1 loop
Res.Val_Array.V (P) := E;
P := P + 1;
end loop;
for I in Cnt .. Len - 1 loop
Res.Val_Array.V (P) := Left.Val_Array.V (I - Cnt + 1);
P := P + 1;
end loop;
end if;
when Iir_Predefined_Array_Rol
| Iir_Predefined_Array_Ror =>
for I in 1 .. Len loop
Res.Val_Array.V (P) := Left.Val_Array.V (Cnt + 1);
P := P + 1;
Cnt := Cnt + 1;
if Cnt = Len then
Cnt := 0;
end if;
end loop;
end case;
return Res;
end Execute_Shift_Operator;
Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
"0123456789ABCDEF";
function Execute_Bit_Vector_To_String (Val : Iir_Value_Literal_Acc;
Log_Base : Natural)
return Iir_Value_Literal_Acc
is
Base : constant Natural := 2 ** Log_Base;
Blen : constant Natural := Natural (Val.Bounds.D (1).Length);
Str : String (1 .. (Blen + Log_Base - 1) / Log_Base);
Pos : Natural;
V : Natural;
N : Natural;
begin
V := 0;
N := 1;
Pos := Str'Last;
for I in reverse Val.Val_Array.V'Range loop
V := V + Ghdl_B1'Pos (Val.Val_Array.V (I).B1) * N;
N := N * 2;
if N = Base or else I = Val.Val_Array.V'First then
Str (Pos) := Hex_Chars (V);
Pos := Pos - 1;
N := 1;
V := 0;
end if;
end loop;
return String_To_Iir_Value (Str);
end Execute_Bit_Vector_To_String;
procedure Check_Std_Ulogic_Dc
(Loc : Iir; V : Grt.Std_Logic_1164.Std_Ulogic)
is
use Grt.Std_Logic_1164;
begin
if V = '-' then
Execute_Failed_Assertion
("STD_LOGIC_1164: '-' operand for matching ordering operator",
2, Loc);
end if;
end Check_Std_Ulogic_Dc;
-- EXPR is the expression whose implementation is an implicit function.
function Execute_Implicit_Function (Block : Block_Instance_Acc;
Expr: Iir;
Left_Param : Iir;
Right_Param : Iir;
Res_Type : Iir)
return Iir_Value_Literal_Acc
is
pragma Unsuppress (Overflow_Check);
Func : Iir_Predefined_Functions;
-- Rename definition for monadic operations.
Left, Right: Iir_Value_Literal_Acc;
Operand : Iir_Value_Literal_Acc renames Left;
Result: Iir_Value_Literal_Acc;
procedure Eval_Right is
begin
Right := Execute_Expression (Block, Right_Param);
end Eval_Right;
-- Eval right argument, check left and right have same length,
-- Create RESULT from left.
procedure Eval_Array is
begin
Eval_Right;
if Left.Bounds.D (1).Length /= Right.Bounds.D (1).Length then
Error_Msg_Constraint (Expr);
end if;
-- Need to copy as the result is modified.
Result := Unshare (Left, Expr_Pool'Access);
end Eval_Array;
Imp : Iir;
begin
Imp := Get_Implementation (Expr);
if Get_Kind (Imp) in Iir_Kinds_Denoting_Name then
Imp := Get_Named_Entity (Imp);
end if;
Func := Get_Implicit_Definition (Imp);
-- Eval left operand.
case Func is
when Iir_Predefined_Now_Function =>
Left := null;
when Iir_Predefined_Bit_Rising_Edge
| Iir_Predefined_Boolean_Rising_Edge
| Iir_Predefined_Bit_Falling_Edge
| Iir_Predefined_Boolean_Falling_Edge=>
Operand := Execute_Name (Block, Left_Param, True);
when others =>
Left := Execute_Expression (Block, Left_Param);
end case;
Right := null;
case Func is
when Iir_Predefined_Error =>
raise Internal_Error;
when Iir_Predefined_Array_Array_Concat
| Iir_Predefined_Element_Array_Concat
| Iir_Predefined_Array_Element_Concat
| Iir_Predefined_Element_Element_Concat =>
Eval_Right;
declare
-- Array length of the result.
Len: Iir_Index32;
-- Index into the result.
Pos: Iir_Index32;
begin
-- Compute the length of the result.
case Func is
when Iir_Predefined_Array_Array_Concat =>
Len := Left.Val_Array.Len + Right.Val_Array.Len;
when Iir_Predefined_Element_Array_Concat =>
Len := 1 + Right.Val_Array.Len;
when Iir_Predefined_Array_Element_Concat =>
Len := Left.Val_Array.Len + 1;
when Iir_Predefined_Element_Element_Concat =>
Len := 1 + 1;
when others =>
raise Program_Error;
end case;
if Func = Iir_Predefined_Array_Array_Concat
and then Left.Val_Array.Len = 0
then
if Flags.Vhdl_Std = Vhdl_87 then
-- LRM87 7.2.3
-- [...], unless the left operand is a null array, in
-- which case the result of the concatenation is the
-- right operand.
return Right;
else
-- LRM93 7.2.4
-- If both operands are null arrays, then the result of
-- the concatenation is the right operand.
if Right.Val_Array.Len = 0 then
return Right;
end if;
end if;
end if;
if Flags.Vhdl_Std = Vhdl_87
and then (Func = Iir_Predefined_Array_Array_Concat
or Func = Iir_Predefined_Array_Element_Concat)
then
-- LRM87 7.2.3 Adding Operators
-- The left bound if this result is the left bound of the
-- left operand, [...]. The direction of the result is the
-- direction of the left operand, unless the left operand
-- is a null array, in which case the direction of the
-- result is that of the right operand.
Result := Create_Array_Value (Len, 1);
Result.Bounds.D (1) := Create_Range_Value
(Left.Bounds.D (1).Left, null, Left.Bounds.D (1).Dir, Len);
Create_Right_Bound_From_Length (Result.Bounds.D (1), Len);
else
-- Create the array result.
Result := Create_Array_Value (Len, 1);
Result.Bounds.D (1) := Create_Bounds_From_Length
(Block,
Get_First_Element (Get_Index_Subtype_List (Res_Type)),
Len);
end if;
-- Fill the result: left.
case Func is
when Iir_Predefined_Array_Array_Concat
| Iir_Predefined_Array_Element_Concat =>
for I in Left.Val_Array.V'Range loop
Result.Val_Array.V (I) := Left.Val_Array.V (I);
end loop;
Pos := Left.Val_Array.Len;
when Iir_Predefined_Element_Array_Concat
| Iir_Predefined_Element_Element_Concat =>
Result.Val_Array.V (1) := Left;
Pos := 1;
when others =>
raise Program_Error;
end case;
-- Note: here POS is equal to the position of the last element
-- filled, or 0 if no elements were filled.
-- Fill the result: right.
case Func is
when Iir_Predefined_Array_Array_Concat
| Iir_Predefined_Element_Array_Concat =>
for I in Right.Val_Array.V'Range loop
Result.Val_Array.V (Pos + I) := Right.Val_Array.V (I);
end loop;
when Iir_Predefined_Array_Element_Concat
| Iir_Predefined_Element_Element_Concat =>
Result.Val_Array.V (Pos + 1) := Right;
when others =>
raise Program_Error;
end case;
end;
when Iir_Predefined_Bit_And
| Iir_Predefined_Boolean_And =>
if Left.B1 = Lit_Enum_0.B1 then
-- Short circuit operator.
Result := Lit_Enum_0;
else
Eval_Right;
Result := Boolean_To_Lit (Right.B1 = Lit_Enum_1.B1);
end if;
when Iir_Predefined_Bit_Nand
| Iir_Predefined_Boolean_Nand =>
if Left.B1 = Lit_Enum_0.B1 then
-- Short circuit operator.
Result := Lit_Enum_1;
else
Eval_Right;
Result := Boolean_To_Lit (Right.B1 = Lit_Enum_0.B1);
end if;
when Iir_Predefined_Bit_Or
| Iir_Predefined_Boolean_Or =>
if Left.B1 = Lit_Enum_1.B1 then
-- Short circuit operator.
Result := Lit_Enum_1;
else
Eval_Right;
Result := Boolean_To_Lit (Right.B1 = Lit_Enum_1.B1);
end if;
when Iir_Predefined_Bit_Nor
| Iir_Predefined_Boolean_Nor =>
if Left.B1 = Lit_Enum_1.B1 then
-- Short circuit operator.
Result := Lit_Enum_0;
else
Eval_Right;
Result := Boolean_To_Lit (Right.B1 = Lit_Enum_0.B1);
end if;
when Iir_Predefined_Bit_Xor
| Iir_Predefined_Boolean_Xor =>
Eval_Right;
Result := Boolean_To_Lit (Left.B1 /= Right.B1);
when Iir_Predefined_Bit_Xnor
| Iir_Predefined_Boolean_Xnor =>
Eval_Right;
Result := Boolean_To_Lit (Left.B1 = Right.B1);
when Iir_Predefined_Bit_Not
| Iir_Predefined_Boolean_Not =>
Result := Boolean_To_Lit (Operand.B1 = Lit_Enum_0.B1);
when Iir_Predefined_Bit_Condition =>
Result := Boolean_To_Lit (Operand.B1 = Lit_Enum_1.B1);
when Iir_Predefined_Array_Sll
| Iir_Predefined_Array_Srl
| Iir_Predefined_Array_Sla
| Iir_Predefined_Array_Sra
| Iir_Predefined_Array_Rol
| Iir_Predefined_Array_Ror =>
Eval_Right;
Result := Execute_Shift_Operator (Left, Right.I64, Expr);
when Iir_Predefined_Enum_Equality
| Iir_Predefined_Integer_Equality
| Iir_Predefined_Array_Equality
| Iir_Predefined_Access_Equality
| Iir_Predefined_Physical_Equality
| Iir_Predefined_Floating_Equality
| Iir_Predefined_Record_Equality
| Iir_Predefined_Bit_Match_Equality
| Iir_Predefined_Bit_Array_Match_Equality =>
Eval_Right;
Result := Boolean_To_Lit (Is_Equal (Left, Right));
when Iir_Predefined_Enum_Inequality
| Iir_Predefined_Integer_Inequality
| Iir_Predefined_Array_Inequality
| Iir_Predefined_Access_Inequality
| Iir_Predefined_Physical_Inequality
| Iir_Predefined_Floating_Inequality
| Iir_Predefined_Record_Inequality
| Iir_Predefined_Bit_Match_Inequality
| Iir_Predefined_Bit_Array_Match_Inequality =>
Eval_Right;
Result := Boolean_To_Lit (not Is_Equal (Left, Right));
when Iir_Predefined_Integer_Less
| Iir_Predefined_Physical_Less =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Boolean_To_Lit (Left.I64 < Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Greater
| Iir_Predefined_Physical_Greater =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Boolean_To_Lit (Left.I64 > Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Less_Equal
| Iir_Predefined_Physical_Less_Equal =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Boolean_To_Lit (Left.I64 <= Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Greater_Equal
| Iir_Predefined_Physical_Greater_Equal =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Boolean_To_Lit (Left.I64 >= Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Enum_Less =>
Eval_Right;
case Left.Kind is
when Iir_Value_B1 =>
Result := Boolean_To_Lit (Left.B1 < Right.B1);
when Iir_Value_E32 =>
Result := Boolean_To_Lit (Left.E32 < Right.E32);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Enum_Greater =>
Eval_Right;
case Left.Kind is
when Iir_Value_B1 =>
Result := Boolean_To_Lit (Left.B1 > Right.B1);
when Iir_Value_E32 =>
Result := Boolean_To_Lit (Left.E32 > Right.E32);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Enum_Less_Equal =>
Eval_Right;
case Left.Kind is
when Iir_Value_B1 =>
Result := Boolean_To_Lit (Left.B1 <= Right.B1);
when Iir_Value_E32 =>
Result := Boolean_To_Lit (Left.E32 <= Right.E32);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Enum_Greater_Equal =>
Eval_Right;
case Left.Kind is
when Iir_Value_B1 =>
Result := Boolean_To_Lit (Left.B1 >= Right.B1);
when Iir_Value_E32 =>
Result := Boolean_To_Lit (Left.E32 >= Right.E32);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Enum_Minimum
| Iir_Predefined_Physical_Minimum =>
Eval_Right;
if Compare_Value (Left, Right) = Less then
Result := Left;
else
Result := Right;
end if;
when Iir_Predefined_Enum_Maximum
| Iir_Predefined_Physical_Maximum =>
Eval_Right;
if Compare_Value (Left, Right) = Less then
Result := Right;
else
Result := Left;
end if;
when Iir_Predefined_Integer_Plus
| Iir_Predefined_Physical_Plus =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Create_I64_Value (Left.I64 + Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Minus
| Iir_Predefined_Physical_Minus =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Create_I64_Value (Left.I64 - Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Mul =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
Result := Create_I64_Value (Left.I64 * Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Mod =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
if Right.I64 = 0 then
Error_Msg_Constraint (Expr);
end if;
Result := Create_I64_Value (Left.I64 mod Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Rem =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
if Right.I64 = 0 then
Error_Msg_Constraint (Expr);
end if;
Result := Create_I64_Value (Left.I64 rem Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Div =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
if Right.I64 = 0 then
Error_Msg_Constraint (Expr);
end if;
Result := Create_I64_Value (Left.I64 / Right.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Absolute
| Iir_Predefined_Physical_Absolute =>
case Operand.Kind is
when Iir_Value_I64 =>
Result := Create_I64_Value (abs Operand.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Negation
| Iir_Predefined_Physical_Negation =>
case Operand.Kind is
when Iir_Value_I64 =>
Result := Create_I64_Value (-Operand.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Identity
| Iir_Predefined_Physical_Identity =>
case Operand.Kind is
when Iir_Value_I64 =>
Result := Create_I64_Value (Operand.I64);
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Exp =>
Eval_Right;
case Left.Kind is
when Iir_Value_I64 =>
if Right.I64 < 0 then
Error_Msg_Constraint (Expr);
end if;
Result := Create_I64_Value (Left.I64 ** Natural (Right.I64));
when others =>
raise Internal_Error;
end case;
when Iir_Predefined_Integer_Minimum =>
Eval_Right;
Result := Create_I64_Value (Ghdl_I64'Min (Left.I64, Right.I64));
when Iir_Predefined_Integer_Maximum =>
Eval_Right;
Result := Create_I64_Value (Ghdl_I64'Max (Left.I64, Right.I64));
when Iir_Predefined_Floating_Mul =>
Eval_Right;
Result := Create_F64_Value (Left.F64 * Right.F64);
when Iir_Predefined_Floating_Div =>
Eval_Right;
Result := Create_F64_Value (Left.F64 / Right.F64);
when Iir_Predefined_Floating_Minus =>
Eval_Right;
Result := Create_F64_Value (Left.F64 - Right.F64);
when Iir_Predefined_Floating_Plus =>
Eval_Right;
Result := Create_F64_Value (Left.F64 + Right.F64);
when Iir_Predefined_Floating_Exp =>
Eval_Right;
Result := Create_F64_Value (Left.F64 ** Integer (Right.I64));
when Iir_Predefined_Floating_Identity =>
Result := Create_F64_Value (Operand.F64);
when Iir_Predefined_Floating_Negation =>
Result := Create_F64_Value (-Operand.F64);
when Iir_Predefined_Floating_Absolute =>
Result := Create_F64_Value (abs (Operand.F64));
when Iir_Predefined_Floating_Less =>
Eval_Right;
Result := Boolean_To_Lit (Left.F64 < Right.F64);
when Iir_Predefined_Floating_Less_Equal =>
Eval_Right;
Result := Boolean_To_Lit (Left.F64 <= Right.F64);
when Iir_Predefined_Floating_Greater =>
Eval_Right;
Result := Boolean_To_Lit (Left.F64 > Right.F64);
when Iir_Predefined_Floating_Greater_Equal =>
Eval_Right;
Result := Boolean_To_Lit (Left.F64 >= Right.F64);
when Iir_Predefined_Floating_Minimum =>
Eval_Right;
Result := Create_F64_Value (Ghdl_F64'Min (Left.F64, Right.F64));
when Iir_Predefined_Floating_Maximum =>
Eval_Right;
Result := Create_F64_Value (Ghdl_F64'Max (Left.F64, Right.F64));
when Iir_Predefined_Integer_Physical_Mul =>
Eval_Right;
Result := Create_I64_Value (Left.I64 * Right.I64);
when Iir_Predefined_Physical_Integer_Mul =>
Eval_Right;
Result := Create_I64_Value (Left.I64 * Right.I64);
when Iir_Predefined_Physical_Physical_Div =>
Eval_Right;
Result := Create_I64_Value (Left.I64 / Right.I64);
when Iir_Predefined_Physical_Integer_Div =>
Eval_Right;
Result := Create_I64_Value (Left.I64 / Right.I64);
when Iir_Predefined_Real_Physical_Mul =>
Eval_Right;
Result := Create_I64_Value
(Ghdl_I64 (Left.F64 * Ghdl_F64 (Right.I64)));
when Iir_Predefined_Physical_Real_Mul =>
Eval_Right;
Result := Create_I64_Value
(Ghdl_I64 (Ghdl_F64 (Left.I64) * Right.F64));
when Iir_Predefined_Physical_Real_Div =>
Eval_Right;
Result := Create_I64_Value
(Ghdl_I64 (Ghdl_F64 (Left.I64) / Right.F64));
when Iir_Predefined_Universal_I_R_Mul =>
Eval_Right;
Result := Create_F64_Value (Ghdl_F64 (Left.I64) * Right.F64);
when Iir_Predefined_Universal_R_I_Mul =>
Eval_Right;
Result := Create_F64_Value (Left.F64 * Ghdl_F64 (Right.I64));
when Iir_Predefined_TF_Array_And =>
Eval_Array;
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
Result.Val_Array.V (I).B1 and Right.Val_Array.V (I).B1;
end loop;
when Iir_Predefined_TF_Array_Nand =>
Eval_Array;
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
not (Result.Val_Array.V (I).B1 and Right.Val_Array.V (I).B1);
end loop;
when Iir_Predefined_TF_Array_Or =>
Eval_Array;
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
Result.Val_Array.V (I).B1 or Right.Val_Array.V (I).B1;
end loop;
when Iir_Predefined_TF_Array_Nor =>
Eval_Array;
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
not (Result.Val_Array.V (I).B1 or Right.Val_Array.V (I).B1);
end loop;
when Iir_Predefined_TF_Array_Xor =>
Eval_Array;
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
Result.Val_Array.V (I).B1 xor Right.Val_Array.V (I).B1;
end loop;
when Iir_Predefined_TF_Array_Xnor =>
Eval_Array;
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
not (Result.Val_Array.V (I).B1 xor Right.Val_Array.V (I).B1);
end loop;
when Iir_Predefined_TF_Array_Element_And =>
Eval_Right;
Result := Unshare (Left, Expr_Pool'Access);
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
Result.Val_Array.V (I).B1 and Right.B1;
end loop;
when Iir_Predefined_TF_Element_Array_And =>
Eval_Right;
Result := Unshare (Right, Expr_Pool'Access);
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=
Result.Val_Array.V (I).B1 and Left.B1;
end loop;
when Iir_Predefined_TF_Array_Element_Or =>
Eval_Right;
Result := Unshare (Left, Expr_Pool'Access);
for I in Result.Val_Array.V'Range loop
Result.Val_Array.V (I).B1 :=