From 49294a83ee67eef83180721c578f69855bf96cad Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 24 Nov 2017 06:21:01 +0100 Subject: Create the simul.ads package (for a namespace). --- src/vhdl/simulate/simul-environments.ads | 481 +++++++++++++++++++++++++++++++ 1 file changed, 481 insertions(+) create mode 100644 src/vhdl/simulate/simul-environments.ads (limited to 'src/vhdl/simulate/simul-environments.ads') diff --git a/src/vhdl/simulate/simul-environments.ads b/src/vhdl/simulate/simul-environments.ads new file mode 100644 index 000000000..e043659b3 --- /dev/null +++ b/src/vhdl/simulate/simul-environments.ads @@ -0,0 +1,481 @@ +-- Naive values for interpreted simulation +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Ada.Text_IO; +with Ada.Unchecked_Deallocation; +with Types; use Types; +with Iirs; use Iirs; +with Grt.Types; use Grt.Types; +with Grt.Signals; use Grt.Signals; +with Grt.Files; +with Areapools; use Areapools; +-- with System.Debug_Pools; + +package Simul.Environments is + -- During simulation, all values are contained into objects of type + -- iir_value_literal. The annotation pass creates such objects for every + -- literal of units. The elaboration pass creates such objects for + -- signals, variables, contants... + -- The simulator uses iir_value_literal for intermediate results, for + -- computed values... + + -- There is several kinds of iir_value_literal, mainly depending on the + -- type of the value: + -- + -- iir_value_e32: + -- the value is an enumeration literal. The enum field contains the + -- position of the literal (same as 'pos). + -- + -- iir_value_i64: + -- the value is an integer. + -- + -- iir_value_f64: + -- the value is a floating point. + -- + -- iir_value_range: + -- Boundaries and direction. + -- + -- iir_value_array: + -- All the values are contained in the array Val_Array. + -- Boundaries of the array are contained in the array BOUNDS, one element + -- per dimension, from 1 to number of dimensions. + -- + -- iir_value_signal: + -- Special case: the iir_value_literal designates a signal. + -- + -- iir_value_record + -- For records. + -- + -- iir_value_access + -- for accesses. + -- + -- iir_value_file + -- for files. + + -- Memory management: + -- The values are always allocated on areapool, which uses a mark/release + -- management. A release operation frees all the memory of the areapool + -- allocated since the mark. This memory management is very efficient. + -- + -- There is one areapool per processes; there is one mark per instances. + -- Objects (variables, signals, constants, iterators, ...) are allocated + -- on the per-process pool. When an activation frame is created (due + -- to a call to a subprogram), a mark is saved. When the activation frame + -- is removed (due to a return from subprogram), the memory is released to + -- the mark. That's simple. + -- + -- Objects for the process is allocated in that areapool, but never + -- released (could be if the process is waiting forever if the user don't + -- need to inspect values). + -- + -- Signals and constants for blocks/entity/architecture are allocated on + -- a global pool. + -- + -- In fact this is not so simple because of functions: they return a + -- value. The current solution is to compute every expressions on a + -- expression pool (only one is needed as the computation cannot be + -- suspended), use the result (copy in case of assignment or return), and + -- release that pool. + -- + -- It is highly recommended to share values as much as possible for + -- expressions (for example, alias the values of 'others =>'). Do not + -- share values for names, but be sure to keep the original nodes. + -- ??? In fact sharing is required to pass actual by references. + -- When an object is created, be sure to unshare the values. This is + -- usually achieved by Copy. + -- + -- Finally, a pool is also needed during elaboration (as elaboration is + -- not done within the context of a process). + + type Iir_Value_Kind is + (Iir_Value_B1, Iir_Value_E8, Iir_Value_E32, + Iir_Value_I64, Iir_Value_F64, + Iir_Value_Access, + Iir_Value_File, + Iir_Value_Range, + Iir_Value_Array, Iir_Value_Record, + Iir_Value_Protected, + Iir_Value_Signal, + Iir_Value_Terminal, + Iir_Value_Quantity, + Iir_Value_Environment); + + -- Uniq identifier for scalar signal. First identifier is 'First + 1. + type Signal_Index_Type is new Natural; + function Get_Last_Signal_Index return Signal_Index_Type; + + type Protected_Index_Type is new Natural; + type Quantity_Index_Type is new Natural; + type Terminal_Index_Type is new Natural; + type Environment_Index_Type is new Natural; + + -- Scalar values. Only these ones can be signals. + 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; + + subtype Iir_Value_Physicals is + Iir_Value_Kind range Iir_Value_I64 .. Iir_Value_I64; + + type Iir_Value_Literal (Kind: Iir_Value_Kind); + + type Iir_Value_Literal_Acc is access Iir_Value_Literal; + + -- Must start at 0. + -- Thus, length of the array is val_array'last - 1. + type Iir_Value_Literal_Array is array (Iir_Index32 range <>) of + Iir_Value_Literal_Acc; + + type Iir_Value_Literal_Array_Acc is access Iir_Value_Literal_Array; + + type Value_Bounds_Array (Nbr_Dims : Iir_Index32) is record + D : Iir_Value_Literal_Array (1 .. Nbr_Dims); + end record; + + type Value_Bounds_Array_Acc is access Value_Bounds_Array; + + type Value_Array (Len : Iir_Index32) is record + V : Iir_Value_Literal_Array (1 .. Len); + end record; + + type Value_Array_Acc is access Value_Array; + + -- A block instance with its architecture/entity declaration is an + -- instancied entity. + type Block_Instance_Type; + type Block_Instance_Acc is access Block_Instance_Type; + + type Iir_Value_Literal (Kind: Iir_Value_Kind) is record + 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 => + I64 : Ghdl_I64; + when Iir_Value_F64 => + F64 : Ghdl_F64; + when Iir_Value_Access => + Val_Access: Iir_Value_Literal_Acc; + when Iir_Value_File => + File: Grt.Files.Ghdl_File_Index; + when Iir_Value_Array => + Val_Array: Value_Array_Acc; -- range 1 .. N + Bounds : Value_Bounds_Array_Acc; -- range 1 .. Dim + when Iir_Value_Record => + Val_Record: Value_Array_Acc; -- range 1 .. N + when Iir_Value_Signal => + Sig : Ghdl_Signal_Ptr; + -- Each signal has a uniq identifier. + Sig_Id : Signal_Index_Type; + when Iir_Value_Protected => + Prot : Protected_Index_Type; + when Iir_Value_Quantity => + Quantity : Quantity_Index_Type; + when Iir_Value_Terminal => + Terminal : Terminal_Index_Type; + when Iir_Value_Environment => + Environment : Environment_Index_Type; + when Iir_Value_Range => + Dir: Iir_Direction; + Length : Iir_Index32; + Left: Iir_Value_Literal_Acc; + Right: Iir_Value_Literal_Acc; + end case; + end record; + + type Object_Slot_Type is new Natural; + subtype Parameter_Slot_Type is Object_Slot_Type range 0 .. 2**15; + + type Pkg_Index_Type is new Natural; + + -- Scope corresponding to an object. + type Scope_Kind_Type is + ( + -- For a package, the depth is + Scope_Kind_Package, + Scope_Kind_Component, + Scope_Kind_Frame, + Scope_Kind_Pkg_Inst, + Scope_Kind_None + ); + type Scope_Depth_Type is range 0 .. 2**15; + type Scope_Type (Kind : Scope_Kind_Type := Scope_Kind_None) is record + case Kind is + when Scope_Kind_Package => + Pkg_Index : Pkg_Index_Type; + when Scope_Kind_Component => + null; + when Scope_Kind_Frame => + Depth : Scope_Depth_Type; + when Scope_Kind_Pkg_Inst => + Pkg_Param : Parameter_Slot_Type; + -- Pkg_Parent : Sim_Info_Acc; + when Scope_Kind_None => + null; + end case; + end record; + + type Block_Instance_Id is new Natural; + No_Block_Instance_Id : constant Block_Instance_Id := 0; + + type Objects_Array is array (Object_Slot_Type range <>) of + Iir_Value_Literal_Acc; + + type Block_Instance_Type (Max_Objs : Object_Slot_Type) is record + -- Flag for wait statement: true if not yet executed. + In_Wait_Flag : Boolean; + + -- Uniq number for a block instance. + Id : Block_Instance_Id; + + -- Useful informations for a dynamic block (ie, a frame). + -- The scope level and an access to the block of upper scope level. + Block_Scope : Scope_Type; + Up_Block : Block_Instance_Acc; + + -- Block, architecture, package, process, component instantiation for + -- this instance. + Label : Iir; + + -- For blocks: corresponding block (different from label for direct + -- component instantiation statement and generate iterator). + -- For packages: Null_Iir + -- For subprograms and processes: statement being executed. + Stmt : Iir; + + -- Instanciation tree. + + -- Parent is always set (but null for top-level block and packages) + Parent: Block_Instance_Acc; + + -- Chain of children. They are in declaration order after elaboration. + -- (in reverse order during elaboration). + -- Not null only for blocks and processes. + Children: Block_Instance_Acc; + Brother: Block_Instance_Acc; + + -- Port association map for this block, if any. + Ports_Map : Iir; + + -- Pool marker for the child (only for subprograms and processes). + Marker : Areapools.Mark_Type; + + -- Reference to the actuals, for copy-out when returning from a + -- procedure. + Actuals_Ref : Value_Array_Acc; + + -- Only for function frame; contains the result. + Result: Iir_Value_Literal_Acc; + + -- Last object elaborated (or number of objects elaborated). + -- Note: this is generally the slot index of the next object to be + -- elaborated (this may be wrong for dynamic objects due to execution + -- branches). + Elab_Objects : Object_Slot_Type := 0; + + -- Values of the objects in that frame. + Objects : Objects_Array (1 .. Max_Objs); + end record; + + procedure Free is new Ada.Unchecked_Deallocation + (Object => Block_Instance_Type, Name => Block_Instance_Acc); + + + -- What is chosen for time. + subtype Iir_Value_Time is Ghdl_I64; + + 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; + + function Create_Signal_Value (Sig : Ghdl_Signal_Ptr) + return Iir_Value_Literal_Acc; + function Create_Terminal_Value (Terminal : Terminal_Index_Type) + return Iir_Value_Literal_Acc; + function Create_Quantity_Value (Quantity : Quantity_Index_Type) + return Iir_Value_Literal_Acc; + function Create_Environment_Value (Env : Environment_Index_Type) + 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). + function Create_I64_Value (Val : Ghdl_I64) return Iir_Value_Literal_Acc; + + -- Return an iir_value_literal_acc (iir_value_fp64) + function Create_F64_Value (Val : Ghdl_F64) return Iir_Value_Literal_Acc; + + function Create_Access_Value (Val : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc; + + function Create_File_Value (Val : Grt.Files.Ghdl_File_Index) + return Iir_Value_Literal_Acc; + + function Create_Protected_Value (Prot : Protected_Index_Type) + return Iir_Value_Literal_Acc; + + -- Return an iir_value_literal (iir_value_record) of NBR elements. + function Create_Record_Value + (Nbr : Iir_Index32; Pool : Areapool_Acc := Current_Pool) + return Iir_Value_Literal_Acc; + + -- Allocate array and the dimension vector (but bounds and values aren't + -- allocated). + function Create_Array_Value (Dim : Iir_Index32; + Pool : Areapool_Acc := Current_Pool) + return Iir_Value_Literal_Acc; + + -- Allocate the Val_Array vector. + procedure Create_Array_Data (Arr : Iir_Value_Literal_Acc; + Len : Iir_Index32; + Pool : Areapool_Acc := Current_Pool); + + -- Return an array of length LENGTH and DIM bounds. + -- If DIM is 0, then the bounds array is not allocated. + function Create_Array_Value (Length: Iir_Index32; + Dim : Iir_Index32; + Pool : Areapool_Acc := Current_Pool) + return Iir_Value_Literal_Acc; + + -- Create a range_value of life LIFE. + function Create_Range_Value + (Left, Right : Iir_Value_Literal_Acc; + Dir : Iir_Direction; + Length : Iir_Index32) + return Iir_Value_Literal_Acc; + + -- Create a range_value (compute the length) + function Create_Range_Value + (Left, Right : Iir_Value_Literal_Acc; + Dir : Iir_Direction) + return Iir_Value_Literal_Acc; + + -- Return true if the value of LEFT and RIGHT are equal. + -- Return false if they are not equal. + -- Raise constraint_error if the types differes. + -- Value or sub-value must not be indirect. + function Is_Equal (Left, Right: Iir_Value_Literal_Acc) return Boolean; + + -- Return TRUE iif ARANGE is a null range. + function Is_Null_Range (Arange : Iir_Value_Literal_Acc) return Boolean; + + -- Get order of LEFT with RIGHT. + -- Must be discrete kind (enum, int, fp, physical) or array (uni dim). + type Order is (Less, Equal, Greater); + function Compare_Value (Left, Right : Iir_Value_Literal_Acc) + return Order; + + -- Check that SRC has the same structure as DEST. Report an error at + -- LOC if not. + procedure Check_Bounds (Dest : Iir_Value_Literal_Acc; + Src : Iir_Value_Literal_Acc; + Loc : Iir); + + -- Store (by copy) SRC into DEST. + -- The type must be equal (otherwise constraint_error is raised). + -- Life of DEST must be Target, otherwise program_error is raised. + -- Value or sub-value must not be indirect. + procedure Store (Dest : Iir_Value_Literal_Acc; Src : Iir_Value_Literal_Acc); + + -- Create a copy of SRC allocated in POOL. + function Unshare (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc) + return Iir_Value_Literal_Acc; + + -- If SRC is an array, just copy the bounds in POOL and return it. + -- Otherwise return SRC. Values are always kept, so that this could + -- be used by alias declarations. + function Unshare_Bounds (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc) + return Iir_Value_Literal_Acc; + + -- Create a copy of SRC on the heap. + function Unshare_Heap (Src : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc; + + -- Deallocate value accessed by ACC. + procedure Free_Heap_Value (Acc : Iir_Value_Literal_Acc); + + -- Increment. + -- VAL must be of kind integer or enumeration. + -- VAL must be of life temporary. + procedure Increment (Val : Iir_Value_Literal_Acc); + + -- Copy BOUNDS of SRC with a specified life. + -- Note: val_array is allocated but not filled. + function Copy_Array_Bound (Src : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc; + + -- Copy the bounds (well the array containing the values) of SRC. + -- Val_record is allocated but not filled. + function Copy_Record (Src : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc; + + -- Return the number of scalars elements in VALS. + function Get_Nbr_Of_Scalars (Val : Iir_Value_Literal_Acc) return Natural; + + -- Return the position of an enumerated type value. + function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural; + + -- Well known values. + -- Boolean_to_lit can be used to convert a boolean value from Ada to a + -- boolean value for vhdl. + type Lit_Enum_Type is array (Boolean) of Iir_Value_Literal_Acc; + Lit_Enum_0 : constant Iir_Value_Literal_Acc := + new Iir_Value_Literal'(Kind => Iir_Value_B1, + B1 => False); + Lit_Enum_1 : constant Iir_Value_Literal_Acc := + new Iir_Value_Literal'(Kind => Iir_Value_B1, + B1 => True); + Boolean_To_Lit: constant Lit_Enum_Type := + (False => Lit_Enum_0, True => Lit_Enum_1); + Lit_Boolean_False: Iir_Value_Literal_Acc + renames Boolean_To_Lit (False); + Lit_Boolean_True: Iir_Value_Literal_Acc + renames Boolean_To_Lit (True); + + -- Literal NULL. + Null_Lit: constant Iir_Value_Literal_Acc := + new Iir_Value_Literal'(Kind => Iir_Value_Access, + Val_Access => null); + + -- Disp a value_literal in raw form. + procedure Disp_Value (Value: Iir_Value_Literal_Acc); + procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc; + Tab: Ada.Text_IO.Count); + + -- Disp a value_literal in readable form. + procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir); +end Simul.Environments; -- cgit v1.2.3