diff options
author | Tristan Gingold <tgingold@free.fr> | 2016-02-10 07:52:03 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2016-02-10 07:52:53 +0100 |
commit | 2f9d5462b70ef1d261bcc7ffca4faaa85400d465 (patch) | |
tree | b171ee56d859f9b41bd3a3500a89b7e494af19b5 /src | |
parent | 8f82f32b357d5c5a9211d677b11297022336b038 (diff) | |
download | ghdl-2f9d5462b70ef1d261bcc7ffca4faaa85400d465.tar.gz ghdl-2f9d5462b70ef1d261bcc7ffca4faaa85400d465.tar.bz2 ghdl-2f9d5462b70ef1d261bcc7ffca4faaa85400d465.zip |
simul: add support of e8.
Diffstat (limited to 'src')
-rw-r--r-- | src/vhdl/simulate/annotations.adb | 33 | ||||
-rw-r--r-- | src/vhdl/simulate/debugger.adb | 5 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.adb | 19 | ||||
-rw-r--r-- | src/vhdl/simulate/execution.adb | 182 | ||||
-rw-r--r-- | src/vhdl/simulate/file_operation.adb | 20 | ||||
-rw-r--r-- | src/vhdl/simulate/grt_interface.adb | 2 | ||||
-rw-r--r-- | src/vhdl/simulate/iir_values.adb | 76 | ||||
-rw-r--r-- | src/vhdl/simulate/iir_values.ads | 12 | ||||
-rw-r--r-- | src/vhdl/simulate/simulation.adb | 26 |
9 files changed, 205 insertions, 170 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index b5dcef417..e11bfed2d 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -186,7 +186,7 @@ package body Annotations is Res : in out String; Off : in out Natural) is - Scalar_Map : constant array (Iir_Value_Scalars) of Character := "bEIF"; + Scalar_Map : constant array (Iir_Value_Scalars) of Character := "beEIF"; begin case Get_Kind (Def) is when Iir_Kinds_Scalar_Type_Definition => @@ -301,18 +301,25 @@ package body Annotations is case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition => - if Def = Std_Package.Boolean_Type_Definition - or else Def = Std_Package.Bit_Type_Definition - then - Set_Info (Def, - new Sim_Info_Type'(Kind => Kind_Scalar_Type, - Scalar_Mode => Iir_Value_B1)); - else - Set_Info (Def, - new Sim_Info_Type'(Kind => Kind_Scalar_Type, - Scalar_Mode => Iir_Value_E32)); - end if; - Annotate_Range_Expression (Block_Info, Get_Range_Constraint (Def)); + declare + Mode : Iir_Value_Kind; + begin + if Def = Std_Package.Boolean_Type_Definition + or else Def = Std_Package.Bit_Type_Definition + then + Mode := Iir_Value_B1; + elsif (Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)) + <= 256) + then + Mode := Iir_Value_E8; + else + Mode := Iir_Value_E32; + end if; + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_Scalar_Type, + Scalar_Mode => Mode)); + Annotate_Range_Expression + (Block_Info, Get_Range_Constraint (Def)); + end; when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index 54e1b42a1..bbb16e231 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -362,10 +362,7 @@ package body Debugger is return; end if; case Value.Kind is - when Iir_Value_I64 - | Iir_Value_F64 - | Iir_Value_E32 - | Iir_Value_B1 + when Iir_Value_Scalars | Iir_Value_Access => Disp_Iir_Value (Value, A_Type); when Iir_Value_Array => diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index b18dda1b8..571abf705 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -93,10 +93,7 @@ package body Elaboration is Res.Val_Record.V (I) := Create_Signal (Lit.Val_Record.V (I)); end loop; - when Iir_Value_I64 - | Iir_Value_F64 - | Iir_Value_B1 - | Iir_Value_E32 => + when Iir_Value_Scalars => Res := Create_Signal_Value (null); when Iir_Value_Signal @@ -515,17 +512,19 @@ package body Elaboration is Bounds := Execute_Bounds (Block, Decl); Res := Bounds.Left; when Init_Value_Any => - case Get_Info (Get_Base_Type (Decl)).Scalar_Mode is + case Iir_Value_Scalars + (Get_Info (Get_Base_Type (Decl)).Scalar_Mode) + is when Iir_Value_B1 => Res := Create_B1_Value (False); + when Iir_Value_E8 => + Res := Create_E8_Value (0); when Iir_Value_E32 => Res := Create_E32_Value (0); when Iir_Value_I64 => Res := Create_I64_Value (0); when Iir_Value_F64 => Res := Create_F64_Value (0.0); - when others => - raise Internal_Error; end case; when Init_Value_Signal => Res := Create_Signal_Value (null); @@ -670,7 +669,7 @@ package body Elaboration is if Slot /= Instance.Elab_Objects + 1 or else Instance.Objects (Slot) /= null then - Error_Msg_Elab ("bad elaboration order"); + Error_Msg_Elab ("bad elaboration order", Decl); raise Internal_Error; end if; -- One slot is reserved for default value @@ -2830,9 +2829,7 @@ package body Elaboration is end if; -- Sanity check: memory area for expressions must be empty. - if not Is_Empty (Expr_Pool) then - raise Internal_Error; - end if; + pragma Assert (Is_Empty (Expr_Pool)); end Elaborate_Design; end Elaboration; diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index cf9fecac5..3d6cfd3d3 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -222,13 +222,13 @@ package body Execution is Mode : constant Iir_Value_Kind := Get_Info (Base_Type).Scalar_Mode; begin - case Mode is + case Iir_Value_Enums (Mode) is + when Iir_Value_E8 => + return Create_E8_Value (Ghdl_E8 (Pos)); 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; @@ -243,7 +243,7 @@ package body Execution is 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))); + Create_E8_Value (Character'Pos (Str (I))); end loop; return Res; end String_To_Iir_Value; @@ -279,13 +279,13 @@ package body Execution is Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type)); Pos : Natural; begin - case Val.Kind is + case Iir_Value_Enums (Val.Kind) is when Iir_Value_B1 => Pos := Ghdl_B1'Pos (Val.B1); + when Iir_Value_E8 => + Pos := Ghdl_E8'Pos (Val.E8); 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))); @@ -805,81 +805,25 @@ package body Execution is Eval_Right; Result := Boolean_To_Lit (not Is_Equal (Left, Right)); when Iir_Predefined_Integer_Less - | Iir_Predefined_Physical_Less => + | Iir_Predefined_Physical_Less + | Iir_Predefined_Enum_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; + Result := Boolean_To_Lit (Compare_Value (Left, Right) < Equal); when Iir_Predefined_Integer_Greater - | Iir_Predefined_Physical_Greater => + | Iir_Predefined_Physical_Greater + | Iir_Predefined_Enum_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; + Result := Boolean_To_Lit (Compare_Value (Left, Right) > Equal); when Iir_Predefined_Integer_Less_Equal - | Iir_Predefined_Physical_Less_Equal => + | Iir_Predefined_Physical_Less_Equal + | Iir_Predefined_Enum_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; + Result := Boolean_To_Lit (Compare_Value (Left, Right) <= Equal); 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 => + | Iir_Predefined_Physical_Greater_Equal + | 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; + Result := Boolean_To_Lit (Compare_Value (Left, Right) >= Equal); when Iir_Predefined_Enum_Minimum | Iir_Predefined_Physical_Minimum => @@ -1639,7 +1583,7 @@ package body Execution is if Index.Kind /= Left_Pos.Kind or else Index.Kind /= Right_Pos.Kind then raise Internal_Error; end if; - case Index.Kind is + case Iir_Value_Discrete (Index.Kind) is when Iir_Value_B1 => case Bounds.Dir is when Iir_To => @@ -1657,6 +1601,23 @@ package body Execution is return Ghdl_B1'Pos (Left_Pos.B1) - Ghdl_B1'Pos (Index.B1); end if; end case; + when Iir_Value_E8 => + case Bounds.Dir is + when Iir_To => + if Index.E8 >= Left_Pos.E8 and then + Index.E8 <= Right_Pos.E8 + then + -- to + return Iir_Index32 (Index.E8 - Left_Pos.E8); + end if; + when Iir_Downto => + if Index.E8 <= Left_Pos.E8 and then + Index.E8 >= Right_Pos.E8 + then + -- downto + return Iir_Index32 (Left_Pos.E8 - Index.E8); + end if; + end case; when Iir_Value_E32 => case Bounds.Dir is when Iir_To => @@ -1691,8 +1652,6 @@ package body Execution is return Iir_Index32 (Left_Pos.I64 - Index.I64); end if; end case; - when others => - raise Internal_Error; end case; Error_Msg_Constraint (Expr); return 0; @@ -1774,6 +1733,8 @@ package body Execution is case Element_Mode is when Iir_Value_B1 => El := Create_B1_Value (Ghdl_B1'Val (Pos)); + when Iir_Value_E8 => + El := Create_E8_Value (Ghdl_E8'Val (Pos)); when Iir_Value_E32 => El := Create_E32_Value (Ghdl_E32'Val (Pos)); when others => @@ -2431,12 +2392,17 @@ package body Execution is is Res : Iir_Value_Literal_Acc; begin - case Val.Kind is + case Iir_Value_Discrete (Val.Kind) is when Iir_Value_B1 => if Val.B1 = False then Error_Msg_Constraint (Expr); end if; Res := Create_B1_Value (False); + when Iir_Value_E8 => + if Val.E8 = 0 then + Error_Msg_Constraint (Expr); + end if; + Res := Create_E8_Value (Val.E8 - 1); when Iir_Value_E32 => if Val.E32 = 0 then Error_Msg_Constraint (Expr); @@ -2447,8 +2413,6 @@ package body Execution is Error_Msg_Constraint (Expr); end if; Res := Create_I64_Value (Val.I64 - 1); - when others => - raise Internal_Error; end case; return Res; end Execute_Dec; @@ -2460,7 +2424,7 @@ package body Execution is is Res : Iir_Value_Literal_Acc; begin - case Val.Kind is + case Iir_Value_Discrete (Val.Kind) is when Iir_Value_B1 => if Val.B1 = True then Error_Msg_Constraint (Expr); @@ -2471,13 +2435,16 @@ package body Execution is Error_Msg_Constraint (Expr); end if; Res := Create_E32_Value (Val.E32 + 1); + when Iir_Value_E8 => + if Val.E8 = Ghdl_E8'Last then + Error_Msg_Constraint (Expr); + end if; + Res := Create_E8_Value (Val.E8 + 1); when Iir_Value_I64 => if Val.I64 = Ghdl_I64'Last then Error_Msg_Constraint (Expr); end if; Res := Create_I64_Value (Val.I64 + 1); - when others => - raise Internal_Error; end case; return Res; end Execute_Inc; @@ -3018,6 +2985,8 @@ package body Execution is case Get_Info (Lit_Type).Scalar_Mode is when Iir_Value_B1 => return Create_B1_Value (Ghdl_B1'Val (Lit)); + when Iir_Value_E8 => + return Create_E8_Value (Ghdl_E8'Val (Lit)); when Iir_Value_E32 => return Create_E32_Value (Ghdl_E32 (Lit)); when others => @@ -3149,16 +3118,15 @@ package body Execution is Get_Info (Base_Type).Scalar_Mode; begin Res := Execute_Expression (Block, Get_Parameter (Expr)); - case Mode is + case Iir_Value_Discrete (Mode) is when Iir_Value_I64 => null; + when Iir_Value_E8 => + Res := Create_E8_Value (Ghdl_E8 (Res.I64)); when Iir_Value_E32 => Res := Create_E32_Value (Ghdl_E32 (Res.I64)); when Iir_Value_B1 => Res := Create_B1_Value (Ghdl_B1'Val (Res.I64)); - when others => - Error_Kind ("execute_expression(val attribute)", - Prefix_Type); end case; Check_Constraints (Block, Res, Prefix_Type, Expr); return Res; @@ -3173,18 +3141,18 @@ package body Execution is Get_Info (Base_Type).Scalar_Mode; begin Res := Execute_Expression (Block, Get_Parameter (Expr)); - case Mode is + case Iir_Value_Discrete (Mode) is when Iir_Value_I64 => null; when Iir_Value_B1 => N_Res := Create_I64_Value (Ghdl_B1'Pos (Res.B1)); Res := N_Res; + when Iir_Value_E8 => + N_Res := Create_I64_Value (Ghdl_I64 (Res.E8)); + Res := N_Res; when Iir_Value_E32 => N_Res := Create_I64_Value (Ghdl_I64 (Res.E32)); Res := N_Res; - when others => - Error_Kind ("execute_expression(pos attribute)", - Base_Type); end case; Check_Constraints (Block, Res, Get_Type (Expr), Expr); return Res; @@ -3924,11 +3892,15 @@ package body Execution is High := Bound.Left; Low := Bound.Right; end if; - case Get_Info (Base_Type).Scalar_Mode is + case Iir_Value_Scalars (Get_Info (Base_Type).Scalar_Mode) is when Iir_Value_I64 => if Value.I64 in Low.I64 .. High.I64 then return; end if; + when Iir_Value_E8 => + if Value.E8 in Low.E8 .. High.E8 then + return; + end if; when Iir_Value_E32 => if Value.E32 in Low.E32 .. High.E32 then return; @@ -3941,8 +3913,6 @@ package body Execution is if Value.B1 in Low.B1 .. High.B1 then return; end if; - when others => - raise Internal_Error; end case; when Iir_Kind_Array_Subtype_Definition | Iir_Kind_Array_Type_Definition => @@ -4182,7 +4152,7 @@ package body Execution is begin for I in Report.Val_Array.V'Range loop Msg (Positive (I)) := - Character'Val (Report.Val_Array.V (I).E32); + Character'Val (Report.Val_Array.V (I).E8); end loop; Execute_Failed_Assertion (Msg, Severity, Stmt); end; @@ -4212,7 +4182,7 @@ package body Execution is Expr := Get_Severity_Expression (Stmt); if Expr /= Null_Iir then Severity_Lit := Execute_Expression (Instance, Expr); - Severity := Natural'Val (Severity_Lit.E32); + Severity := Natural'Val (Severity_Lit.E8); else Severity := Default_Severity; end if; @@ -4270,16 +4240,15 @@ package body Execution is Max := Bounds.Left; end case; - case Val.Kind is + case Iir_Value_Discrete (Val.Kind) is + when Iir_Value_E8 => + return Val.E8 >= Min.E8 and Val.E8 <= Max.E8; when Iir_Value_E32 => return Val.E32 >= Min.E32 and Val.E32 <= Max.E32; when Iir_Value_B1 => return Val.B1 >= Min.B1 and Val.B1 <= Max.B1; when Iir_Value_I64 => return Val.I64 >= Min.I64 and Val.I64 <= Max.I64; - when others => - raise Internal_Error; - return False; end case; end Is_In_Range; @@ -4289,7 +4258,14 @@ package body Execution is Bounds : Iir_Value_Literal_Acc) is begin - case Val.Kind is + case Iir_Value_Discrete (Val.Kind) is + when Iir_Value_E8 => + case Bounds.Dir is + when Iir_To => + Val.E8 := Val.E8 + 1; + when Iir_Downto => + Val.E8 := Val.E8 - 1; + end case; when Iir_Value_E32 => case Bounds.Dir is when Iir_To => @@ -4311,8 +4287,6 @@ package body Execution is when Iir_Downto => Val.I64 := Val.I64 - 1; end case; - when others => - raise Internal_Error; end case; end Update_Loop_Index; diff --git a/src/vhdl/simulate/file_operation.adb b/src/vhdl/simulate/file_operation.adb index 7addb3a26..d5d141c53 100644 --- a/src/vhdl/simulate/file_operation.adb +++ b/src/vhdl/simulate/file_operation.adb @@ -46,7 +46,7 @@ package body File_Operation is -- Convert the string to an Ada string. for I in External_Name.Val_Array.V'Range loop Name_Str (Name_Str'First + Ghdl_Index_Type (I - 1)) := - Character'Val (External_Name.Val_Array.V (I).E32); + Character'Val (External_Name.Val_Array.V (I).E8); end loop; if Is_Text then @@ -77,7 +77,7 @@ package body File_Operation is is pragma Unreferenced (Stmt); Is_Text : constant Boolean := Get_Text_File_Flag (Get_Type (File_Decl)); - File_Mode : constant Ghdl_I32 := Ghdl_I32 (Mode.E32); + File_Mode : constant Ghdl_I32 := Ghdl_I32 (Mode.E8); Status : Ghdl_I32; begin File_Open (Status, File, Name, File_Mode, Is_Text, False); @@ -95,11 +95,11 @@ package body File_Operation is is pragma Unreferenced (Stmt); Is_Text : constant Boolean := Get_Text_File_Flag (Get_Type (File_Decl)); - File_Mode : constant Ghdl_I32 := Ghdl_I32 (Mode.E32); + File_Mode : constant Ghdl_I32 := Ghdl_I32 (Mode.E8); R_Status : Ghdl_I32; begin File_Open (R_Status, File, Name, File_Mode, Is_Text, True); - Status.E32 := Ghdl_E32 (R_Status); + Status.E8 := Ghdl_E8 (R_Status); end File_Open_Status; function Elaborate_File_Declaration @@ -144,7 +144,7 @@ package body File_Operation is File_Name := Execute_Expression (Instance, External_Name); if Get_File_Open_Kind (Decl) /= Null_Iir then Mode := Execute_Expression (Instance, Get_File_Open_Kind (Decl)); - File_Mode := Ghdl_I32 (Mode.E32); + File_Mode := Ghdl_I32 (Mode.E8); else case Get_Mode (Decl) is when Iir_In_Mode => @@ -190,6 +190,8 @@ package body File_Operation is Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.B1'Address), 1); when Iir_Value_I64 => Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.I64'Address), 8); + when Iir_Value_E8 => + Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.E8'Address), 1); when Iir_Value_E32 => Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.E32'Address), 4); when Iir_Value_F64 => @@ -224,7 +226,7 @@ package body File_Operation is -- Convert the string to an Ada string. for I in Value.Val_Array.V'Range loop Val_Str (Val_Str'First + Ghdl_Index_Type (I - 1)) := - Character'Val (Value.Val_Array.V (I).E32); + Character'Val (Value.Val_Array.V (I).E8); end loop; Ghdl_Text_Write (File.File, Val'Unrestricted_Access); @@ -252,7 +254,7 @@ package body File_Operation is begin Len := Ghdl_Text_Read_Length (File.File, Val'Unrestricted_Access); for I in 1 .. Len loop - Value.Val_Array.V (Iir_Index32 (I)).E32 := + Value.Val_Array.V (Iir_Index32 (I)).E8 := Character'Pos (Val_Str (Ghdl_Index_Type (I))); end loop; Length.I64 := Ghdl_I64 (Len); @@ -273,7 +275,7 @@ package body File_Operation is Ghdl_Untruncated_Text_Read (File.File, Val'Unrestricted_Access, Len'Unrestricted_Access); for I in 1 .. Len loop - Str.Val_Array.V (Iir_Index32 (I)).E32 := + Str.Val_Array.V (Iir_Index32 (I)).E8 := Character'Pos (Val_Str (Ghdl_Index_Type (I))); end loop; Length.I64 := Ghdl_I64 (Len); @@ -288,6 +290,8 @@ package body File_Operation is Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.B1'Address), 1); when Iir_Value_I64 => Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.I64'Address), 8); + when Iir_Value_E8 => + Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.E8'Address), 1); when Iir_Value_E32 => Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.E32'Address), 4); when Iir_Value_F64 => diff --git a/src/vhdl/simulate/grt_interface.adb b/src/vhdl/simulate/grt_interface.adb index c4eab58c4..604d30d01 100644 --- a/src/vhdl/simulate/grt_interface.adb +++ b/src/vhdl/simulate/grt_interface.adb @@ -38,7 +38,7 @@ package body Grt_Interface is begin for I in Val.Val_Array.V'Range loop Str.Base (Ghdl_Index_Type (I - 1)) := - Character'Val (Val.Val_Array.V (I).E32); + Character'Val (Val.Val_Array.V (I).E8); end loop; end Set_Std_String_From_Iir_Value; end Grt_Interface; diff --git a/src/vhdl/simulate/iir_values.adb b/src/vhdl/simulate/iir_values.adb index 3d308e7f6..7ebcc6816 100644 --- a/src/vhdl/simulate/iir_values.adb +++ b/src/vhdl/simulate/iir_values.adb @@ -33,6 +33,8 @@ package body Iir_Values is case Left.Kind is when Iir_Value_B1 => return Left.B1 = Right.B1; + when Iir_Value_E8 => + return Left.E8 = Right.E8; when Iir_Value_E32 => return Left.E32 = Right.E32; when Iir_Value_I64 => @@ -105,6 +107,14 @@ package body Iir_Values is else return Greater; end if; + when Iir_Value_E8 => + if Left.E8 < Right.E8 then + return Less; + elsif Left.E8 = Right.E8 then + return Equal; + else + return Greater; + end if; when Iir_Value_E32 => if Left.E32 < Right.E32 then return Less; @@ -211,6 +221,8 @@ package body Iir_Values is else raise Constraint_Error; end if; + when Iir_Value_E8 => + Val.E8 := Val.E8 + 1; when Iir_Value_E32 => Val.E32 := Val.E32 + 1; when Iir_Value_I64 => @@ -253,6 +265,8 @@ package body Iir_Values is end loop; when Iir_Value_B1 => Dest.B1 := Src.B1; + when Iir_Value_E8 => + Dest.E8 := Src.E8; when Iir_Value_E32 => Dest.E32 := Src.E32; when Iir_Value_I64 => @@ -307,10 +321,7 @@ package body Iir_Values is if Src.Kind /= Dest.Kind then raise Internal_Error; end if; - when Iir_Value_B1 - | Iir_Value_E32 - | Iir_Value_I64 - | Iir_Value_F64 + when Iir_Value_Scalars | Iir_Value_Signal => return; when Iir_Value_Range @@ -393,6 +404,15 @@ package body Iir_Values is (Alloc (Current_Pool, (Kind => Iir_Value_B1, B1 => Val))); end Create_B1_Value; + function Create_E8_Value (Val : Ghdl_E8) return Iir_Value_Literal_Acc + is + subtype E8_Value is Iir_Value_Literal (Iir_Value_E8); + function Alloc is new Alloc_On_Pool_Addr (E8_Value); + begin + return To_Iir_Value_Literal_Acc + (Alloc (Current_Pool, (Kind => Iir_Value_E8, E8 => Val))); + end Create_E8_Value; + function Create_E32_Value (Val : Ghdl_E32) return Iir_Value_Literal_Acc is subtype E32_Value is Iir_Value_Literal (Iir_Value_E32); @@ -491,6 +511,12 @@ package body Iir_Values is else Len := 0; end if; + when Iir_Value_E8 => + if High.E8 >= Low.E8 then + Len := Iir_Index32 (High.E8 - Low.E8 + 1); + else + Len := 0; + end if; when Iir_Value_I64 => declare L : Ghdl_I64; @@ -610,14 +636,16 @@ package body Iir_Values is Res: Iir_Value_Literal_Acc; begin case Src.Kind is + when Iir_Value_B1 => + return Create_B1_Value (Src.B1); when Iir_Value_E32 => return Create_E32_Value (Src.E32); + when Iir_Value_E8 => + return Create_E8_Value (Src.E8); when Iir_Value_I64 => return Create_I64_Value (Src.I64); when Iir_Value_F64 => return Create_F64_Value (Src.F64); - when Iir_Value_B1 => - return Create_B1_Value (Src.B1); when Iir_Value_Access => return Create_Access_Value (Src.Val_Access); when Iir_Value_Array => @@ -762,6 +790,8 @@ package body Iir_Values is function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural is begin case Val.Kind is + when Iir_Value_E8 => + return Ghdl_E8'Pos (Val.E8); when Iir_Value_E32 => return Ghdl_E32'Pos (Val.E32); when Iir_Value_B1 => @@ -790,6 +820,8 @@ package body Iir_Values is case Value.Kind is when Iir_Value_B1 => Put_Line ("b1:" & Ghdl_B1'Image (Value.B1)); + when Iir_Value_E8 => + Put_Line ("E8:" & Ghdl_E8'Image (Value.E8)); when Iir_Value_E32 => Put_Line ("e32:" & Ghdl_E32'Image (Value.E32)); when Iir_Value_I64 => @@ -1021,6 +1053,16 @@ package body Iir_Values is Put (")"); end Disp_Iir_Value_Record; + procedure Disp_Iir_Value_Enum (Pos : Natural; A_Type : Iir) + is + Bt : constant Iir := Get_Base_Type (A_Type); + Id : Name_Id; + begin + Id := Get_Identifier + (Get_Nth_Element (Get_Enumeration_Literal_List (Bt), Pos)); + Ada.Text_IO.Put (Name_Table.Image (Id)); + end Disp_Iir_Value_Enum; + procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir) is use Ada.Text_IO; begin @@ -1033,22 +1075,12 @@ package body Iir_Values is Put (Ghdl_I64'Image (Value.I64)); when Iir_Value_F64 => Put (Ghdl_F64'Image (Value.F64)); - when Iir_Value_E32 - | Iir_Value_B1 => - declare - Bt : constant Iir := Get_Base_Type (A_Type); - Id : Name_Id; - Pos : Integer; - begin - if Value.Kind = Iir_Value_E32 then - Pos := Ghdl_E32'Pos (Value.E32); - else - Pos := Ghdl_B1'Pos (Value.B1); - end if; - Id := Get_Identifier - (Get_Nth_Element (Get_Enumeration_Literal_List (Bt), Pos)); - Put (Name_Table.Image (Id)); - end; + when Iir_Value_E32 => + Disp_Iir_Value_Enum (Ghdl_E32'Pos (Value.E32), A_Type); + when Iir_Value_E8 => + Disp_Iir_Value_Enum (Ghdl_E8'Pos (Value.E8), A_Type); + when Iir_Value_B1 => + Disp_Iir_Value_Enum (Ghdl_B1'Pos (Value.B1), A_Type); when Iir_Value_Access => if Value.Val_Access = null then Put ("null"); diff --git a/src/vhdl/simulate/iir_values.ads b/src/vhdl/simulate/iir_values.ads index aeb9b4f49..292e8424a 100644 --- a/src/vhdl/simulate/iir_values.ads +++ b/src/vhdl/simulate/iir_values.ads @@ -102,7 +102,7 @@ package Iir_Values is -- not done within the context of a process). type Iir_Value_Kind is - (Iir_Value_B1, Iir_Value_E32, + (Iir_Value_B1, Iir_Value_E8, Iir_Value_E32, Iir_Value_I64, Iir_Value_F64, Iir_Value_Access, Iir_Value_File, @@ -124,6 +124,12 @@ package Iir_Values is subtype Iir_Value_Scalars is Iir_Value_Kind range Iir_Value_B1 .. Iir_Value_F64; + subtype Iir_Value_Discrete is + Iir_Value_Kind range Iir_Value_B1 .. Iir_Value_I64; + + subtype Iir_Value_Enums is + Iir_Value_Kind range Iir_Value_B1 .. Iir_Value_E32; + -- Abstrace numeric types. subtype Iir_Value_Numerics is Iir_Value_Kind range Iir_Value_I64 .. Iir_Value_F64; @@ -155,6 +161,8 @@ package Iir_Values is case Kind is when Iir_Value_B1 => B1 : Ghdl_B1; + when Iir_Value_E8 => + E8 : Ghdl_E8; when Iir_Value_E32 => E32 : Ghdl_E32; when Iir_Value_I64 => @@ -211,7 +219,7 @@ package Iir_Values is return Iir_Value_Literal_Acc; function Create_B1_Value (Val : Ghdl_B1) return Iir_Value_Literal_Acc; - + function Create_E8_Value (Val : Ghdl_E8) return Iir_Value_Literal_Acc; function Create_E32_Value (Val : Ghdl_E32) return Iir_Value_Literal_Acc; -- Return an iir_value_literal_acc (iir_value_int64). diff --git a/src/vhdl/simulate/simulation.adb b/src/vhdl/simulate/simulation.adb index 7238bf9cf..2d2b1007b 100644 --- a/src/vhdl/simulate/simulation.adb +++ b/src/vhdl/simulate/simulation.adb @@ -39,6 +39,8 @@ package body Simulation is case Mode is when Mode_B1 => return Create_B1_Value (Val.B1); + when Mode_E8 => + return Create_E8_Value (Val.E8); when Mode_E32 => return Create_E32_Value (Val.E32); when Mode_I64 => @@ -53,17 +55,17 @@ package body Simulation is procedure Iir_Value_To_Value (Src : Iir_Value_Literal_Acc; Dst : out Value_Union) is begin - case Src.Kind is + case Iir_Value_Scalars (Src.Kind) is when Iir_Value_B1 => Dst.B1 := Src.B1; + when Iir_Value_E8 => + Dst.E8 := Src.E8; when Iir_Value_E32 => Dst.E32 := Src.E32; when Iir_Value_I64 => Dst.I64 := Src.I64; when Iir_Value_F64 => Dst.F64 := Src.F64; - when others => - raise Internal_Error; -- FIXME end case; end Iir_Value_To_Value; @@ -414,6 +416,9 @@ package body Simulation is when Iir_Value_B1 => Ghdl_Signal_Start_Assign_B1 (Target.Sig, Transactions.Reject, El.Value.B1, El.After); + when Iir_Value_E8 => + Ghdl_Signal_Start_Assign_E8 + (Target.Sig, Transactions.Reject, El.Value.E8, El.After); when Iir_Value_E32 => Ghdl_Signal_Start_Assign_E32 (Target.Sig, Transactions.Reject, El.Value.E32, El.After); @@ -434,6 +439,9 @@ package body Simulation is when Iir_Value_B1 => Ghdl_Signal_Next_Assign_B1 (Target.Sig, El.Value.B1, El.After); + when Iir_Value_E8 => + Ghdl_Signal_Next_Assign_E8 + (Target.Sig, El.Value.E8, El.After); when Iir_Value_E32 => Ghdl_Signal_Next_Assign_E32 (Target.Sig, El.Value.E32, El.After); @@ -1191,6 +1199,11 @@ package body Simulation is return Create_Signal_Value (Grt.Signals.Ghdl_Create_Signal_B1 (Val, null, System.Null_Address)); + when Mode_E8 => + Val.E8 := 0; + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_E8 + (Val, null, System.Null_Address)); when Mode_E32 => Val.E32 := 0; return Create_Signal_Value @@ -1201,8 +1214,7 @@ package body Simulation is return Create_Signal_Value (Grt.Signals.Ghdl_Create_Signal_F64 (Val, null, System.Null_Address)); - when Mode_E8 - | Mode_I32 => + when Mode_I32 => raise Internal_Error; end case; when Iir_Value_Array => @@ -1536,6 +1548,10 @@ package body Simulation is Sig.Sig := Grt.Signals.Ghdl_Create_Signal_B1 (To_Ghdl_Value_Ptr (Val.B1'Address), null, System.Null_Address); + when Iir_Value_E8 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E8 + (To_Ghdl_Value_Ptr (Val.E8'Address), + null, System.Null_Address); when Iir_Value_E32 => Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E32 (To_Ghdl_Value_Ptr (Val.E32'Address), |