diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-04-08 07:50:09 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-04-09 21:24:36 +0200 |
commit | 0d8c0721babf663e88c7ca8172173991c115406f (patch) | |
tree | e58b74e1b4ebe577fd86d0b6d69c803f73ceb44b /src | |
parent | 644d4ecd655d1f9892d0db709bde07015ef3424a (diff) | |
download | ghdl-0d8c0721babf663e88c7ca8172173991c115406f.tar.gz ghdl-0d8c0721babf663e88c7ca8172173991c115406f.tar.bz2 ghdl-0d8c0721babf663e88c7ca8172173991c115406f.zip |
synth: extract synth.objtypes from synth.values.
Diffstat (limited to 'src')
-rw-r--r-- | src/synth/synth-aggr.ads | 1 | ||||
-rw-r--r-- | src/synth/synth-context.ads | 1 | ||||
-rw-r--r-- | src/synth/synth-decls.adb | 1 | ||||
-rw-r--r-- | src/synth/synth-decls.ads | 2 | ||||
-rw-r--r-- | src/synth/synth-disp_vhdl.adb | 2 | ||||
-rw-r--r-- | src/synth/synth-expr.ads | 1 | ||||
-rw-r--r-- | src/synth/synth-files_operations.adb | 1 | ||||
-rw-r--r-- | src/synth/synth-heap.ads | 1 | ||||
-rw-r--r-- | src/synth/synth-insts.adb | 1 | ||||
-rw-r--r-- | src/synth/synth-objtypes.adb | 572 | ||||
-rw-r--r-- | src/synth/synth-objtypes.ads | 243 | ||||
-rw-r--r-- | src/synth/synth-oper.ads | 1 | ||||
-rw-r--r-- | src/synth/synth-static_oper.adb | 1 | ||||
-rw-r--r-- | src/synth/synth-stmts.ads | 1 | ||||
-rw-r--r-- | src/synth/synth-values-debug.adb | 1 | ||||
-rw-r--r-- | src/synth/synth-values.adb | 525 | ||||
-rw-r--r-- | src/synth/synth-values.ads | 217 | ||||
-rw-r--r-- | src/synth/synthesis.adb | 4 |
18 files changed, 833 insertions, 743 deletions
diff --git a/src/synth/synth-aggr.ads b/src/synth/synth-aggr.ads index 5dd7e4bd7..4b5cf6418 100644 --- a/src/synth/synth-aggr.ads +++ b/src/synth/synth-aggr.ads @@ -18,6 +18,7 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; with Vhdl.Nodes; use Vhdl.Nodes; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index 84316b5ef..2f1ff9698 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -25,6 +25,7 @@ with Vhdl.Annotations; use Vhdl.Annotations; with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Environment; use Synth.Environment; +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; package Synth.Context is diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 552fab7f7..89d3b3ad8 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -38,6 +38,7 @@ with Synth.Stmts; with Synth.Source; use Synth.Source; with Synth.Errors; use Synth.Errors; with Synth.Files_Operations; +with Synth.Values; use Synth.Values; package body Synth.Decls is procedure Synth_Anonymous_Subtype_Indication diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index 5faa1bfa3..68b7fea08 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -21,7 +21,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Context; use Synth.Context; -with Synth.Values; use Synth.Values; +with Synth.Objtypes; use Synth.Objtypes; package Synth.Decls is -- Get the type of DECL iff it is standalone (not an already existing diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index 375f72e85..6736343ff 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -32,7 +32,7 @@ with Vhdl.Utils; use Vhdl.Utils; with Netlists.Iterators; use Netlists.Iterators; with Netlists.Disp_Vhdl; use Netlists.Disp_Vhdl; -with Synth.Values; use Synth.Values; +with Synth.Objtypes; use Synth.Objtypes; package body Synth.Disp_Vhdl is procedure Disp_Signal (Desc : Port_Desc) is diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 3c47bebfa..42ac1d56c 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -25,6 +25,7 @@ with Types; use Types; with Netlists; use Netlists; with Synth.Source; +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; with Vhdl.Nodes; use Vhdl.Nodes; diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index 525adec54..324c7caa8 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -25,6 +25,7 @@ with Grt.Files_Operations; use Grt.Files_Operations; with Vhdl.Annotations; +with Synth.Objtypes; use Synth.Objtypes; with Synth.Expr; use Synth.Expr; with Synth.Errors; use Synth.Errors; diff --git a/src/synth/synth-heap.ads b/src/synth/synth-heap.ads index 204ff3846..2283b3002 100644 --- a/src/synth/synth-heap.ads +++ b/src/synth/synth-heap.ads @@ -18,6 +18,7 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; package Synth.Heap is diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index da5b23b04..e271195dc 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -44,6 +44,7 @@ with Vhdl.Errors; with Vhdl.Ieee.Math_Real; with Vhdl.Std_Package; +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; with Synth.Stmts; use Synth.Stmts; diff --git a/src/synth/synth-objtypes.adb b/src/synth/synth-objtypes.adb new file mode 100644 index 000000000..6292db4db --- /dev/null +++ b/src/synth/synth-objtypes.adb @@ -0,0 +1,572 @@ +-- Values in synthesis. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program 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 of the License, or +-- (at your option) any later version. +-- +-- This program 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 this program; if not, write to the Free Software +-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, +-- MA 02110-1301, USA. + +with Ada.Unchecked_Conversion; +with System; + +with Mutils; use Mutils; + +package body Synth.Objtypes is + function To_Bound_Array_Acc is new Ada.Unchecked_Conversion + (System.Address, Bound_Array_Acc); + + function To_Rec_El_Array_Acc is new Ada.Unchecked_Conversion + (System.Address, Rec_El_Array_Acc); + + function To_Type_Acc is new Ada.Unchecked_Conversion + (System.Address, Type_Acc); + + function "+" (L, R : Value_Offsets) return Value_Offsets is + begin + return (L.Net_Off + R.Net_Off, L.Mem_Off + R.Mem_Off); + end "+"; + + function Is_Bounded_Type (Typ : Type_Acc) return Boolean is + begin + case Typ.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float + | Type_Vector + | Type_Slice + | Type_Array + | Type_Record + | Type_Access + | Type_File => + return True; + when Type_Unbounded_Array + | Type_Unbounded_Vector => + return False; + end case; + end Is_Bounded_Type; + + function Are_Types_Equal (L, R : Type_Acc) return Boolean is + begin + if L.Kind /= R.Kind + or else L.W /= R.W + then + return False; + end if; + if L = R then + return True; + end if; + + case L.Kind is + when Type_Bit + | Type_Logic => + return True; + when Type_Discrete => + return L.Drange = R.Drange; + when Type_Float => + return L.Frange = R.Frange; + when Type_Vector => + return L.Vbound = R.Vbound + and then Are_Types_Equal (L.Vec_El, R.Vec_El); + when Type_Unbounded_Vector => + return Are_Types_Equal (L.Uvec_El, R.Uvec_El); + when Type_Slice => + return Are_Types_Equal (L.Slice_El, R.Slice_El); + when Type_Array => + if L.Abounds.Ndim /= R.Abounds.Ndim then + return False; + end if; + for I in L.Abounds.D'Range loop + if L.Abounds.D (I) /= R.Abounds.D (I) then + return False; + end if; + end loop; + return Are_Types_Equal (L.Arr_El, R.Arr_El); + when Type_Unbounded_Array => + return L.Uarr_Ndim = R.Uarr_Ndim + and then Are_Types_Equal (L.Uarr_El, R.Uarr_El); + when Type_Record => + if L.Rec.Len /= R.Rec.Len then + return False; + end if; + for I in L.Rec.E'Range loop + if not Are_Types_Equal (L.Rec.E (I).Typ, R.Rec.E (I).Typ) then + return False; + end if; + end loop; + return True; + when Type_Access => + return Are_Types_Equal (L.Acc_Acc, R.Acc_Acc); + when Type_File => + return Are_Types_Equal (L.File_Typ, R.File_Typ); + end case; + end Are_Types_Equal; + + function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width + is + Lo, Hi : Int64; + W : Width; + begin + case Rng.Dir is + when Iir_To => + Lo := Rng.Left; + Hi := Rng.Right; + when Iir_Downto => + Lo := Rng.Right; + Hi := Rng.Left; + end case; + if Lo > Hi then + -- Null range. + W := 0; + elsif Lo >= 0 then + -- Positive. + W := Width (Clog2 (Uns64 (Hi) + 1)); + elsif Lo = Int64'First then + -- Handle possible overflow. + W := 64; + elsif Hi < 0 then + -- Negative only. + W := Width (Clog2 (Uns64 (-Lo))) + 1; + else + declare + Wl : constant Width := Width (Clog2 (Uns64 (-Lo))); + Wh : constant Width := Width (Clog2 (Uns64 (Hi))); + begin + W := Width'Max (Wl, Wh) + 1; + end; + end if; + return W; + end Discrete_Range_Width; + + function Create_Bit_Type return Type_Acc + is + subtype Bit_Type_Type is Type_Type (Type_Bit); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Bit_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit, + Is_Synth => True, + Al => 0, + Sz => 1, + W => 1))); + end Create_Bit_Type; + + function Create_Logic_Type return Type_Acc + is + subtype Logic_Type_Type is Type_Type (Type_Logic); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Logic_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Logic, + Is_Synth => True, + Al => 0, + Sz => 1, + W => 1))); + end Create_Logic_Type; + + function Create_Discrete_Type (Rng : Discrete_Range_Type; + Sz : Size_Type; + W : Width) + return Type_Acc + is + subtype Discrete_Type_Type is Type_Type (Type_Discrete); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Discrete_Type_Type); + Al : Palign_Type; + begin + if Sz <= 1 then + Al := 0; + elsif Sz <= 4 then + Al := 2; + else + pragma Assert (Sz <= 8); + Al := 3; + end if; + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete, + Is_Synth => True, + Al => Al, + Sz => Sz, + W => W, + Drange => Rng))); + end Create_Discrete_Type; + + function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc + is + subtype Float_Type_Type is Type_Type (Type_Float); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Float_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float, + Is_Synth => True, + Al => 3, + Sz => 8, + W => 64, + Frange => Rng))); + end Create_Float_Type; + + function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) + return Type_Acc + is + subtype Vector_Type_Type is Type_Type (Type_Vector); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type); + begin + return To_Type_Acc + (Alloc (Current_Pool, (Kind => Type_Vector, + Is_Synth => True, + Al => El_Type.Al, + Sz => El_Type.Sz * Size_Type (Bnd.Len), + W => Bnd.Len, + Vbound => Bnd, + Vec_El => El_Type))); + end Create_Vector_Type; + + function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) + return Type_Acc + is + subtype Slice_Type_Type is Type_Type (Type_Slice); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Slice_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, + (Kind => Type_Slice, + Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => Size_Type (Len) * El_Type.Sz, + W => Len * El_Type.W, + Slice_El => El_Type))); + end Create_Slice_Type; + + function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) + return Type_Acc is + begin + return Create_Vector_Type ((Dir => Iir_Downto, + Left => Int32 (Len) - 1, + Right => 0, + Len => Len), + El); + end Create_Vec_Type_By_Length; + + function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc + is + use System; + subtype Data_Type is Bound_Array (Ndims); + Res : Address; + begin + -- Manually allocate the array to handle large arrays without + -- creating a large temporary value. + Areapools.Allocate + (Current_Pool.all, Res, + Data_Type'Size / Storage_Unit, Data_Type'Alignment); + + declare + -- Discard the warnings for no pragma Import as we really want + -- to use the default initialization. + pragma Warnings (Off); + Addr1 : constant Address := Res; + Init : Data_Type; + for Init'Address use Addr1; + pragma Warnings (On); + begin + null; + end; + + return To_Bound_Array_Acc (Res); + end Create_Bound_Array; + + function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) + return Type_Acc + is + subtype Array_Type_Type is Type_Type (Type_Array); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type); + L : Uns32; + begin + L := 1; + for I in Bnd.D'Range loop + L := L * Bnd.D (I).Len; + end loop; + return To_Type_Acc (Alloc (Current_Pool, + (Kind => Type_Array, + Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => El_Type.Sz * Size_Type (L), + W => El_Type.W * L, + Abounds => Bnd, + Arr_El => El_Type))); + end Create_Array_Type; + + function Create_Unbounded_Array (Ndim : Dim_Type; El_Type : Type_Acc) + return Type_Acc + is + subtype Unbounded_Type_Type is Type_Type (Type_Unbounded_Array); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array, + Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => 0, + W => 0, + Uarr_Ndim => Ndim, + Uarr_El => El_Type))); + end Create_Unbounded_Array; + + function Create_Unbounded_Vector (El_Type : Type_Acc) return Type_Acc + is + subtype Unbounded_Type_Type is Type_Type (Type_Unbounded_Vector); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Vector, + Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => 0, + W => 0, + Uvec_El => El_Type))); + end Create_Unbounded_Vector; + + function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc is + begin + case Arr_Type.Kind is + when Type_Vector => + return Arr_Type.Vec_El; + when Type_Array => + return Arr_Type.Arr_El; + when Type_Unbounded_Array => + return Arr_Type.Uarr_El; + when Type_Unbounded_Vector => + return Arr_Type.Uvec_El; + when others => + raise Internal_Error; + end case; + end Get_Array_Element; + + function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type) + return Bound_Type is + begin + case Typ.Kind is + when Type_Vector => + if Dim /= 1 then + raise Internal_Error; + end if; + return Typ.Vbound; + when Type_Array => + return Typ.Abounds.D (Dim); + when others => + raise Internal_Error; + end case; + end Get_Array_Bound; + + function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32 + is + Len : Int64; + begin + case Rng.Dir is + when Iir_To => + Len := Rng.Right - Rng.Left + 1; + when Iir_Downto => + Len := Rng.Left - Rng.Right + 1; + end case; + if Len < 0 then + return 0; + else + return Uns32 (Len); + end if; + end Get_Range_Length; + + function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc + is + use System; + subtype Data_Type is Rec_El_Array (Nels); + Res : Address; + begin + -- Manually allocate the array to handle large arrays without + -- creating a large temporary value. + Areapools.Allocate + (Current_Pool.all, Res, + Data_Type'Size / Storage_Unit, Data_Type'Alignment); + + declare + -- Discard the warnings for no pragma Import as we really want + -- to use the default initialization. + pragma Warnings (Off); + Addr1 : constant Address := Res; + Init : Data_Type; + for Init'Address use Addr1; + pragma Warnings (On); + begin + null; + end; + + return To_Rec_El_Array_Acc (Res); + end Create_Rec_El_Array; + + function Align (Off : Size_Type; Al : Palign_Type) return Size_Type + is + Mask : constant Size_Type := 2 ** Natural (Al) - 1; + begin + return (Off + Mask) and not Mask; + end Align; + + function Create_Record_Type (Els : Rec_El_Array_Acc) + return Type_Acc + is + subtype Record_Type_Type is Type_Type (Type_Record); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type); + Is_Synth : Boolean; + W : Width; + Al : Palign_Type; + Sz : Size_Type; + begin + -- Layout the record. + Is_Synth := True; + Al := 0; + Sz := 0; + W := 0; + for I in Els.E'Range loop + declare + E : Rec_El_Type renames Els.E (I); + begin + -- For nets. + E.Boff := W; + Is_Synth := Is_Synth and E.Typ.Is_Synth; + W := W + E.Typ.W; + + -- For memory. + Al := Palign_Type'Max (Al, E.Typ.Al); + Sz := Align (Sz, E.Typ.Al); + E.Moff := Sz; + Sz := Sz + E.Typ.Sz; + end; + end loop; + Sz := Align (Sz, Al); + + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record, + Is_Synth => Is_Synth, + Al => Al, + Sz => Sz, + W => W, + Rec => Els))); + end Create_Record_Type; + + function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc + is + subtype Access_Type_Type is Type_Type (Type_Access); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Access_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access, + Is_Synth => False, + Al => 2, + Sz => 4, + W => 32, + Acc_Acc => Acc_Type))); + end Create_Access_Type; + + function Create_File_Type (File_Type : Type_Acc) return Type_Acc + is + subtype File_Type_Type is Type_Type (Type_File); + function Alloc is new Areapools.Alloc_On_Pool_Addr (File_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_File, + Is_Synth => False, + Al => 2, + Sz => 4, + W => 32, + File_Typ => File_Type))); + end Create_File_Type; + + 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 : Width; + 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 Get_Type_Width (Atype : Type_Acc) return Width is + begin + pragma Assert (Atype.Kind /= Type_Unbounded_Array); + return Atype.W; + end Get_Type_Width; + + function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width is + begin + case T.Kind is + when Type_Vector => + if Dim /= 1 then + raise Internal_Error; + end if; + return T.Vbound.Len; + when Type_Slice => + if Dim /= 1 then + raise Internal_Error; + end if; + return T.W; + when Type_Array => + return T.Abounds.D (Dim).Len; + when others => + raise Internal_Error; + end case; + end Get_Bound_Length; + + function Is_Matching_Bounds (L, R : Type_Acc) return Boolean is + begin + case L.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + pragma Assert (L.Kind = R.Kind); + return True; + when Type_Vector + | Type_Slice => + return Get_Bound_Length (L, 1) = Get_Bound_Length (R, 1); + when Type_Array => + for I in L.Abounds.D'Range loop + if Get_Bound_Length (L, I) /= Get_Bound_Length (R, I) then + return False; + end if; + end loop; + return True; + when Type_Unbounded_Array + | Type_Unbounded_Vector => + raise Internal_Error; + when Type_Record => + -- FIXME: handle vhdl-08 + return True; + when Type_Access => + return True; + when Type_File => + raise Internal_Error; + end case; + end Is_Matching_Bounds; + + procedure Init is + begin + Instance_Pool := Global_Pool'Access; + Boolean_Type := Create_Bit_Type; + Logic_Type := Create_Logic_Type; + Bit_Type := Create_Bit_Type; + end Init; +end Synth.Objtypes; diff --git a/src/synth/synth-objtypes.ads b/src/synth/synth-objtypes.ads new file mode 100644 index 000000000..a01183c03 --- /dev/null +++ b/src/synth/synth-objtypes.ads @@ -0,0 +1,243 @@ +-- Values in synthesis. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program 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 of the License, or +-- (at your option) any later version. +-- +-- This program 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 this program; if not, write to the Free Software +-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, +-- MA 02110-1301, USA. + +with Types; use Types; +with Areapools; use Areapools; + +with Netlists; use Netlists; + +with Vhdl.Nodes; use Vhdl.Nodes; + +package Synth.Objtypes is + type Discrete_Range_Type is record + -- An integer range. + Dir : Iir_Direction; + + -- Netlist representation: signed or unsigned, width of vector. + Is_Signed : Boolean; + + Left : Int64; + Right : Int64; + end record; + + -- Return the width of RNG. + function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width; + + type Float_Range_Type is record + Dir : Iir_Direction; + Left : Fp64; + Right : Fp64; + end record; + + type Bound_Type is record + Dir : Iir_Direction; + Left : Int32; + Right : Int32; + Len : Width; + end record; + + type Bound_Array_Type is array (Dim_Type range <>) of Bound_Type; + + type Bound_Array (Ndim : Dim_Type) is record + D : Bound_Array_Type (1 .. Ndim); + end record; + + type Bound_Array_Acc is access Bound_Array; + + type Type_Kind is + ( + Type_Bit, + Type_Logic, + Type_Discrete, + Type_Float, + Type_Vector, + Type_Unbounded_Vector, + + -- A slice is for a slice of vector with dynamic bounds. So the bounds + -- of the result aren't known, but its width is. + Type_Slice, + Type_Array, + Type_Unbounded_Array, + Type_Record, + + Type_Access, + Type_File + ); + + subtype Type_Nets is Type_Kind range Type_Bit .. Type_Logic; + + type Type_Type (Kind : Type_Kind); + type Type_Acc is access Type_Type; + + type Rec_El_Type is record + -- Bit offset: offset of the element in a net. + Boff : Uns32; + + -- Memory offset: offset of the element in memory. + Moff : Size_Type; + + -- Type of the element. + Typ : Type_Acc; + end record; + + type Rec_El_Array_Type is array (Iir_Index32 range <>) of Rec_El_Type; + type Rec_El_Array (Len : Iir_Index32) is record + E : Rec_El_Array_Type (1 .. Len); + end record; + + type Rec_El_Array_Acc is access Rec_El_Array; + + -- Power of 2 alignment. + type Palign_Type is range 0 .. 3; + + type Type_Type (Kind : Type_Kind) is record + -- False if the type is not synthesisable: is or contains access/file. + Is_Synth : Boolean; + + -- Alignment (in bytes) for this type. + Al : Palign_Type; + + -- Number of bytes (when in memory) for this type. + Sz : Size_Type; + + -- Number of bits (when in a net) for this type. + W : Width; + + case Kind is + when Type_Bit + | Type_Logic => + null; + when Type_Discrete => + Drange : Discrete_Range_Type; + when Type_Float => + Frange : Float_Range_Type; + when Type_Vector => + Vbound : Bound_Type; + Vec_El : Type_Acc; + when Type_Unbounded_Vector => + Uvec_El : Type_Acc; + when Type_Slice => + Slice_El : Type_Acc; + when Type_Array => + Abounds : Bound_Array_Acc; + Arr_El : Type_Acc; + when Type_Unbounded_Array => + Uarr_Ndim : Dim_Type; + Uarr_El : Type_Acc; + when Type_Record => + Rec : Rec_El_Array_Acc; + when Type_Access => + Acc_Acc : Type_Acc; + when Type_File => + File_Typ : Type_Acc; + end case; + end record; + + type Memory_Element is mod 2**8; + type Memory_Array is array (Size_Type range <>) of Memory_Element; + + -- Flat pointer for a generic pointer. + type Memory_Ptr is access all Memory_Array (Size_Type); + + type Memtyp is record + Typ : Type_Acc; + Mem : Memory_Ptr; + end record; + + -- Offsets for a value. + type Value_Offsets is record + Net_Off : Uns32; + Mem_Off : Size_Type; + end record; + + function "+" (L, R : Value_Offsets) return Value_Offsets; + + Global_Pool : aliased Areapool; + Expr_Pool : aliased Areapool; + + -- Areapool used by Create_*_Value + Current_Pool : Areapool_Acc := Expr_Pool'Access; + + -- Pool for objects allocated in the current instance. + Instance_Pool : Areapool_Acc; + + -- Types. + function Create_Discrete_Type (Rng : Discrete_Range_Type; + Sz : Size_Type; + W : Width) + return Type_Acc; + + function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc; + function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) + return Type_Acc; + function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) + return Type_Acc; + function Create_Unbounded_Vector (El_Type : Type_Acc) return Type_Acc; + function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) + return Type_Acc; + function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc; + function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) + return Type_Acc; + function Create_Unbounded_Array (Ndim : Dim_Type; El_Type : Type_Acc) + return Type_Acc; + function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc; + + function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc; + + function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc; + + function Create_File_Type (File_Type : Type_Acc) return Type_Acc; + + -- Return the bounds of dimension DIM of a vector/array. For a vector, + -- DIM must be 1. + function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type) + return Bound_Type; + + -- Return the length of RNG. + function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32; + + -- Return the element of a vector/array/unbounded_array. + function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc; + + function Is_Bounded_Type (Typ : Type_Acc) return Boolean; + + function Are_Types_Equal (L, R : Type_Acc) return Boolean; + + -- Return the length of a vector type. + function Vec_Length (Typ : Type_Acc) return Iir_Index32; + + -- Get the number of indexes in array type TYP without counting + -- sub-elements. + function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32; + + -- Return length of dimension DIM of type T. + function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width; + + function Is_Matching_Bounds (L, R : Type_Acc) return Boolean; + + function Get_Type_Width (Atype : Type_Acc) return Width; + + procedure Init; + + -- Set by Init. + Boolean_Type : Type_Acc := null; + Logic_Type : Type_Acc := null; + Bit_Type : Type_Acc := null; +end Synth.Objtypes; diff --git a/src/synth/synth-oper.ads b/src/synth/synth-oper.ads index eba256c93..297c698e3 100644 --- a/src/synth/synth-oper.ads +++ b/src/synth/synth-oper.ads @@ -18,6 +18,7 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; with Vhdl.Nodes; use Vhdl.Nodes; diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index 4712dd844..eeb24ed64 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -31,6 +31,7 @@ with Netlists.Utils; use Netlists.Utils; with Synth.Errors; use Synth.Errors; with Synth.Source; use Synth.Source; +with Synth.Objtypes; use Synth.Objtypes; with Synth.Environment; with Synth.Expr; use Synth.Expr; with Synth.Oper; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index dbe0d03b1..349b52991 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -23,6 +23,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Netlists; use Netlists; +with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; with Synth.Environment; use Synth.Environment; diff --git a/src/synth/synth-values-debug.adb b/src/synth/synth-values-debug.adb index e2d3bac45..dfea20a98 100644 --- a/src/synth/synth-values-debug.adb +++ b/src/synth/synth-values-debug.adb @@ -20,6 +20,7 @@ with Simple_IO; use Simple_IO; with Utils_IO; use Utils_IO; +with Vhdl.Nodes; use Vhdl.Nodes; package body Synth.Values.Debug is procedure Debug_Bound (Bnd : Bound_Type) is diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index e0d56174b..47a354078 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -22,28 +22,14 @@ with Ada.Unchecked_Conversion; with System; with System.Storage_Elements; -with Mutils; use Mutils; - with Netlists.Utils; -package body Synth.Values is - function To_Bound_Array_Acc is new Ada.Unchecked_Conversion - (System.Address, Bound_Array_Acc); - - function To_Rec_El_Array_Acc is new Ada.Unchecked_Conversion - (System.Address, Rec_El_Array_Acc); - - function To_Type_Acc is new Ada.Unchecked_Conversion - (System.Address, Type_Acc); +with Vhdl.Nodes; use Vhdl.Nodes; +package body Synth.Values is function To_Value_Acc is new Ada.Unchecked_Conversion (System.Address, Value_Acc); - function "+" (L, R : Value_Offsets) return Value_Offsets is - begin - return (L.Net_Off + R.Net_Off, L.Mem_Off + R.Mem_Off); - end "+"; - function Is_Static (Val : Value_Acc) return Boolean is begin case Val.Kind is @@ -79,26 +65,6 @@ package body Synth.Values is end case; end Is_Static_Val; - function Is_Bounded_Type (Typ : Type_Acc) return Boolean is - begin - case Typ.Kind is - when Type_Bit - | Type_Logic - | Type_Discrete - | Type_Float - | Type_Vector - | Type_Slice - | Type_Array - | Type_Record - | Type_Access - | Type_File => - return True; - when Type_Unbounded_Array - | Type_Unbounded_Vector => - return False; - end case; - end Is_Bounded_Type; - function Strip_Alias_Const (V : Value_Acc) return Value_Acc is Res : Value_Acc; @@ -157,427 +123,6 @@ package body Synth.Values is end case; end Is_Equal; - function Are_Types_Equal (L, R : Type_Acc) return Boolean is - begin - if L.Kind /= R.Kind - or else L.W /= R.W - then - return False; - end if; - if L = R then - return True; - end if; - - case L.Kind is - when Type_Bit - | Type_Logic => - return True; - when Type_Discrete => - return L.Drange = R.Drange; - when Type_Float => - return L.Frange = R.Frange; - when Type_Vector => - return L.Vbound = R.Vbound - and then Are_Types_Equal (L.Vec_El, R.Vec_El); - when Type_Unbounded_Vector => - return Are_Types_Equal (L.Uvec_El, R.Uvec_El); - when Type_Slice => - return Are_Types_Equal (L.Slice_El, R.Slice_El); - when Type_Array => - if L.Abounds.Ndim /= R.Abounds.Ndim then - return False; - end if; - for I in L.Abounds.D'Range loop - if L.Abounds.D (I) /= R.Abounds.D (I) then - return False; - end if; - end loop; - return Are_Types_Equal (L.Arr_El, R.Arr_El); - when Type_Unbounded_Array => - return L.Uarr_Ndim = R.Uarr_Ndim - and then Are_Types_Equal (L.Uarr_El, R.Uarr_El); - when Type_Record => - if L.Rec.Len /= R.Rec.Len then - return False; - end if; - for I in L.Rec.E'Range loop - if not Are_Types_Equal (L.Rec.E (I).Typ, R.Rec.E (I).Typ) then - return False; - end if; - end loop; - return True; - when Type_Access => - return Are_Types_Equal (L.Acc_Acc, R.Acc_Acc); - when Type_File => - return Are_Types_Equal (L.File_Typ, R.File_Typ); - end case; - end Are_Types_Equal; - - function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width - is - Lo, Hi : Int64; - W : Width; - begin - case Rng.Dir is - when Iir_To => - Lo := Rng.Left; - Hi := Rng.Right; - when Iir_Downto => - Lo := Rng.Right; - Hi := Rng.Left; - end case; - if Lo > Hi then - -- Null range. - W := 0; - elsif Lo >= 0 then - -- Positive. - W := Width (Clog2 (Uns64 (Hi) + 1)); - elsif Lo = Int64'First then - -- Handle possible overflow. - W := 64; - elsif Hi < 0 then - -- Negative only. - W := Width (Clog2 (Uns64 (-Lo))) + 1; - else - declare - Wl : constant Width := Width (Clog2 (Uns64 (-Lo))); - Wh : constant Width := Width (Clog2 (Uns64 (Hi))); - begin - W := Width'Max (Wl, Wh) + 1; - end; - end if; - return W; - end Discrete_Range_Width; - - function Create_Bit_Type return Type_Acc - is - subtype Bit_Type_Type is Type_Type (Type_Bit); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Bit_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit, - Is_Synth => True, - Al => 0, - Sz => 1, - W => 1))); - end Create_Bit_Type; - - function Create_Logic_Type return Type_Acc - is - subtype Logic_Type_Type is Type_Type (Type_Logic); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Logic_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Logic, - Is_Synth => True, - Al => 0, - Sz => 1, - W => 1))); - end Create_Logic_Type; - - function Create_Discrete_Type (Rng : Discrete_Range_Type; - Sz : Size_Type; - W : Width) - return Type_Acc - is - subtype Discrete_Type_Type is Type_Type (Type_Discrete); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Discrete_Type_Type); - Al : Palign_Type; - begin - if Sz <= 1 then - Al := 0; - elsif Sz <= 4 then - Al := 2; - else - pragma Assert (Sz <= 8); - Al := 3; - end if; - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete, - Is_Synth => True, - Al => Al, - Sz => Sz, - W => W, - Drange => Rng))); - end Create_Discrete_Type; - - function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc - is - subtype Float_Type_Type is Type_Type (Type_Float); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Float_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float, - Is_Synth => True, - Al => 3, - Sz => 8, - W => 64, - Frange => Rng))); - end Create_Float_Type; - - function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) - return Type_Acc - is - subtype Vector_Type_Type is Type_Type (Type_Vector); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type); - begin - return To_Type_Acc - (Alloc (Current_Pool, (Kind => Type_Vector, - Is_Synth => True, - Al => El_Type.Al, - Sz => El_Type.Sz * Size_Type (Bnd.Len), - W => Bnd.Len, - Vbound => Bnd, - Vec_El => El_Type))); - end Create_Vector_Type; - - function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) - return Type_Acc - is - subtype Slice_Type_Type is Type_Type (Type_Slice); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Slice_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, - (Kind => Type_Slice, - Is_Synth => El_Type.Is_Synth, - Al => El_Type.Al, - Sz => Size_Type (Len) * El_Type.Sz, - W => Len * El_Type.W, - Slice_El => El_Type))); - end Create_Slice_Type; - - function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) - return Type_Acc is - begin - return Create_Vector_Type ((Dir => Iir_Downto, - Left => Int32 (Len) - 1, - Right => 0, - Len => Len), - El); - end Create_Vec_Type_By_Length; - - function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc - is - use System; - subtype Data_Type is Bound_Array (Ndims); - Res : Address; - begin - -- Manually allocate the array to handle large arrays without - -- creating a large temporary value. - Areapools.Allocate - (Current_Pool.all, Res, - Data_Type'Size / Storage_Unit, Data_Type'Alignment); - - declare - -- Discard the warnings for no pragma Import as we really want - -- to use the default initialization. - pragma Warnings (Off); - Addr1 : constant Address := Res; - Init : Data_Type; - for Init'Address use Addr1; - pragma Warnings (On); - begin - null; - end; - - return To_Bound_Array_Acc (Res); - end Create_Bound_Array; - - function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) - return Type_Acc - is - subtype Array_Type_Type is Type_Type (Type_Array); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type); - L : Uns32; - begin - L := 1; - for I in Bnd.D'Range loop - L := L * Bnd.D (I).Len; - end loop; - return To_Type_Acc (Alloc (Current_Pool, - (Kind => Type_Array, - Is_Synth => El_Type.Is_Synth, - Al => El_Type.Al, - Sz => El_Type.Sz * Size_Type (L), - W => El_Type.W * L, - Abounds => Bnd, - Arr_El => El_Type))); - end Create_Array_Type; - - function Create_Unbounded_Array (Ndim : Dim_Type; El_Type : Type_Acc) - return Type_Acc - is - subtype Unbounded_Type_Type is Type_Type (Type_Unbounded_Array); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array, - Is_Synth => El_Type.Is_Synth, - Al => El_Type.Al, - Sz => 0, - W => 0, - Uarr_Ndim => Ndim, - Uarr_El => El_Type))); - end Create_Unbounded_Array; - - function Create_Unbounded_Vector (El_Type : Type_Acc) return Type_Acc - is - subtype Unbounded_Type_Type is Type_Type (Type_Unbounded_Vector); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Vector, - Is_Synth => El_Type.Is_Synth, - Al => El_Type.Al, - Sz => 0, - W => 0, - Uvec_El => El_Type))); - end Create_Unbounded_Vector; - - function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc is - begin - case Arr_Type.Kind is - when Type_Vector => - return Arr_Type.Vec_El; - when Type_Array => - return Arr_Type.Arr_El; - when Type_Unbounded_Array => - return Arr_Type.Uarr_El; - when Type_Unbounded_Vector => - return Arr_Type.Uvec_El; - when others => - raise Internal_Error; - end case; - end Get_Array_Element; - - function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type) - return Bound_Type is - begin - case Typ.Kind is - when Type_Vector => - if Dim /= 1 then - raise Internal_Error; - end if; - return Typ.Vbound; - when Type_Array => - return Typ.Abounds.D (Dim); - when others => - raise Internal_Error; - end case; - end Get_Array_Bound; - - function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32 - is - Len : Int64; - begin - case Rng.Dir is - when Iir_To => - Len := Rng.Right - Rng.Left + 1; - when Iir_Downto => - Len := Rng.Left - Rng.Right + 1; - end case; - if Len < 0 then - return 0; - else - return Uns32 (Len); - end if; - end Get_Range_Length; - - function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc - is - use System; - subtype Data_Type is Rec_El_Array (Nels); - Res : Address; - begin - -- Manually allocate the array to handle large arrays without - -- creating a large temporary value. - Areapools.Allocate - (Current_Pool.all, Res, - Data_Type'Size / Storage_Unit, Data_Type'Alignment); - - declare - -- Discard the warnings for no pragma Import as we really want - -- to use the default initialization. - pragma Warnings (Off); - Addr1 : constant Address := Res; - Init : Data_Type; - for Init'Address use Addr1; - pragma Warnings (On); - begin - null; - end; - - return To_Rec_El_Array_Acc (Res); - end Create_Rec_El_Array; - - function Align (Off : Size_Type; Al : Palign_Type) return Size_Type - is - Mask : constant Size_Type := 2 ** Natural (Al) - 1; - begin - return (Off + Mask) and not Mask; - end Align; - - function Create_Record_Type (Els : Rec_El_Array_Acc) - return Type_Acc - is - subtype Record_Type_Type is Type_Type (Type_Record); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type); - Is_Synth : Boolean; - W : Width; - Al : Palign_Type; - Sz : Size_Type; - begin - -- Layout the record. - Is_Synth := True; - Al := 0; - Sz := 0; - W := 0; - for I in Els.E'Range loop - declare - E : Rec_El_Type renames Els.E (I); - begin - -- For nets. - E.Boff := W; - Is_Synth := Is_Synth and E.Typ.Is_Synth; - W := W + E.Typ.W; - - -- For memory. - Al := Palign_Type'Max (Al, E.Typ.Al); - Sz := Align (Sz, E.Typ.Al); - E.Moff := Sz; - Sz := Sz + E.Typ.Sz; - end; - end loop; - Sz := Align (Sz, Al); - - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record, - Is_Synth => Is_Synth, - Al => Al, - Sz => Sz, - W => W, - Rec => Els))); - end Create_Record_Type; - - function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc - is - subtype Access_Type_Type is Type_Type (Type_Access); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Access_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access, - Is_Synth => False, - Al => 2, - Sz => 4, - W => 32, - Acc_Acc => Acc_Type))); - end Create_Access_Type; - - function Create_File_Type (File_Type : Type_Acc) return Type_Acc - is - subtype File_Type_Type is Type_Type (Type_File); - function Alloc is new Areapools.Alloc_On_Pool_Addr (File_Type_Type); - begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_File, - Is_Synth => False, - Al => 2, - Sz => 4, - W => 32, - File_Typ => File_Type))); - end Create_File_Type; - function Create_Value_Wire (W : Wire_Id) return Value_Acc is subtype Value_Type_Wire is Value_Type (Values.Value_Wire); @@ -764,64 +309,6 @@ package body Synth.Values is return Res; end Unshare; - function Get_Type_Width (Atype : Type_Acc) return Width is - begin - pragma Assert (Atype.Kind /= Type_Unbounded_Array); - return Atype.W; - end Get_Type_Width; - - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width is - begin - case T.Kind is - when Type_Vector => - if Dim /= 1 then - raise Internal_Error; - end if; - return T.Vbound.Len; - when Type_Slice => - if Dim /= 1 then - raise Internal_Error; - end if; - return T.W; - when Type_Array => - return T.Abounds.D (Dim).Len; - when others => - raise Internal_Error; - end case; - end Get_Bound_Length; - - function Is_Matching_Bounds (L, R : Type_Acc) return Boolean is - begin - case L.Kind is - when Type_Bit - | Type_Logic - | Type_Discrete - | Type_Float => - pragma Assert (L.Kind = R.Kind); - return True; - when Type_Vector - | Type_Slice => - return Get_Bound_Length (L, 1) = Get_Bound_Length (R, 1); - when Type_Array => - for I in L.Abounds.D'Range loop - if Get_Bound_Length (L, I) /= Get_Bound_Length (R, I) then - return False; - end if; - end loop; - return True; - when Type_Unbounded_Array - | Type_Unbounded_Vector => - raise Internal_Error; - when Type_Record => - -- FIXME: handle vhdl-08 - return True; - when Type_Access => - return True; - when Type_File => - raise Internal_Error; - end case; - end Is_Matching_Bounds; - type Ghdl_U8_Ptr is access all Ghdl_U8; function To_U8_Ptr is new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_U8_Ptr); @@ -1134,12 +621,4 @@ package body Synth.Values is raise Internal_Error; end case; end Get_Memtyp; - - procedure Init is - begin - Instance_Pool := Global_Pool'Access; - Boolean_Type := Create_Bit_Type; - Logic_Type := Create_Logic_Type; - Bit_Type := Create_Bit_Type; - end Init; end Synth.Values; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 95f7f3f0d..ec1c28813 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -28,136 +28,11 @@ with Grt.Files_Operations; with Netlists; use Netlists; -with Vhdl.Nodes; use Vhdl.Nodes; - +with Synth.Objtypes; use Synth.Objtypes; with Synth.Environment; use Synth.Environment; with Synth.Source; use Synth.Source; package Synth.Values is - type Discrete_Range_Type is record - -- An integer range. - Dir : Iir_Direction; - - -- Netlist representation: signed or unsigned, width of vector. - Is_Signed : Boolean; - - Left : Int64; - Right : Int64; - end record; - - -- Return the width of RNG. - function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width; - - type Float_Range_Type is record - Dir : Iir_Direction; - Left : Fp64; - Right : Fp64; - end record; - - type Bound_Type is record - Dir : Iir_Direction; - Left : Int32; - Right : Int32; - Len : Width; - end record; - - type Bound_Array_Type is array (Dim_Type range <>) of Bound_Type; - - type Bound_Array (Ndim : Dim_Type) is record - D : Bound_Array_Type (1 .. Ndim); - end record; - - type Bound_Array_Acc is access Bound_Array; - - type Type_Kind is - ( - Type_Bit, - Type_Logic, - Type_Discrete, - Type_Float, - Type_Vector, - Type_Unbounded_Vector, - - -- A slice is for a slice of vector with dynamic bounds. So the bounds - -- of the result aren't known, but its width is. - Type_Slice, - Type_Array, - Type_Unbounded_Array, - Type_Record, - - Type_Access, - Type_File - ); - - subtype Type_Nets is Type_Kind range Type_Bit .. Type_Logic; - - type Type_Type (Kind : Type_Kind); - type Type_Acc is access Type_Type; - - type Rec_El_Type is record - -- Bit offset: offset of the element in a net. - Boff : Uns32; - - -- Memory offset: offset of the element in memory. - Moff : Size_Type; - - -- Type of the element. - Typ : Type_Acc; - end record; - - type Rec_El_Array_Type is array (Iir_Index32 range <>) of Rec_El_Type; - type Rec_El_Array (Len : Iir_Index32) is record - E : Rec_El_Array_Type (1 .. Len); - end record; - - type Rec_El_Array_Acc is access Rec_El_Array; - - -- Power of 2 alignment. - type Palign_Type is range 0 .. 3; - - type Type_Type (Kind : Type_Kind) is record - -- False if the type is not synthesisable: is or contains access/file. - Is_Synth : Boolean; - - -- Alignment (in bytes) for this type. - Al : Palign_Type; - - -- Number of bytes (when in memory) for this type. - Sz : Size_Type; - - -- Number of bits (when in a net) for this type. - W : Width; - - case Kind is - when Type_Bit - | Type_Logic => - null; - when Type_Discrete => - Drange : Discrete_Range_Type; - when Type_Float => - Frange : Float_Range_Type; - when Type_Vector => - Vbound : Bound_Type; - Vec_El : Type_Acc; - when Type_Unbounded_Vector => - Uvec_El : Type_Acc; - when Type_Slice => - Slice_El : Type_Acc; - when Type_Array => - Abounds : Bound_Array_Acc; - Arr_El : Type_Acc; - when Type_Unbounded_Array => - Uarr_Ndim : Dim_Type; - Uarr_El : Type_Acc; - when Type_Record => - Rec : Rec_El_Array_Acc; - when Type_Access => - Acc_Acc : Type_Acc; - when Type_File => - File_Typ : Type_Acc; - end case; - end record; - -- Values is how signals and variables are decomposed. This is similar to -- values in simulation, but simplified (no need to handle files, -- accesses...) @@ -194,25 +69,6 @@ package Synth.Values is subtype File_Index is Grt.Files_Operations.Ghdl_File_Index; - type Memory_Element is mod 2**8; - type Memory_Array is array (Size_Type range <>) of Memory_Element; - - -- Flat pointer for a generic pointer. - type Memory_Ptr is access all Memory_Array (Size_Type); - - type Memtyp is record - Typ : Type_Acc; - Mem : Memory_Ptr; - end record; - - -- Offsets for a value. - type Value_Offsets is record - Net_Off : Uns32; - Mem_Off : Size_Type; - end record; - - function "+" (L, R : Value_Offsets) return Value_Offsets; - type Value_Type (Kind : Value_Kind) is record case Kind is when Value_Net => @@ -247,55 +103,6 @@ package Synth.Values is procedure Free_Valtyp_Array is new Ada.Unchecked_Deallocation (Valtyp_Array, Valtyp_Array_Acc); - Global_Pool : aliased Areapool; - Expr_Pool : aliased Areapool; - - -- Areapool used by Create_*_Value - Current_Pool : Areapool_Acc := Expr_Pool'Access; - - -- Pool for objects allocated in the current instance. - Instance_Pool : Areapool_Acc; - - -- Types. - function Create_Discrete_Type (Rng : Discrete_Range_Type; - Sz : Size_Type; - W : Width) - return Type_Acc; - - function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc; - function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) - return Type_Acc; - function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) - return Type_Acc; - function Create_Unbounded_Vector (El_Type : Type_Acc) return Type_Acc; - function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) - return Type_Acc; - function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc; - function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) - return Type_Acc; - function Create_Unbounded_Array (Ndim : Dim_Type; El_Type : Type_Acc) - return Type_Acc; - function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc; - - function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc; - - function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc; - - function Create_File_Type (File_Type : Type_Acc) return Type_Acc; - - -- Return the bounds of dimension DIM of a vector/array. For a vector, - -- DIM must be 1. - function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type) - return Bound_Type; - - -- Return the length of RNG. - function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32; - - -- Return the element of a vector/array/unbounded_array. - function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc; - - function Is_Bounded_Type (Typ : Type_Acc) return Boolean; - -- True if VAL is static, ie contains neither nets nor wires. function Is_Static (Val : Value_Acc) return Boolean; @@ -303,7 +110,6 @@ package Synth.Values is function Is_Static_Val (Val : Value_Acc) return Boolean; function Is_Equal (L, R : Valtyp) return Boolean; - function Are_Types_Equal (L, R : Type_Acc) return Boolean; -- Create a Value_Net. function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp; @@ -345,20 +151,6 @@ package Synth.Values is function Unshare (Src : Valtyp; Pool : Areapool_Acc) return Valtyp; - -- Return the length of a vector type. - function Vec_Length (Typ : Type_Acc) return Iir_Index32; - - -- Get the number of indexes in array type TYP without counting - -- sub-elements. - function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32; - - -- Return length of dimension DIM of type T. - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width; - - function Is_Matching_Bounds (L, R : Type_Acc) return Boolean; - - function Get_Type_Width (Atype : Type_Acc) return Width; - -- Create a default initial value for TYP. function Create_Value_Default (Typ : Type_Acc) return Valtyp; procedure Write_Value_Default (M : Memory_Ptr; Typ : Type_Acc); @@ -386,11 +178,4 @@ package Synth.Values is procedure Copy_Memory (Dest : Memory_Ptr; Src : Memory_Ptr; Sz : Size_Type); procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp); - - procedure Init; - - -- Set by Init. - Boolean_Type : Type_Acc := null; - Logic_Type : Type_Acc := null; - Bit_Type : Type_Acc := null; end Synth.Values; diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index 4c83f2646..09860618d 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -21,7 +21,7 @@ with Errorout; use Errorout; with Vhdl.Errors; use Vhdl.Errors; -with Synth.Values; +with Synth.Objtypes; with Synth.Insts; use Synth.Insts; with Synth.Environment.Debug; @@ -56,7 +56,7 @@ package body Synthesis is Global_Instance := Make_Base_Instance; - Synth.Values.Init; + Synth.Objtypes.Init; Synth_Top_Entity (Global_Instance, Arch, Config, Encoding, Inst); Synth_All_Instances; |