diff options
Diffstat (limited to 'src/synth/elab-vhdl_values.adb')
| -rw-r--r-- | src/synth/elab-vhdl_values.adb | 100 |
1 files changed, 56 insertions, 44 deletions
diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index 017edc700..c5485c400 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -32,7 +32,8 @@ package body Elab.Vhdl_Values is return True; when Value_Net | Value_Wire - | Value_Signal => + | Value_Signal + | Value_Dyn_Alias => return False; when Value_File => return True; @@ -68,6 +69,25 @@ package body Elab.Vhdl_Values is return (V.Typ, Strip_Alias_Const (V.Val)); end Strip_Alias_Const; + function Get_Memory (V : Value_Acc) return Memory_Ptr is + begin + case V.Kind is + when Value_Const => + return Get_Memory (V.C_Val); + when Value_Alias => + return Get_Memory (V.A_Obj) + V.A_Off.Mem_Off; + when Value_Memory => + return V.Mem; + when others => + raise Internal_Error; + end case; + end Get_Memory; + + function Get_Memory (V : Valtyp) return Memory_Ptr is + begin + return Get_Memory (V.Val); + end Get_Memory; + function Is_Equal (L, R : Valtyp) return Boolean is begin return Is_Equal (Get_Memtyp (L), Get_Memtyp (R)); @@ -102,7 +122,8 @@ package body Elab.Vhdl_Values is (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => S))); end Create_Value_Net; - function Create_Value_Signal (S : Uns32; Init : Value_Acc) return Value_Acc + function Create_Value_Signal (S : Signal_Index_Type; Init : Value_Acc) + return Value_Acc is subtype Value_Type_Signal is Value_Type (Value_Signal); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Signal); @@ -161,31 +182,6 @@ package body Elab.Vhdl_Values is return (Vtype, Create_Value_File (File)); end Create_Value_File; - function Vec_Length (Typ : Type_Acc) return Iir_Index32 is - begin - return Iir_Index32 (Typ.Vbound.Len); - end Vec_Length; - - function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32 is - begin - case Typ.Kind is - when Type_Vector => - return Iir_Index32 (Typ.Vbound.Len); - when Type_Array => - declare - Len : Uns32; - begin - Len := 1; - for I in Typ.Abounds.D'Range loop - Len := Len * Typ.Abounds.D (I).Len; - end loop; - return Iir_Index32 (Len); - end; - when others => - raise Internal_Error; - end case; - end Get_Array_Flat_Length; - function Create_Value_Alias (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp is @@ -202,6 +198,27 @@ package body Elab.Vhdl_Values is return (Typ, Val); end Create_Value_Alias; + function Create_Value_Dyn_Alias (Obj : Value_Acc; + Poff : Uns32; + Ptyp : Type_Acc; + Voff : Uns32; + Eoff : Uns32) return Value_Acc + is + subtype Value_Type_Dyn_Alias is Value_Type (Value_Dyn_Alias); + function Alloc is new Areapools.Alloc_On_Pool_Addr + (Value_Type_Dyn_Alias); + Val : Value_Acc; + begin + Val := To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Dyn_Alias, + D_Obj => Obj, + D_Poff => Poff, + D_Ptyp => Ptyp, + D_Voff => Voff, + D_Eoff => Eoff))); + return Val; + end Create_Value_Dyn_Alias; + function Create_Value_Const (Val : Value_Acc; Loc : Node) return Value_Acc is subtype Value_Type_Const is Value_Type (Value_Const); @@ -255,7 +272,8 @@ package body Elab.Vhdl_Values is raise Internal_Error; when Value_Const => raise Internal_Error; - when Value_Alias => + when Value_Alias + | Value_Dyn_Alias => raise Internal_Error; end case; return Res; @@ -395,12 +413,13 @@ package body Elab.Vhdl_Values is Write_Discrete (M, Typ, Typ.Drange.Left); when Type_Float => Write_Fp64 (M, Typ.Frange.Left); - when Type_Vector => + when Type_Array + | Type_Vector => declare - Len : constant Iir_Index32 := Vec_Length (Typ); - El_Typ : constant Type_Acc := Typ.Vec_El; + Len : constant Uns32 := Get_Bound_Length (Typ); + El_Typ : constant Type_Acc := Typ.Arr_El; begin - for I in 1 .. Len loop + for I in 1 .. Iir_Index32 (Len) loop Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ); end loop; end; @@ -410,18 +429,10 @@ package body Elab.Vhdl_Values is raise Internal_Error; when Type_Slice => raise Internal_Error; - when Type_Array => - declare - Len : constant Iir_Index32 := Get_Array_Flat_Length (Typ); - El_Typ : constant Type_Acc := Typ.Arr_El; - begin - for I in 1 .. Len loop - Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ); - end loop; - end; when Type_Record => for I in Typ.Rec.E'Range loop - Write_Value_Default (M + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ); + Write_Value_Default (M + Typ.Rec.E (I).Offs.Mem_Off, + Typ.Rec.E (I).Typ); end loop; when Type_Access => Write_Access (M, Null_Heap_Index); @@ -452,7 +463,7 @@ package body Elab.Vhdl_Values is function Value_To_String (Val : Valtyp) return String is - Str : String (1 .. Natural (Val.Typ.Abounds.D (1).Len)); + Str : String (1 .. Natural (Val.Typ.Abound.Len)); begin for I in Str'Range loop Str (Natural (I)) := Character'Val @@ -466,7 +477,8 @@ package body Elab.Vhdl_Values is case V.Val.Kind is when Value_Net | Value_Wire - | Value_Signal => + | Value_Signal + | Value_Dyn_Alias => raise Internal_Error; when Value_Memory => return (V.Typ, V.Val.Mem); |