-- 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; 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); function To_Value_Acc is new Ada.Unchecked_Conversion (System.Address, Value_Acc); function To_Value_Array_Acc is new Ada.Unchecked_Conversion (System.Address, Values.Value_Array_Acc); function Is_Const (Val : Value_Acc) return Boolean is begin case Val.Kind is when Value_Discrete | Value_Float => return True; when Value_Net | Value_Wire => return False; when Value_Const_Array | Value_Const_Record => return True; when Value_Array | Value_Record => return False; when Value_Alias => return Is_Const (Val.A_Obj); when Value_Instance | Value_Subtype => -- Not really a value. raise Internal_Error; end case; end Is_Const; function Is_Const_Val (Val : Value_Acc) return Boolean is begin case Val.Kind is when Value_Discrete | Value_Float => return True; when Value_Net => return Netlists.Utils.Is_Const_Net (Val.N); when Value_Wire => return Is_Const_Wire (Val.W); when Value_Const_Array | Value_Const_Record => return True; when Value_Array | Value_Record => return False; when Value_Instance | Value_Subtype | Value_Alias => -- Not really a value. raise Internal_Error; end case; end Is_Const_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 => return True; when Type_Unbounded_Array | Type_Unbounded_Vector => return False; end case; end Is_Bounded_Type; function Is_Equal (L, R : Value_Acc) return Boolean is begin if L.Kind /= R.Kind then return False; end if; case L.Kind is when Value_Discrete => return L.Scal = R.Scal; when Value_Const_Array => if L.Arr.Len /= R.Arr.Len then return False; end if; for I in L.Arr.V'Range loop if not Is_Equal (L.Arr.V (I), R.Arr.V (I)) then return False; end if; end loop; return True; when others => -- TODO. raise Internal_Error; end case; end Is_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, 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, W => 1))); end Create_Logic_Type; function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width) return Type_Acc is subtype Discret
/**CFile****************************************************************

  FileName    [vec.h]

  SystemName  [ABC: Logic synthesis and verification system.]

  PackageName [Resizable arrays.]

  Synopsis    [External declarations.]

  Author      [Alan Mishchenko]
  
  Affiliation [UC Berkeley]

  Date        [Ver. 1.0. Started - June 20, 2005.]

  Revision    [$Id: vec.h,v 1.00 2005/06/20 00:00:00 alanmi Exp $]

***********************************************************************/
 
#ifndef ABC__misc__vec__vec_h
#define ABC__misc__vec__vec_h


////////////////////////////////////////////////////////////////////////
///                          INCLUDES                                ///
////////////////////////////////////////////////////////////////////////

#include "misc/util/abc_global.h"

#include "vecInt.h"
#include "vecFlt.h"
#include "vecStr.h"
#include "vecPtr.h"
#include "vecVec.h"
#include "vecAtt.h"
#include "vecWrd.h"
#include "vecBit.h"

////////////////////////////////////////////////////////////////////////
///                      MACRO DEFINITIONS                           ///
////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////
///                         PARAMETERS                               ///
////////////////////////////////////////////////////////////////////////



ABC_NAMESPACE_HEADER_START


////////////////////////////////////////////////////////////////////////
///                         BASIC TYPES                              ///
////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////
///                    FUNCTION DECLARATIONS                         ///
////////////////////////////////////////////////////////////////////////



ABC_NAMESPACE_HEADER_END



#endif

////////////////////////////////////////////////////////////////////////
///                       END OF FILE                                ///
////////////////////////////////////////////////////////////////////////
generated by cgit v1.2.3 (git 2.25.1) at 2025-09-11 01:43:14 +0000
Init : Data_Type; for Init'Address use Addr1; pragma Warnings (On); begin null; end; return To_Value_Array_Acc (Res); end Create_Value_Array; function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Value_Acc is subtype Value_Type_Array is Value_Type (Value_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Array); Res : Value_Acc; begin pragma Assert (Bounds /= null); Res := To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Array, Arr => Arr, Typ => Bounds))); return Res; end Create_Value_Array; function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Value_Acc is subtype Value_Type_Const_Array is Value_Type (Value_Const_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const_Array); Res : Value_Acc; begin pragma Assert (Bounds /= null); Res := To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Const_Array, Arr => Arr, Typ => Bounds))); return Res; end Create_Value_Const_Array; function Get_Array_Flat_Length (Typ : Type_Acc) return Width is begin case Typ.Kind is when Type_Vector => return 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 Len; end; when others => raise Internal_Error; end case; end Get_Array_Flat_Length; procedure Create_Array_Data (Arr : Value_Acc) is Len : Width; begin case Arr.Typ.Kind is when Type_Array => Len := Get_Array_Flat_Length (Arr.Typ); when Type_Vector => Len := Arr.Typ.Vbound.Len; when others => raise Internal_Error; end case; Arr.Arr := Create_Value_Array (Iir_Index32 (Len)); end Create_Array_Data; function Create_Value_Array (Bounds : Type_Acc) return Value_Acc is Res : Value_Acc; begin Res := Create_Value_Array (Bounds, null); Create_Array_Data (Res); return Res; end Create_Value_Array; function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Value_Acc is subtype Value_Type_Record is Value_Type (Value_Record); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Record); begin return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Record, Typ => Typ, Rec => Els))); end Create_Value_Record; function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Value_Acc is subtype Value_Type_Const_Record is Value_Type (Value_Const_Record); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const_Record); begin return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Const_Record, Typ => Typ, Rec => Els))); end Create_Value_Const_Record; function Create_Value_Instance (Inst : Instance_Id) return Value_Acc is subtype Value_Type_Instance is Value_Type (Value_Instance); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Instance); begin return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Instance, Instance => Inst, Typ => null))); end Create_Value_Instance; function Create_Value_Subtype (Typ : Type_Acc) return Value_Acc is subtype Value_Type_Subtype is Value_Type (Value_Subtype); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Subtype); begin return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Subtype, Typ => Typ))); end Create_Value_Subtype; function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) return Value_Acc is subtype Value_Type_Alias is Value_Type (Value_Alias); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Alias); begin return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Alias, A_Obj => Obj, A_Off => Off, Typ => Typ))); end Create_Value_Alias; function Copy (Src: in Value_Acc) return Value_Acc is Res: Value_Acc; begin case Src.Kind is when Value_Wire => Res := Create_Value_Wire (Src.W, Src.Typ); when others => raise Internal_Error; end case; return Res; end Copy; function Unshare (Src : Value_Acc; Pool : Areapool_Acc) return Value_Acc is Prev_Pool : constant Areapool_Acc := Current_Pool; Res : Value_Acc; begin Current_Pool := Pool; Res := Copy (Src); Current_Pool := Prev_Pool; 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 (L : Type_Acc; Dim : Iir_Index32) return Width is begin case L.Kind is when Type_Vector => if Dim /= 1 then raise Internal_Error; end if; return L.Vbound.Len; when Type_Slice => if Dim /= 1 then raise Internal_Error; end if; return L.W; when Type_Array => return L.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; end case; end Is_Matching_Bounds; function Create_Value_Default (Typ : Type_Acc) return Value_Acc is begin case Typ.Kind is when Type_Bit | Type_Logic => -- FIXME: what about subtype ? return Create_Value_Discrete (0, Typ); when Type_Discrete => return Create_Value_Discrete (Typ.Drange.Left, Typ); when Type_Float => return Create_Value_Float (Typ.Frange.Left, Typ); when Type_Vector => declare El_Typ : constant Type_Acc := Typ.Vec_El; Arr : Value_Array_Acc; begin Arr := Create_Value_Array (Iir_Index32 (Typ.Vbound.Len)); for I in Arr.V'Range loop Arr.V (I) := Create_Value_Default (El_Typ); end loop; return Create_Value_Array (Typ, Arr); end; when Type_Unbounded_Vector => raise Internal_Error; when Type_Slice => raise Internal_Error; when Type_Array => declare El_Typ : constant Type_Acc := Typ.Vec_El; Arr : Value_Array_Acc; begin Arr := Create_Value_Array (Iir_Index32 (Get_Array_Flat_Length (Typ))); for I in Arr.V'Range loop Arr.V (I) := Create_Value_Default (El_Typ); end loop; return Create_Value_Array (Typ, Arr); end; when Type_Unbounded_Array => raise Internal_Error; when Type_Record => declare Els : Value_Array_Acc; begin Els := Create_Value_Array (Typ.Rec.Len); for I in Els.V'Range loop Els.V (I) := Create_Value_Default (Typ.Rec.E (I).Typ); end loop; return Create_Value_Record (Typ, Els); end; end case; end Create_Value_Default; 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;