diff options
| author | Tristan Gingold <tgingold@free.fr> | 2015-01-17 15:51:53 +0100 | 
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2015-01-17 15:51:53 +0100 | 
| commit | 0dcbdbd0f005e72b8aa9bddfe1eda45dcbad789c (patch) | |
| tree | c8653c201fde4648065672041ec4f1cc90009cba /src | |
| parent | e8f6e48e092ce96cbd643a0ff94c4dafe245b9dd (diff) | |
| download | ghdl-0dcbdbd0f005e72b8aa9bddfe1eda45dcbad789c.tar.gz ghdl-0dcbdbd0f005e72b8aa9bddfe1eda45dcbad789c.tar.bz2 ghdl-0dcbdbd0f005e72b8aa9bddfe1eda45dcbad789c.zip | |
simulation: handle v87 concatenation.
Diffstat (limited to 'src')
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 115 | 
1 files changed, 74 insertions, 41 deletions
| diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 995cb170b..464fc132c 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -20,6 +20,7 @@ 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; @@ -94,6 +95,42 @@ package body Execution is                                            Get_Info (Decl).Scope_Level);     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) @@ -124,34 +161,7 @@ package body Execution is                 raise Internal_Error;           end case;        else -         case Res.Left.Kind is -            when Iir_Value_E32 => -               declare -                  R : Ghdl_E32; -               begin -                  case Index_Bounds.Dir is -                     when Iir_To => -                        R := Res.Left.E32 + Ghdl_E32 (Len - 1); -                     when Iir_Downto => -                        R := Res.Left.E32 - Ghdl_E32 (Len - 1); -                  end case; -                  Res.Right := Create_E32_Value (R); -               end; -            when Iir_Value_I64 => -               declare -                  R : Ghdl_I64; -               begin -                  case Index_Bounds.Dir is -                     when Iir_To => -                        R := Res.Left.I64 + Ghdl_I64 (Len - 1); -                     when Iir_Downto => -                        R := Res.Left.I64 - Ghdl_I64 (Len - 1); -                  end case; -                  Res.Right := Create_I64_Value (R); -               end; -            when others => -               raise Internal_Error; -         end case; +         Create_Right_Bound_From_Length (Res, Len);        end if;        return Res;     end Create_Bounds_From_Length; @@ -521,20 +531,43 @@ package body Execution is                       raise Program_Error;                 end case; -               -- LRM93 7.2.4 -               -- If both operands are null arrays, then the result of the -               -- concatenation is the right operand. -               if Len = 0 then -                  --  Note: this return is allowed since LEFT is free, and -                  --  RIGHT must not be free. -                  return Right; -               end if; +               if Flags.Vhdl_Std = Vhdl_87 then +                  --  LRM87 7.2.3 Adding Operators +                  --  The left bound if this result is the left bound of the +                  --  left operand, unless the left operand is a null array, +                  --  in which case of result of the concatenation is the +                  --  right 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. +                  if (Func = Iir_Predefined_Array_Array_Concat +                        or Func = Iir_Predefined_Array_Element_Concat) +                    and then Left.Val_Array.Len = 0 +                  then +                     return Right; +                  end if; -               -- 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); +                  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 +                  -- LRM93 7.2.4 +                  -- If both operands are null arrays, then the result of the +                  -- concatenation is the right operand. +                  if Len = 0 then +                     --  Note: this return is allowed since LEFT is free, and +                     --  RIGHT must not be free. +                     return Right; +                  end if; + +                  --  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 | 
