diff options
Diffstat (limited to 'src')
108 files changed, 6704 insertions, 2310 deletions
diff --git a/src/areapools.adb b/src/areapools.adb index dd2e38257..6b49b2d64 100644 --- a/src/areapools.adb +++ b/src/areapools.adb @@ -105,6 +105,7 @@ package body Areapools is if Erase_When_Released and then M.Last /= null + and then M.Next_Use /= 0 then declare Last : Size_Type; diff --git a/src/errorout.ads b/src/errorout.ads index f6735c8b5..16515d8af 100644 --- a/src/errorout.ads +++ b/src/errorout.ads @@ -106,6 +106,10 @@ package Errorout is -- FIXME: currently only subprograms are handled. Warnid_Unused, + -- A variable or signal is never written. + -- (only for synthesis) + Warnid_Nowrite, + -- Others choice is not needed, all values are already covered. Warnid_Others, @@ -122,6 +126,9 @@ package Errorout is -- be triggered. Warnid_Useless, + -- Missing association for a formal. + Warnid_No_Assoc, + -- Violation of staticness rules Warnid_Static, @@ -317,6 +324,7 @@ private | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs | Warnid_Hide | Warnid_Pragma | Warnid_Analyze_Assert | Warnid_Attribute | Warnid_Deprecated_Option | Warnid_Unexpected_Option + | Warnid_Nowrite | Warnid_No_Wait | Warnid_Useless | Msgid_Warning => (Enabled => True, Error => False), Warnid_Delta_Cycle | Warnid_Body | Warnid_Static | Warnid_Nested_Comment @@ -324,6 +332,7 @@ private | Warnid_Others | Warnid_Reserved_Word | Warnid_Directive | Warnid_Parenthesis | Warnid_Delayed_Checks | Warnid_Default_Binding | Warnid_Vital_Generic | Warnid_Missing_Xref + | Warnid_No_Assoc | Warnid_Unused => (Enabled => False, Error => False)); -- Compute the column from Error_Record E. diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 8f59bbf65..d3aa203f4 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -1110,7 +1110,6 @@ package body Ghdlprint is Vhdl.Canon.Canon_Flag_Configurations := False; Vhdl.Canon.Canon_Flag_Specification_Lists := False; Vhdl.Canon.Canon_Flag_Associations := False; - Vhdl.Canon.Canon_Flag_Inertial_Associations := False; -- Parse all files. for I in Args'Range loop diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index 259a3dc57..468c2253c 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -45,13 +45,12 @@ with Elab.Vhdl_Context; with Elab.Vhdl_Debug; with Elab.Vhdl_Insts; with Elab.Debugger; + with Synth.Flags; with Simul.Vhdl_Elab; with Simul.Vhdl_Simul; package body Ghdlsimul is - Flag_Interractive : Boolean := False; - procedure Compile_Init (Analyze_Only : Boolean) is begin Common_Compile_Init (Analyze_Only); @@ -65,6 +64,7 @@ package body Ghdlsimul is -- The design is always analyzed in whole. Flags.Flag_Whole_Analyze := True; Vhdl.Canon.Canon_Flag_Add_Labels := True; + Vhdl.Canon.Canon_Flag_Add_Suspend_State := True; Vhdl.Annotations.Flag_Synthesis := True; @@ -101,10 +101,6 @@ package body Ghdlsimul is Simul.Vhdl_Elab.Gather_Processes (Inst); Simul.Vhdl_Elab.Elab_Processes; - if Flag_Interractive then - Elab.Debugger.Debug_Elab (Inst); - end if; - if False then Elab.Vhdl_Debug.Disp_Hierarchy (Inst, False, True); end if; @@ -174,6 +170,8 @@ package body Ghdlsimul is Flags.Flag_String (5) := Time_Resolution; Grtlink.Flag_String := Flags.Flag_String; + Synth.Flags.Severity_Level := Grt.Options.Severity_Level; + Elaborate_Proc := Simul.Vhdl_Simul.Runtime_Elaborate'Access; Simul.Vhdl_Simul.Simulation; @@ -189,11 +187,11 @@ package body Ghdlsimul is is begin if Option = "--debug" or Option = "-g" then - Synth.Flags.Flag_Debug_Enable := True; + Elab.Debugger.Flag_Debug_Enable := True; elsif Option = "-t" then Synth.Flags.Flag_Trace_Statements := True; elsif Option = "-i" then - Flag_Interractive := True; + Simul.Vhdl_Simul.Flag_Interractive := True; else return False; end if; diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index aff353bdb..138dca8df 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -44,9 +44,11 @@ with Netlists.Disp_Verilog; with Netlists.Disp_Dot; with Netlists.Errors; with Netlists.Inference; +with Netlists.Rename; with Elab.Vhdl_Context; use Elab.Vhdl_Context; with Elab.Vhdl_Insts; +with Elab.Debugger; with Synthesis; with Synth.Disp_Vhdl; @@ -225,12 +227,14 @@ package body Ghdlsynth is Flag_Debug_Elaborate := True; elsif Option = "-de" then Flag_Debug_Noexpand := True; + elsif Option = "-dn" then + Flag_Debug_Nonull := True; elsif Option = "-t" then Flag_Trace_Statements := True; elsif Option = "-i" then Flag_Debug_Init := True; elsif Option = "-g" then - Flag_Debug_Enable := True; + Elab.Debugger.Flag_Debug_Enable := True; elsif Option = "-v" then if not Synth.Flags.Flag_Verbose then Synth.Flags.Flag_Verbose := True; @@ -275,10 +279,6 @@ package body Ghdlsynth is -- Do not canon concurrent statements. Vhdl.Canon.Canon_Flag_Concurrent_Stmts := False; - -- Do not create concurrent signal assignment for inertial - -- association. They are handled directly. - Vhdl.Canon.Canon_Flag_Inertial_Associations := False; - if Ghdlcomp.Init_Verilog_Options /= null then Ghdlcomp.Init_Verilog_Options.all (False); end if; @@ -455,6 +455,7 @@ package body Ghdlsynth is when Format_Raw_Vhdl => Netlists.Disp_Vhdl.Disp_Vhdl (Res); when Format_Verilog => + Netlists.Rename.Rename_Module (Res, Language_Verilog); Netlists.Disp_Verilog.Disp_Verilog (Res); end case; end Disp_Design; diff --git a/src/grt/config/jumps.c b/src/grt/config/jumps.c index 9a2ee1046..0b01409e7 100644 --- a/src/grt/config/jumps.c +++ b/src/grt/config/jumps.c @@ -27,7 +27,7 @@ #include <signal.h> #include <fcntl.h> -#if ( defined (__linux__) || defined (__APPLE__) ) && !defined (__ANDROID__) +#if ( (defined (__linux__) && defined (__GLIBC__) ) || defined (__APPLE__) ) && !defined (__ANDROID__) #define HAVE_BACKTRACE 1 #include <sys/ucontext.h> #endif diff --git a/src/grt/vhpi_user.h b/src/grt/vhpi_user.h index c20e21f05..9dd4cebb6 100644 --- a/src/grt/vhpi_user.h +++ b/src/grt/vhpi_user.h @@ -1,42 +1,42 @@ /* -------------------------------------------------------------------- -/* -/* Copyright 2019 IEEE P1076 WG Authors -/* -/* See the LICENSE file distributed with this work for copyright and -/* licensing information and the AUTHORS file. -/* -/* This file to you under the Apache License, Version 2.0 (the "License"). -/* You may obtain a copy of the License at -/* -/* http://www.apache.org/licenses/LICENSE-2.0 -/* -/* Unless required by applicable law or agreed to in writing, software -/* distributed under the License is distributed on an "AS IS" BASIS, -/* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or -/* implied. See the License for the specific language governing -/* permissions and limitations under the License. -/* -/* -/* Title : vhpi_user.h -/* : -/* Developers: IEEE P1076 Working Group, VHPI Task Force -/* : -/* Purpose : This header file describes the procedural interface -/* : to access VHDL compiled, instantiated and run-time -/* : data.It is derived from the UML model. For conformance -/* : with the VHPI standard, a VHPI application or program -/* : shall reference this header file. -/* : -/* Note : The contents of this file may be modified in an -/* : implementation to provide implementation-defined -/* : functionality, as described in B.3. -/* : -/* -------------------------------------------------------------------- -/* modification history : -/* -------------------------------------------------------------------- -/* $Revision: 1315 $ -/* $Date: 2008-07-13 10:11:53 +0930 (Sun, 13 Jul 2008) $ -/* -------------------------------------------------------------------- + * + * Copyright 2019 IEEE P1076 WG Authors + * + * See the LICENSE file distributed with this work for copyright and + * licensing information and the AUTHORS file. + * + * This file to you under the Apache License, Version 2.0 (the "License"). + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + * implied. See the License for the specific language governing + * permissions and limitations under the License. + * + * + * Title : vhpi_user.h + * : + * Developers: IEEE P1076 Working Group, VHPI Task Force + * : + * Purpose : This header file describes the procedural interface + * : to access VHDL compiled, instantiated and run-time + * : data.It is derived from the UML model. For conformance + * : with the VHPI standard, a VHPI application or program + * : shall reference this header file. + * : + * Note : The contents of this file may be modified in an + * : implementation to provide implementation-defined + * : functionality, as described in B.3. + * : + * -------------------------------------------------------------------- + * modification history : + * -------------------------------------------------------------------- + * $Revision: 1315 $ + * $Date: 2008-07-13 10:11:53 +0930 (Sun, 13 Jul 2008) $ + * -------------------------------------------------------------------- */ @@ -119,7 +119,7 @@ typedef int32_t vhpiIntT; typedef int64_t vhpiLongIntT; typedef unsigned char vhpiCharT; typedef double vhpiRealT; -typedef int32_t vhpiSmallPhysT; +typedef int32_t vhpiSmallPhysT; typedef struct vhpiPhysS { int32_t high; @@ -620,7 +620,7 @@ typedef enum { #ifdef VHPIEXTEND_INT_PROPERTIES VHPIEXTEND_INT_PROPERTIES - + #endif } vhpiIntPropertyT; @@ -652,7 +652,7 @@ typedef enum { #ifdef VHPIEXTEND_STR_PROPERTIES VHPIEXTEND_STR_PROPERTIES - + #endif } vhpiStrPropertyT; diff --git a/src/options.adb b/src/options.adb index 00da22ca5..019817ca3 100644 --- a/src/options.adb +++ b/src/options.adb @@ -68,7 +68,7 @@ package body Options is function Option_Warning (Opt: String; Val : Boolean) return Option_State is begin - -- Handle -Werror. + -- Handle -Werror and -Wno-error if Opt = "error" then Warning_Error (Msgid_Warning, Val); for I in Msgid_Warnings loop @@ -77,7 +77,7 @@ package body Options is return Option_Ok; end if; - -- Handle -Werror=xxx + -- Handle -Werror=xxx and -Wno-error=xxx if Opt'Length >= 6 and then Opt (Opt'First .. Opt'First + 5) = "error=" then @@ -91,6 +91,14 @@ package body Options is return Option_Err; end if; + -- Handle -Wall + if Opt = "all" then + for I in Msgid_Warnings loop + Enable_Warning(I, True); + end loop; + return Option_Ok; + end if; + -- Normal warnings. for I in Msgid_Warnings loop if Warning_Image (I) = Opt then @@ -300,6 +308,7 @@ package body Options is P (" -Wbody warns for not necessary package body"); P (" -Wspecs warns if a all/others spec does not apply"); P (" -Wunused warns if a subprogram is never used"); + P (" -Wall enables all warnings."); P (" -Werror turns warnings into errors"); -- P ("Simulation option:"); -- P (" --assert-level=LEVEL set the level which stop the"); diff --git a/src/std_names.adb b/src/std_names.adb index cf3ffeef5..fe0038318 100644 --- a/src/std_names.adb +++ b/src/std_names.adb @@ -501,7 +501,11 @@ package body Std_Names is Def ("frequency_domain", Name_Frequency_Domain); Def ("domain", Name_Domain); Def ("frequency", Name_Frequency); - Def ("real_vector", Name_Real_Vector); + + Def ("env", Name_Env); + Def ("stop", Name_Stop); + Def ("finish", Name_Finish); + Def ("resolution_limit", Name_Resolution_Limit); Def ("nul", Name_Nul); Def ("soh", Name_Soh); @@ -617,6 +621,7 @@ package body Std_Names is Def ("ieee", Name_Ieee); Def ("std_logic_1164", Name_Std_Logic_1164); Def ("vital_timing", Name_VITAL_Timing); + Def ("vital_primitives", Name_VITAL_Primitives); Def ("numeric_std", Name_Numeric_Std); Def ("numeric_bit", Name_Numeric_Bit); Def ("numeric_std_unsigned", Name_Numeric_Std_Unsigned); @@ -673,6 +678,7 @@ package body Std_Names is Def ("sin", Name_Sin); Def ("cos", Name_Cos); Def ("arctan", Name_Arctan); + Def ("sign", Name_Sign); Def ("shl", Name_Shl); Def ("shr", Name_Shr); Def ("ext", Name_Ext); diff --git a/src/std_names.ads b/src/std_names.ads index f1165488b..7b6711c98 100644 --- a/src/std_names.ads +++ b/src/std_names.ads @@ -577,9 +577,14 @@ package Std_Names is Name_Domain : constant Name_Id := Name_First_Standard + 059; Name_Frequency : constant Name_Id := Name_First_Standard + 060; - Name_Last_Standard : constant Name_Id := Name_Frequency; - - Name_First_Charname : constant Name_Id := Name_Last_Standard + 1; + -- For Std.Env + Name_First_Env : constant Name_Id := Name_Frequency + 1; + Name_Env : constant Name_Id := Name_First_Env + 0; + Name_Stop : constant Name_Id := Name_First_Env + 1; + Name_Finish : constant Name_Id := Name_First_Env + 2; + Name_Resolution_Limit : constant Name_Id := Name_First_Env + 3; + + Name_First_Charname : constant Name_Id := Name_Resolution_Limit + 1; Name_Nul : constant Name_Id := Name_First_Charname + 00; Name_Soh : constant Name_Id := Name_First_Charname + 01; Name_Stx : constant Name_Id := Name_First_Charname + 02; @@ -698,15 +703,16 @@ package Std_Names is Name_Ieee : constant Name_Id := Name_First_Ieee_Pkg + 000; Name_Std_Logic_1164 : constant Name_Id := Name_First_Ieee_Pkg + 001; Name_VITAL_Timing : constant Name_Id := Name_First_Ieee_Pkg + 002; - Name_Numeric_Std : constant Name_Id := Name_First_Ieee_Pkg + 003; - Name_Numeric_Bit : constant Name_Id := Name_First_Ieee_Pkg + 004; - Name_Numeric_Std_Unsigned : constant Name_Id := Name_First_Ieee_Pkg + 005; - Name_Std_Logic_Arith : constant Name_Id := Name_First_Ieee_Pkg + 006; - Name_Std_Logic_Signed : constant Name_Id := Name_First_Ieee_Pkg + 007; - Name_Std_Logic_Unsigned : constant Name_Id := Name_First_Ieee_Pkg + 008; - Name_Std_Logic_Textio : constant Name_Id := Name_First_Ieee_Pkg + 009; - Name_Std_Logic_Misc : constant Name_Id := Name_First_Ieee_Pkg + 010; - Name_Math_Real : constant Name_Id := Name_First_Ieee_Pkg + 011; + Name_VITAL_Primitives : constant Name_Id := Name_First_Ieee_Pkg + 003; + Name_Numeric_Std : constant Name_Id := Name_First_Ieee_Pkg + 004; + Name_Numeric_Bit : constant Name_Id := Name_First_Ieee_Pkg + 005; + Name_Numeric_Std_Unsigned : constant Name_Id := Name_First_Ieee_Pkg + 006; + Name_Std_Logic_Arith : constant Name_Id := Name_First_Ieee_Pkg + 007; + Name_Std_Logic_Signed : constant Name_Id := Name_First_Ieee_Pkg + 008; + Name_Std_Logic_Unsigned : constant Name_Id := Name_First_Ieee_Pkg + 009; + Name_Std_Logic_Textio : constant Name_Id := Name_First_Ieee_Pkg + 010; + Name_Std_Logic_Misc : constant Name_Id := Name_First_Ieee_Pkg + 011; + Name_Math_Real : constant Name_Id := Name_First_Ieee_Pkg + 012; Name_Last_Ieee_Pkg : constant Name_Id := Name_Math_Real; Name_First_Ieee_Name : constant Name_Id := Name_Last_Ieee_Pkg + 1; @@ -756,12 +762,13 @@ package Std_Names is Name_Sin : constant Name_Id := Name_First_Ieee_Name + 043; Name_Cos : constant Name_Id := Name_First_Ieee_Name + 044; Name_Arctan : constant Name_Id := Name_First_Ieee_Name + 045; - Name_Shl : constant Name_Id := Name_First_Ieee_Name + 046; - Name_Shr : constant Name_Id := Name_First_Ieee_Name + 047; - Name_Ext : constant Name_Id := Name_First_Ieee_Name + 048; - Name_Sxt : constant Name_Id := Name_First_Ieee_Name + 049; - Name_Find_Leftmost : constant Name_Id := Name_First_Ieee_Name + 050; - Name_Find_Rightmost : constant Name_Id := Name_First_Ieee_Name + 051; + Name_Sign : constant Name_Id := Name_First_Ieee_Name + 046; + Name_Shl : constant Name_Id := Name_First_Ieee_Name + 047; + Name_Shr : constant Name_Id := Name_First_Ieee_Name + 048; + Name_Ext : constant Name_Id := Name_First_Ieee_Name + 049; + Name_Sxt : constant Name_Id := Name_First_Ieee_Name + 050; + Name_Find_Leftmost : constant Name_Id := Name_First_Ieee_Name + 051; + Name_Find_Rightmost : constant Name_Id := Name_First_Ieee_Name + 052; Name_Last_Ieee_Name : constant Name_Id := Name_Find_Rightmost; Name_First_Synthesis : constant Name_Id := Name_Last_Ieee_Name + 1; diff --git a/src/synth/elab-debugger.adb b/src/synth/elab-debugger.adb index e9f372dc3..f1138904f 100644 --- a/src/synth/elab-debugger.adb +++ b/src/synth/elab-debugger.adb @@ -33,8 +33,6 @@ with Elab.Vhdl_Context.Debug; use Elab.Vhdl_Context.Debug; with Elab.Vhdl_Debug; use Elab.Vhdl_Debug; package body Elab.Debugger is - Flag_Enabled : Boolean := False; - Current_Instance : Synth_Instance_Acc; Current_Loc : Node; @@ -42,9 +40,15 @@ package body Elab.Debugger is ( Reason_Init, Reason_Break, + Reason_Time, Reason_Error ); + function Debug_Current_Instance return Synth_Instance_Acc is + begin + return Current_Instance; + end Debug_Current_Instance; + package Breakpoints is new Tables (Table_Index_Type => Natural, Table_Component_Type => Node, @@ -491,6 +495,47 @@ package body Elab.Debugger is Prepare_Continue; end Cont_Proc; + procedure Disp_A_Frame (Inst: Synth_Instance_Acc) + is + Src : Node; + begin + if Inst = Root_Instance then + Put_Line ("root instance"); + return; + end if; + + Src := Get_Source_Scope (Inst); + Put (Vhdl.Errors.Disp_Node (Src)); + Put (" at "); + Put (Files_Map.Image (Get_Location (Src))); + New_Line; + end Disp_A_Frame; + + procedure Debug_Bt (Instance : Synth_Instance_Acc) + is + Inst : Synth_Instance_Acc; + begin + Inst := Instance; + while Inst /= null loop + Disp_A_Frame (Inst); + Inst := Get_Caller_Instance (Inst); + end loop; + end Debug_Bt; + pragma Unreferenced (Debug_Bt); + + procedure Where_Proc (Line : String) + is + pragma Unreferenced (Line); + Inst : Synth_Instance_Acc; + begin + -- Check_Current_Process; + Inst := Current_Instance; + while Inst /= null loop + Disp_A_Frame (Inst); + Inst := Get_Caller_Instance (Inst); + end loop; + end Where_Proc; + procedure List_Proc (Line : String) is pragma Unreferenced (Line); @@ -654,11 +699,18 @@ package body Elab.Debugger is Next => Menu_Step'Access, Proc => Break_Proc'Access); + Menu_Where : aliased Menu_Entry := + (Kind => Menu_Command, + Name => new String'("w*here"), + Help => new String'("disp call stack"), + Next => Menu_Break'Access, + Proc => Where_Proc'Access); + Menu_Help2 : aliased Menu_Entry := (Kind => Menu_Command, Name => new String'("?"), Help => new String'("print help"), - Next => Menu_Break'Access, -- Menu_Help1'Access, + Next => Menu_Where'Access, Proc => Help_Proc'Access); Menu_Top : aliased Menu_Entry := @@ -836,7 +888,8 @@ package body Elab.Debugger is end case; -- Default state. Exec_State := Exec_Run; - + when Reason_Time => + Exec_State := Exec_Run; end case; case Reason is @@ -921,7 +974,7 @@ package body Elab.Debugger is procedure Debug_Init (Top : Node) is begin - Flag_Enabled := True; + Flag_Debug_Enable := True; Current_Instance := null; Current_Loc := Top; @@ -937,7 +990,7 @@ package body Elab.Debugger is begin Current_Instance := Top; Current_Loc := Get_Source_Scope (Top); - Flag_Enabled := True; + Flag_Debug_Enable := True; -- To avoid warnings. Exec_Statement := Null_Node; @@ -954,6 +1007,14 @@ package body Elab.Debugger is Debug (Reason_Break); end Debug_Break; + procedure Debug_Time is + begin + Current_Instance := Root_Instance; + Current_Loc := Null_Node; + + Debug (Reason_Time); + end Debug_Time; + procedure Debug_Leave (Inst : Synth_Instance_Acc) is begin if Exec_Instance = Inst then @@ -975,38 +1036,11 @@ package body Elab.Debugger is procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node) is begin - if Flag_Enabled then + if Flag_Debug_Enable then Current_Instance := Inst; Current_Loc := Expr; Debug (Reason_Error); end if; end Debug_Error; - procedure Disp_A_Frame (Inst: Synth_Instance_Acc) is - begin - if Inst = Root_Instance then - Put_Line ("root instance"); - return; - end if; - - Put (Vhdl.Errors.Disp_Node (Get_Source_Scope (Inst))); --- if Inst.Stmt /= Null_Iir then --- Put (" at "); --- Put (Files_Map.Image (Get_Location (Inst.Stmt))); --- end if; - New_Line; - end Disp_A_Frame; - - procedure Debug_Bt (Instance : Synth_Instance_Acc) - is - Inst : Synth_Instance_Acc; - begin - Inst := Instance; - while Inst /= null loop - Disp_A_Frame (Inst); - Inst := Get_Caller_Instance (Inst); - end loop; - end Debug_Bt; - pragma Unreferenced (Debug_Bt); - end Elab.Debugger; diff --git a/src/synth/elab-debugger.ads b/src/synth/elab-debugger.ads index 3376e3ba3..cc456dfc1 100644 --- a/src/synth/elab-debugger.ads +++ b/src/synth/elab-debugger.ads @@ -23,6 +23,9 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Elab.Vhdl_Context; use Elab.Vhdl_Context; package Elab.Debugger is + -- True to start debugger on error. + Flag_Debug_Enable : Boolean := False; + -- If true, debugging is enabled: -- * call Debug_Break() before executing the next sequential statement -- * call Debug_Leave when a frame is destroyed. @@ -37,10 +40,15 @@ package Elab.Debugger is procedure Debug_Leave (Inst : Synth_Instance_Acc); + -- Debug on a time breakpoint. + procedure Debug_Time; + -- To be called in case of execution error, like: -- * index out of bounds. procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node); + function Debug_Current_Instance return Synth_Instance_Acc; + type Menu_Procedure is access procedure (Line : String); type Cst_String_Acc is access constant String; @@ -54,11 +62,19 @@ package Elab.Debugger is Help : Cst_String_Acc; Proc : Menu_Procedure); + -- Prepare resume execution. + procedure Prepare_Continue; -- Utilities for menu commands. -- Return the position of the first non-blank character. function Skip_Blanks (S : String) return Positive; + function Skip_Blanks (S : String; F : Positive) return Positive; + + -- Return the position of the last character of the word (the last + -- non-blank character). + function Get_Word (S : String) return Positive; + function Get_Word (S : String; F : Positive) return Positive; -- Convert STR to number RES, set VALID to true iff the conversion is ok. procedure To_Num (Str : String; Res : out Uns32; Valid : out Boolean); diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb index c14a82964..95b9ddf29 100644 --- a/src/synth/elab-vhdl_context.adb +++ b/src/synth/elab-vhdl_context.adb @@ -25,7 +25,7 @@ with Vhdl.Utils; package body Elab.Vhdl_Context is - Sig_Nbr : Signal_Index_Type := 0; + Sig_Nbr : Signal_Index_Type := No_Signal_Index; function Get_Nbr_Signal return Signal_Index_Type is begin @@ -63,7 +63,6 @@ package body Elab.Vhdl_Context is Foreign => 0, Extra_Units => null, Extra_Link => null, - Cur_Stmt => Null_Node, Elab_Objects => 0, Objects => (others => (Kind => Obj_None))); Inst_Tables.Append (Root_Instance); @@ -112,7 +111,6 @@ package body Elab.Vhdl_Context is Foreign => 0, Extra_Units => null, Extra_Link => null, - Cur_Stmt => Null_Node, Elab_Objects => 0, Objects => (others => (Kind => Obj_None))); @@ -154,7 +152,6 @@ package body Elab.Vhdl_Context is Foreign => 0, Extra_Units => null, Extra_Link => null, - Cur_Stmt => Null_Node, Elab_Objects => 0, Objects => (others => (Kind => Obj_None))); @@ -308,8 +305,8 @@ package body Elab.Vhdl_Context is Vt : Valtyp; begin Create_Object (Syn_Inst, Info.Slot, 1); - Vt := (Typ, Create_Value_Signal (Sig_Nbr, Init)); Sig_Nbr := Sig_Nbr + 1; + Vt := (Typ, Create_Value_Signal (Sig_Nbr, Init)); Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt); end Create_Signal; @@ -461,24 +458,64 @@ package body Elab.Vhdl_Context is Syn_Inst.Uninst_Scope := Get_Info (Bod); end Set_Uninstantiated_Scope; - procedure Destroy_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node) + procedure Destroy_Init (D : out Destroy_Type; + Syn_Inst : Synth_Instance_Acc) is + begin + D := (Inst => Syn_Inst, + First => Object_Slot_Type'Last, + Last => Syn_Inst.Elab_Objects); + end Destroy_Init; + + procedure Destroy_Object (D : in out Destroy_Type; Decl : Node) is Info : constant Sim_Info_Acc := Get_Info (Decl); Slot : constant Object_Slot_Type := Info.Slot; begin - if Slot /= Syn_Inst.Elab_Objects - or else Info.Obj_Scope /= Syn_Inst.Block_Scope - then - Error_Msg_Elab ("synth: bad destroy order"); + if Info.Obj_Scope /= D.Inst.Block_Scope then + -- Bad context. + raise Internal_Error; + end if; + if Slot > D.Last then + -- Not elaborated object ? + raise Internal_Error; end if; - Syn_Inst.Objects (Slot) := (Kind => Obj_None); - Syn_Inst.Elab_Objects := Slot - 1; + if D.Inst.Objects (Slot).Kind = Obj_None then + -- Already destroyed. + raise Internal_Error; + end if; + if Slot < D.First then + D.First := Slot; + end if; + D.Inst.Objects (Slot) := (Kind => Obj_None); end Destroy_Object; + procedure Destroy_Finish (D : in out Destroy_Type) is + begin + if D.First = Object_Slot_Type'Last then + -- No object destroyed. + return; + end if; + + if D.Last /= D.Inst.Elab_Objects then + -- Two destroys at the same time. + raise Internal_Error; + end if; + + -- Check all objects have been destroyed. + for I in D.First .. D.Last loop + if D.Inst.Objects (I).Kind /= Obj_None then + raise Internal_Error; + end if; + end loop; + + D.Inst.Elab_Objects := D.First - 1; + end Destroy_Finish; + function Get_Instance_By_Scope (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) - return Synth_Instance_Acc is + return Synth_Instance_Acc + is + pragma Assert (Scope /= null); begin case Scope.Kind is when Kind_Block @@ -489,7 +526,9 @@ package body Elab.Vhdl_Context is begin Current := Syn_Inst; while Current /= null loop - if Current.Block_Scope = Scope then + if Current.Block_Scope = Scope + or else Current.Uninst_Scope = Scope + then return Current; end if; Current := Current.Up_Block; @@ -563,15 +602,4 @@ package body Elab.Vhdl_Context is begin return Syn_Inst.Caller; end Get_Caller_Instance; - - function Get_Current_Stmt (Inst : Synth_Instance_Acc) return Node is - begin - return Inst.Cur_Stmt; - end Get_Current_Stmt; - - procedure Set_Current_Stmt (Inst : Synth_Instance_Acc; Stmt : Node) is - begin - Inst.Cur_Stmt := Stmt; - end Set_Current_Stmt; - end Elab.Vhdl_Context; diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads index 6227b138d..0bf2a4b50 100644 --- a/src/synth/elab-vhdl_context.ads +++ b/src/synth/elab-vhdl_context.ads @@ -98,10 +98,6 @@ package Elab.Vhdl_Context is function Get_Next_Extra_Instance (Inst : Synth_Instance_Acc) return Synth_Instance_Acc; - -- Current statement (for execution). - function Get_Current_Stmt (Inst : Synth_Instance_Acc) return Node; - procedure Set_Current_Stmt (Inst : Synth_Instance_Acc; Stmt : Node); - procedure Create_Object (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); @@ -149,8 +145,11 @@ package Elab.Vhdl_Context is procedure Mutate_Object (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); - procedure Destroy_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node); + type Destroy_Type is limited private; + procedure Destroy_Init (D : out Destroy_Type; + Syn_Inst : Synth_Instance_Acc); + procedure Destroy_Object (D : in out Destroy_Type; Decl : Node); + procedure Destroy_Finish (D : in out Destroy_Type); -- Get the value of OBJ. function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node) @@ -180,6 +179,12 @@ package Elab.Vhdl_Context is function Get_Caller_Instance (Syn_Inst : Synth_Instance_Acc) return Synth_Instance_Acc; private + type Destroy_Type is record + Inst : Synth_Instance_Acc; + First : Object_Slot_Type; + Last : Object_Slot_Type; + end record; + type Obj_Kind is ( Obj_None, @@ -241,9 +246,6 @@ private Extra_Units : Synth_Instance_Acc; Extra_Link : Synth_Instance_Acc; - -- For processes and subprograms. - Cur_Stmt : Node; - -- Last elaborated object. Detect elaboration issues. Elab_Objects : Object_Slot_Type; diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index 79153d4cd..68ba51bf5 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -15,19 +15,33 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. -with Types; use Types; with Name_Table; use Name_Table; with Simple_IO; use Simple_IO; with Utils_IO; use Utils_IO; +with Files_Map; +with Areapools; with Libraries; +with Std_Names; +with Errorout; -with Elab.Debugger; +with Elab.Debugger; use Elab.Debugger; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Values; use Elab.Vhdl_Values; with Elab.Vhdl_Values.Debug; use Elab.Vhdl_Values.Debug; +with Synth.Vhdl_Expr; + with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Errors; +with Vhdl.Tokens; +with Vhdl.Scanner; +with Vhdl.Parse; +with Vhdl.Sem_Scopes; +with Vhdl.Sem_Expr; +with Vhdl.Canon; +with Vhdl.Annotations; +with Vhdl.Std_Package; +with Vhdl.Prints; package body Elab.Vhdl_Debug is procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is @@ -116,30 +130,52 @@ package body Elab.Vhdl_Debug is end if; end Disp_Value_Vector; - procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type) + procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node) is Stride : Size_Type; + Len : Uns32; begin - if Dim = Mem.Typ.Abounds.Ndim then + if Mem.Typ.Alast then -- Last dimension - Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abounds.D (Dim)); + Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abound); else Stride := Mem.Typ.Arr_El.Sz; - for I in Dim + 1 .. Mem.Typ.Abounds.Ndim loop - Stride := Stride * Size_Type (Mem.Typ.Abounds.D (I).Len); - end loop; + Len := Mem.Typ.Abound.Len; Put ("("); - for I in 1 .. Mem.Typ.Abounds.D (Dim).Len loop + for I in 1 .. Len loop if I /= 1 then Put (", "); end if; - Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1); + Disp_Value_Array ((Mem.Typ, + Mem.Mem + Size_Type (Len - I) * Stride), + A_Type); end loop; Put (")"); end if; end Disp_Value_Array; + procedure Disp_Value_Record (M : Memtyp; Vtype: Node) + is + El_List : Iir_Flist; + El : Node; + begin + Put ("("); + El_List := Get_Elements_Declaration_List (Vtype); + for I in M.Typ.Rec.E'Range loop + El := Get_Nth_Element (El_List, Natural (I - 1)); + if I /= 1 then + Put (", "); + end if; + Put (Image (Get_Identifier (El))); + Put (": "); + Disp_Memtyp ((M.Typ.Rec.E (I).Typ, + M.Mem + M.Typ.Rec.E (I).Offs.Mem_Off), + Get_Type (El)); + end loop; + Put (")"); + end Disp_Value_Record; + procedure Disp_Memtyp (M : Memtyp; Vtype : Node) is begin if M.Mem = null then @@ -153,9 +189,9 @@ package body Elab.Vhdl_Debug is | Type_Logic => Disp_Discrete_Value (Read_Discrete (M), Get_Base_Type (Vtype)); when Type_Vector => - Disp_Value_Vector (M, Vtype, M.Typ.Vbound); + Disp_Value_Vector (M, Vtype, M.Typ.Abound); when Type_Array => - Disp_Value_Array (M, Vtype, 1); + Disp_Value_Array (M, Vtype); when Type_Float => Put ("*float*"); when Type_Slice => @@ -163,7 +199,7 @@ package body Elab.Vhdl_Debug is when Type_File => Put ("*file*"); when Type_Record => - Put ("*record*"); + Disp_Value_Record (M, Vtype); when Type_Access => Put ("*access*"); when Type_Protected => @@ -190,7 +226,7 @@ package body Elab.Vhdl_Debug is when Value_Signal => Put ("signal"); Put (' '); - Put_Uns32 (Vt.Val.S); + Put_Uns32 (Uns32 (Vt.Val.S)); when Value_File => Put ("file"); when Value_Const => @@ -199,6 +235,8 @@ package body Elab.Vhdl_Debug is when Value_Alias => Put ("alias"); Disp_Memtyp (Get_Memtyp (Vt), Vtype); + when Value_Dyn_Alias => + Put ("dyn alias"); when Value_Memory => Disp_Memtyp (Get_Memtyp (Vt), Vtype); end case; @@ -237,7 +275,7 @@ package body Elab.Vhdl_Debug is Put ("float"); when Type_Vector => Put ("vector ("); - Disp_Bound_Type (Typ.Vbound); + Disp_Bound_Type (Typ.Abound); Put (')'); when Type_Unbounded_Vector => Put ("unbounded_vector"); @@ -301,6 +339,15 @@ package body Elab.Vhdl_Debug is | Iir_Kind_Procedure_Body | Iir_Kind_Component_Declaration => null; + when Iir_Kind_Suspend_State_Declaration => + declare + Val : constant Valtyp := Get_Value (Instance, Decl); + begin + Put_Indent (Indent); + Put ("STATE: "); + Put_Int32 (Int32 (Read_I32 (Val.Val.Mem))); + New_Line; + end; when others => Vhdl.Errors.Error_Kind ("disp_declaration_object", Decl); end case; @@ -1000,4 +1047,284 @@ package body Elab.Vhdl_Debug is end; end if; end Disp_Instance_Path; + + type Handle_Scope_Type is access procedure (N : Iir); + + procedure Foreach_Scopes (N : Iir; Handler : Handle_Scope_Type) is + begin + case Get_Kind (N) is + when Iir_Kind_Process_Statement + | Iir_Kind_Sensitized_Process_Statement => + Foreach_Scopes (Get_Parent (N), Handler); + Handler.all (N); + when Iir_Kind_Architecture_Body => + Foreach_Scopes (Get_Entity (N), Handler); + Handler.all (N); + + when Iir_Kind_Entity_Declaration => + -- Top of scopes. + Handler.all (N); + + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + Foreach_Scopes (Get_Parent (N), Handler); + Handler.all (N); + when Iir_Kind_Package_Body => + Handler.all (N); + + when Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Simple_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Case_Statement => + Foreach_Scopes (Get_Parent (N), Handler); + + when Iir_Kind_For_Loop_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body => + Foreach_Scopes (Get_Parent (N), Handler); + Handler.all (N); + + when others => + Vhdl.Errors.Error_Kind ("foreach_scopes", N); + end case; + end Foreach_Scopes; + + procedure Add_Decls_For (N : Iir) + is + use Vhdl.Sem_Scopes; + begin + case Get_Kind (N) is + when Iir_Kind_Entity_Declaration => + declare + Unit : constant Iir := Get_Design_Unit (N); + begin + Add_Context_Clauses (Unit); + -- Add_Name (Unit, Get_Identifier (N), False); + Add_Entity_Declarations (N); + end; + when Iir_Kind_Architecture_Body => + Open_Declarative_Region; + Add_Context_Clauses (Get_Design_Unit (N)); + Add_Declarations (Get_Declaration_Chain (N), False); + Add_Declarations_Of_Concurrent_Statement (N); + when Iir_Kind_Package_Body => + declare + Package_Decl : constant Iir := Get_Package (N); + Package_Unit : constant Iir := Get_Design_Unit (Package_Decl); + begin + Add_Name (Package_Unit); + Add_Context_Clauses (Package_Unit); + Open_Declarative_Region; + Add_Declarations (Get_Declaration_Chain (Package_Decl), False); + Add_Declarations (Get_Declaration_Chain (N), False); + end; + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + declare + Spec : constant Iir := Get_Subprogram_Specification (N); + begin + Open_Declarative_Region; + Add_Declarations + (Get_Interface_Declaration_Chain (Spec), False); + Add_Declarations + (Get_Declaration_Chain (N), False); + end; + when Iir_Kind_Process_Statement + | Iir_Kind_Sensitized_Process_Statement => + Open_Declarative_Region; + Add_Declarations (Get_Declaration_Chain (N), False); + when Iir_Kind_For_Loop_Statement + | Iir_Kind_For_Generate_Statement => + Open_Declarative_Region; + Add_Name (Get_Parameter_Specification (N)); + when Iir_Kind_Block_Statement => + declare + Header : constant Iir := Get_Block_Header (N); + begin + Open_Declarative_Region; + if Header /= Null_Iir then + Add_Declarations (Get_Generic_Chain (Header), False); + Add_Declarations (Get_Port_Chain (Header), False); + end if; + Add_Declarations (Get_Declaration_Chain (N), False); + Add_Declarations_Of_Concurrent_Statement (N); + end; + when Iir_Kind_Generate_Statement_Body => + Open_Declarative_Region; + Add_Declarations (Get_Declaration_Chain (N), False); + Add_Declarations_Of_Concurrent_Statement (N); + when others => + Vhdl.Errors.Error_Kind ("enter_scope(2)", N); + end case; + end Add_Decls_For; + + procedure Enter_Scope (Node : Iir) + is + use Vhdl.Sem_Scopes; + begin + Push_Interpretations; + Open_Declarative_Region; + + -- Add STD + Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False); + Use_All_Names (Vhdl.Std_Package.Standard_Package); + + Foreach_Scopes (Node, Add_Decls_For'Access); + end Enter_Scope; + + procedure Del_Decls_For (N : Iir) + is + use Vhdl.Sem_Scopes; + begin + case Get_Kind (N) is + when Iir_Kind_Entity_Declaration => + null; + when Iir_Kind_Architecture_Body => + Close_Declarative_Region; + when Iir_Kind_Process_Statement + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Package_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body + | Iir_Kind_For_Loop_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body => + Close_Declarative_Region; + when others => + Vhdl.Errors.Error_Kind ("Decl_Decls_For", N); + end case; + end Del_Decls_For; + + procedure Leave_Scope (Node : Iir) + is + use Vhdl.Sem_Scopes; + begin + Foreach_Scopes (Node, Del_Decls_For'Access); + + Close_Declarative_Region; + Pop_Interpretations; + end Leave_Scope; + + Buffer_Index : Natural := 1; + + procedure Print_Proc (Line : String) + is + use Vhdl.Tokens; + use Areapools; + use Errorout; + Cur_Inst : constant Synth_Instance_Acc := Debug_Current_Instance; + Prev_Nbr_Errors : constant Natural := Nbr_Errors; + Index_Str : String := Natural'Image (Buffer_Index); + File : Source_File_Entry; + Expr : Iir; + Res : Valtyp; + P : Natural; + Opt_Value : Boolean := False; + Opt_Name : Boolean := False; + Marker : Mark_Type; + Cur_Scope : Node; + begin + -- Decode options: /v + P := Line'First; + loop + P := Skip_Blanks (Line (P .. Line'Last)); + if P + 2 < Line'Last and then Line (P .. P + 1) = "/v" then + Opt_Value := True; + P := P + 2; + elsif P + 2 < Line'Last and then Line (P .. P + 1) = "/n" then + Opt_Name := True; + P := P + 2; + else + exit; + end if; + end loop; + + pragma Unreferenced (Opt_Value); + + Buffer_Index := Buffer_Index + 1; + Index_Str (Index_Str'First) := '*'; + File := Files_Map.Create_Source_File_From_String + (Name_Table.Get_Identifier ("*debug" & Index_Str & '*'), + Line (P .. Line'Last)); + Vhdl.Scanner.Set_File (File); + Vhdl.Scanner.Scan; + Expr := Vhdl.Parse.Parse_Expression; + if Vhdl.Scanner.Current_Token /= Tok_Eof then + Put_Line ("garbage at end of expression ignored"); + end if; + Vhdl.Scanner.Close_File; + if Nbr_Errors /= Prev_Nbr_Errors then + Put_Line ("error while parsing expression, evaluation aborted"); + Nbr_Errors := Prev_Nbr_Errors; + return; + end if; + + Cur_Scope := Elab.Vhdl_Context.Get_Source_Scope (Cur_Inst); + Enter_Scope (Cur_Scope); + Expr := Vhdl.Sem_Expr.Sem_Expression_Universal (Expr); + Leave_Scope (Cur_Scope); + + if Expr = Null_Iir + or else Nbr_Errors /= Prev_Nbr_Errors + then + Put_Line ("error while analyzing expression, evaluation aborted"); + Nbr_Errors := Prev_Nbr_Errors; + return; + end if; + + Vhdl.Prints.Disp_Expression (Expr); + New_Line; + + Vhdl.Annotations.Annotate_Expand_Table; + Vhdl.Canon.Canon_Expression (Expr); + + Mark (Marker, Expr_Pool); + + if Opt_Name then + case Get_Kind (Expr) is + when Iir_Kind_Simple_Name => + null; + when others => + Put_Line ("expression is not a name"); + Opt_Name := False; + end case; + end if; + if Opt_Name then + -- Res := Execute_Name (Dbg_Cur_Frame, Expr, True); + raise Internal_Error; + else + Res := Synth.Vhdl_Expr.Synth_Expression (Cur_Inst, Expr); + end if; + if Res.Val.Kind = Value_Memory then + Disp_Memtyp (Get_Memtyp (Res), Get_Type (Expr)); + else + Elab.Vhdl_Values.Debug.Debug_Valtyp (Res); + end if; + New_Line; + + -- Free value + Release (Marker, Expr_Pool); + end Print_Proc; + + procedure Append_Commands is + begin + Append_Menu_Command + (Name => new String'("p*rint"), + Help => new String'("execute expression"), + Proc => Print_Proc'Access); + end Append_Commands; + end Elab.Vhdl_Debug; diff --git a/src/synth/elab-vhdl_debug.ads b/src/synth/elab-vhdl_debug.ads index 3510af71a..0690c9c2e 100644 --- a/src/synth/elab-vhdl_debug.ads +++ b/src/synth/elab-vhdl_debug.ads @@ -15,6 +15,8 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Types; use Types; + with Vhdl.Nodes; use Vhdl.Nodes; with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk; @@ -25,6 +27,8 @@ package Elab.Vhdl_Debug is procedure Disp_Memtyp (M : Memtyp; Vtype : Node); function Walk_Declarations (Cb : Walk_Cb) return Walk_Status; + procedure Disp_Discrete_Value (Val : Int64; Btype : Node); + procedure Disp_Declaration_Objects (Instance : Synth_Instance_Acc; Decl_Chain : Iir; Indent : Natural := 0); @@ -43,4 +47,6 @@ package Elab.Vhdl_Debug is -- If COMPONENTS is true, also display components procedure Disp_Instance_Path (Inst : Synth_Instance_Acc; Components : Boolean := False); + + procedure Append_Commands; end Elab.Vhdl_Debug; diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb index 87c5dbd50..caaac05c4 100644 --- a/src/synth/elab-vhdl_decls.adb +++ b/src/synth/elab-vhdl_decls.adb @@ -32,6 +32,7 @@ package body Elab.Vhdl_Decls is (Syn_Inst : Synth_Instance_Acc; Subprg : Node) is Inter : Node; + Typ : Type_Acc; begin if Is_Second_Subprogram_Specification (Subprg) then -- Already handled. @@ -40,9 +41,10 @@ package body Elab.Vhdl_Decls is Inter := Get_Interface_Declaration_Chain (Subprg); while Inter /= Null_Node loop - Elab_Declaration_Type (Syn_Inst, Inter); + Typ := Elab_Declaration_Type (Syn_Inst, Inter); Inter := Get_Chain (Inter); end loop; + pragma Unreferenced (Typ); end Elab_Subprogram_Declaration; procedure Elab_Constant_Declaration (Syn_Inst : Synth_Instance_Acc; @@ -55,7 +57,7 @@ package body Elab.Vhdl_Decls is Val : Valtyp; Obj_Type : Type_Acc; begin - Elab_Declaration_Type (Syn_Inst, Decl); + Obj_Type := Elab_Declaration_Type (Syn_Inst, Decl); if Deferred_Decl = Null_Node or else Get_Deferred_Declaration_Flag (Decl) then @@ -89,7 +91,6 @@ package body Elab.Vhdl_Decls is end if; Last_Type := Decl_Type; end if; - Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type); Val := Exec_Expression_With_Type (Syn_Inst, Get_Default_Value (Decl), Obj_Type); if Val = No_Valtyp then @@ -107,8 +108,7 @@ package body Elab.Vhdl_Decls is Init : Valtyp; Obj_Typ : Type_Acc; begin - Elab_Declaration_Type (Syn_Inst, Decl); - Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl); if Is_Valid (Def) then Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ); @@ -128,12 +128,11 @@ package body Elab.Vhdl_Decls is Init : Valtyp; Obj_Typ : Type_Acc; begin - Elab_Declaration_Type (Syn_Inst, Decl); + Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl); if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then Error_Msg_Elab (+Decl, "protected type not supported"); return; end if; - Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type); if Is_Valid (Def) then Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ); @@ -262,7 +261,12 @@ package body Elab.Vhdl_Decls is (Syn_Inst, Get_Type_Definition (Decl), Get_Subtype_Definition (Decl)); when Iir_Kind_Subtype_Declaration => - Elab_Declaration_Type (Syn_Inst, Decl); + declare + T : Type_Acc; + begin + T := Elab_Declaration_Type (Syn_Inst, Decl); + pragma Unreferenced (T); + end; when Iir_Kind_Component_Declaration => null; when Iir_Kind_File_Declaration => @@ -281,6 +285,13 @@ package body Elab.Vhdl_Decls is when Iir_Kind_Signal_Attribute_Declaration => -- Not supported by synthesis. null; + when Iir_Kind_Suspend_State_Declaration => + declare + Val : Valtyp; + begin + Val := Create_Value_Memory (Create_Memory_U32 (0)); + Create_Object (Syn_Inst, Decl, Val); + end; when others => Vhdl.Errors.Error_Kind ("elab_declaration", Decl); end case; diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb index a920d2a8f..3693f3249 100644 --- a/src/synth/elab-vhdl_expr.adb +++ b/src/synth/elab-vhdl_expr.adb @@ -25,7 +25,6 @@ with Errorout; use Errorout; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; -with Vhdl.Annotations; use Vhdl.Annotations; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; @@ -37,42 +36,12 @@ with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; with Synth.Vhdl_Aggr; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +with Synth.Vhdl_Eval; use Synth.Vhdl_Eval; with Grt.Types; with Grt.To_Strings; package body Elab.Vhdl_Expr is - function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; - Atype : Node; - Dim : Dim_Type) return Bound_Type - is - Info : constant Sim_Info_Acc := Get_Info (Atype); - begin - if Info = null then - pragma Assert (Get_Type_Declarator (Atype) = Null_Node); - declare - Index_Type : constant Node := - Get_Index_Type (Atype, Natural (Dim - 1)); - begin - return Synth_Bounds_From_Range (Syn_Inst, Index_Type); - end; - else - declare - Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); - begin - case Bnds.Kind is - when Type_Vector => - pragma Assert (Dim = 1); - return Bnds.Vbound; - when Type_Array => - return Bnds.Abounds.D (Dim); - when others => - raise Internal_Error; - end case; - end; - end if; - end Synth_Array_Bounds; - function Synth_Bounds_From_Length (Atype : Node; Len : Int32) return Bound_Type is @@ -94,8 +63,8 @@ package body Elab.Vhdl_Expr is end case; end Synth_Bounds_From_Length; - function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node) return Valtyp + function Exec_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node) return Valtyp is Aggr_Type : constant Node := Get_Type (Aggr); pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1); @@ -104,7 +73,6 @@ package body Elab.Vhdl_Expr is Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); Last : constant Natural := Flist_Last (Els); Bnd : Bound_Type; - Bnds : Bound_Array_Acc; Res_Type : Type_Acc; Val : Valtyp; Res : Valtyp; @@ -116,9 +84,7 @@ package body Elab.Vhdl_Expr is if El_Typ.Kind in Type_Nets then Res_Type := Create_Vector_Type (Bnd, El_Typ); else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res_Type := Create_Array_Type (Bnds, El_Typ); + Res_Type := Create_Array_Type (Bnd, True, El_Typ); end if; Res := Create_Value_Memory (Res_Type); @@ -132,7 +98,7 @@ package body Elab.Vhdl_Expr is end loop; return Res; - end Synth_Simple_Aggregate; + end Exec_Simple_Aggregate; -- Change the bounds of VAL. function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is @@ -221,18 +187,28 @@ package body Elab.Vhdl_Expr is when Type_Array => pragma Assert (Vtype.Kind = Type_Array); -- Check bounds. - for I in Vtype.Abounds.D'Range loop - if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then - Error_Msg_Elab (+Loc, "mismatching array bounds"); - return No_Valtyp; + declare + Src_Typ, Dst_Typ : Type_Acc; + begin + Src_Typ := Vtype; + Dst_Typ := Dtype; + loop + pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); + if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then + Error_Msg_Elab (+Loc, "mismatching array bounds"); + return No_Valtyp; + end if; + exit when Src_Typ.Alast; + Src_Typ := Src_Typ.Arr_El; + Dst_Typ := Dst_Typ.Arr_El; + end loop; + -- TODO: check element. + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; end if; - end loop; - -- TODO: check element. - if Bounds then - return Reshape_Value (Vt, Dtype); - else - return Vt; - end if; + end; when Type_Unbounded_Array => pragma Assert (Vtype.Kind = Type_Array); return Vt; @@ -258,8 +234,8 @@ package body Elab.Vhdl_Expr is end case; end Exec_Subtype_Conversion; - function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp + function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp is Param : constant Node := Get_Parameter (Attr); Etype : constant Node := Get_Type (Attr); @@ -297,7 +273,7 @@ package body Elab.Vhdl_Expr is end case; return Create_Value_Discrete (Val, Dtype); end; - end Synth_Value_Attribute; + end Exec_Value_Attribute; function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) return String @@ -348,37 +324,18 @@ package body Elab.Vhdl_Expr is return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); end; when others => - Error_Kind ("execute_image_attribute", Expr_Type); + Error_Kind ("synth_image_attribute_str", Expr_Type); end case; end Synth_Image_Attribute_Str; - function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp - is - Len : constant Natural := Str'Length; - Bnd : Bound_Array_Acc; - Typ : Type_Acc; - Res : Valtyp; - begin - Bnd := Create_Bound_Array (1); - Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len), - Len => Uns32 (Len)); - Typ := Create_Array_Type (Bnd, Styp.Uarr_El); - - Res := Create_Value_Memory (Typ); - for I in Str'Range loop - Write_U8 (Res.Val.Mem + Size_Type (I - Str'First), - Character'Pos (Str (I))); - end loop; - return Res; - end String_To_Valtyp; - - function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp + function Exec_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp is Param : constant Node := Get_Parameter (Attr); Etype : constant Node := Get_Type (Attr); V : Valtyp; Dtype : Type_Acc; + Res : Memtyp; begin -- The parameter is expected to be static. V := Exec_Expression (Syn_Inst, Param); @@ -392,21 +349,24 @@ package body Elab.Vhdl_Expr is end if; Strip_Const (V); - return String_To_Valtyp + Res := String_To_Memtyp (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); - end Synth_Image_Attribute; + return Create_Value_Memtyp (Res); + end Exec_Image_Attribute; - function Synth_Instance_Name_Attribute + function Exec_Instance_Name_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp is Atype : constant Node := Get_Type (Attr); Atyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); Name : constant Path_Instance_Name_Type := Get_Path_Instance_Name_Suffix (Attr); + Res : Memtyp; begin -- Return a truncated name, as the prefix is not completly known. - return String_To_Valtyp (Name.Suffix, Atyp); - end Synth_Instance_Name_Attribute; + Res := String_To_Memtyp (Name.Suffix, Atyp); + return Create_Value_Memtyp (Res); + end Exec_Instance_Name_Attribute; -- Convert index IDX in PFX to an offset. -- SYN_INST and LOC are used in case of error. @@ -448,12 +408,11 @@ package body Elab.Vhdl_Expr is (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc) is begin case Typ.Kind is - when Type_Vector => - El_Typ := Typ.Vec_El; - Bnd := Typ.Vbound; - when Type_Array => + when Type_Array + | Type_Vector => + pragma Assert (Typ.Alast); El_Typ := Typ.Arr_El; - Bnd := Typ.Abounds.D (1); + Bnd := Typ.Abound; when others => raise Internal_Error; end case; @@ -463,27 +422,22 @@ package body Elab.Vhdl_Expr is (Btyp : Type_Acc; Bnd : Bound_Type; El_Typ : Type_Acc) return Type_Acc is Res : Type_Acc; - Bnds : Bound_Array_Acc; begin case Btyp.Kind is when Type_Vector => pragma Assert (El_Typ.Kind in Type_Nets); - Res := Create_Vector_Type (Bnd, Btyp.Vec_El); + Res := Create_Vector_Type (Bnd, Btyp.Arr_El); when Type_Unbounded_Vector => pragma Assert (El_Typ.Kind in Type_Nets); - Res := Create_Vector_Type (Bnd, Btyp.Uvec_El); + Res := Create_Vector_Type (Bnd, Btyp.Uarr_El); when Type_Array => - pragma Assert (Btyp.Abounds.Ndim = 1); + pragma Assert (Btyp.Alast); pragma Assert (Is_Bounded_Type (Btyp.Arr_El)); - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res := Create_Array_Type (Bnds, Btyp.Arr_El); + Res := Create_Array_Type (Bnd, True, Btyp.Arr_El); when Type_Unbounded_Array => - pragma Assert (Btyp.Uarr_Ndim = 1); + pragma Assert (Btyp.Ulast); pragma Assert (Is_Bounded_Type (El_Typ)); - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res := Create_Array_Type (Bnds, El_Typ); + Res := Create_Array_Type (Bnd, True, El_Typ); when others => raise Internal_Error; end case; @@ -519,7 +473,7 @@ package body Elab.Vhdl_Expr is Strip_Const (Idx_Val); - Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); + Bnd := Get_Array_Bound (Pfx_Type); pragma Assert (Is_Static (Idx_Val.Val)); @@ -744,6 +698,13 @@ package body Elab.Vhdl_Expr is Val := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); return Val.Typ; end; + when Iir_Kind_Function_Call => + declare + Val : Valtyp; + begin + Val := Synth.Vhdl_Expr.Synth_Expression (Syn_Inst, Name); + return Val.Typ; + end; when others => Error_Kind ("exec_name_subtype", Name); end case; @@ -803,10 +764,7 @@ package body Elab.Vhdl_Expr is begin Exec_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); - Dest_Off.Net_Off := - Dest_Off.Net_Off + Dest_Typ.Rec.E (Idx + 1).Boff; - Dest_Off.Mem_Off := - Dest_Off.Mem_Off + Dest_Typ.Rec.E (Idx + 1).Moff; + Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs; Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; end; @@ -901,7 +859,7 @@ package body Elab.Vhdl_Expr is return Synth_Subtype_Indication (Syn_Inst, Get_Type (Expr)); when others => - Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr); + Vhdl.Errors.Error_Kind ("exec_type_of_object", Expr); end case; return null; end Exec_Type_Of_Object; @@ -943,7 +901,9 @@ package body Elab.Vhdl_Expr is | Iir_Kind_Array_Subtype_Definition => case Conv_Typ.Kind is when Type_Vector - | Type_Unbounded_Vector => + | Type_Unbounded_Vector + | Type_Array + | Type_Unbounded_Array => return Val; when others => Error_Msg_Elab @@ -994,9 +954,9 @@ package body Elab.Vhdl_Expr is return False; end Error_Ieee_Operator; - function Synth_String_Literal - (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) - return Valtyp + function Exec_String_Literal (Syn_Inst : Synth_Instance_Acc; + Str : Node; + Str_Typ : Type_Acc) return Valtyp is pragma Unreferenced (Syn_Inst); pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); @@ -1005,16 +965,14 @@ package body Elab.Vhdl_Expr is Str_Type : constant Node := Get_Type (Str); El_Type : Type_Acc; Bounds : Bound_Type; - Bnds : Bound_Array_Acc; Res_Type : Type_Acc; Res : Valtyp; Pos : Nat8; begin case Str_Typ.Kind is - when Type_Vector => - Bounds := Str_Typ.Vbound; - when Type_Array => - Bounds := Str_Typ.Abounds.D (1); + when Type_Vector + | Type_Array => + Bounds := Str_Typ.Abound; when Type_Unbounded_Vector | Type_Unbounded_Array => Bounds := Synth_Bounds_From_Length @@ -1027,9 +985,7 @@ package body Elab.Vhdl_Expr is if El_Type.Kind in Type_Nets then Res_Type := Create_Vector_Type (Bounds, El_Type); else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bounds; - Res_Type := Create_Array_Type (Bnds, El_Type); + Res_Type := Create_Array_Type (Bounds, True, El_Type); end if; Res := Create_Value_Memory (Res_Type); @@ -1044,7 +1000,7 @@ package body Elab.Vhdl_Expr is end loop; return Res; - end Synth_String_Literal; + end Exec_String_Literal; -- Return the left bound if the direction of the range is LEFT_DIR. function Synth_Low_High_Type_Attribute @@ -1224,7 +1180,8 @@ package body Elab.Vhdl_Expr is pragma Assert (Is_Static (Val.Val)); Res := Create_Value_Memory (Res_Typ); Copy_Memory - (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Moff, + (Res.Val.Mem, + Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Offs.Mem_Off, Res_Typ.Sz); return Res; end; @@ -1246,7 +1203,7 @@ package body Elab.Vhdl_Expr is return Create_Value_Discrete (Get_Physical_Value (Expr), Expr_Type); when Iir_Kind_String_Literal8 => - return Synth_String_Literal (Syn_Inst, Expr, Expr_Type); + return Exec_String_Literal (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Enumeration_Literal => return Exec_Name (Syn_Inst, Expr); when Iir_Kind_Type_Conversion => @@ -1260,7 +1217,7 @@ package body Elab.Vhdl_Expr is Imp : constant Node := Get_Implementation (Expr); begin case Get_Implicit_Definition (Imp) is - when Iir_Predefined_Pure_Functions + when Iir_Predefined_Operators | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators => return Synth_Operator_Function_Call (Syn_Inst, Expr); when Iir_Predefined_None => @@ -1272,7 +1229,7 @@ package body Elab.Vhdl_Expr is when Iir_Kind_Aggregate => return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Simple_Aggregate => - return Synth_Simple_Aggregate (Syn_Inst, Expr); + return Exec_Simple_Aggregate (Syn_Inst, Expr); when Iir_Kind_Parenthesis_Expression => return Exec_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type); @@ -1358,11 +1315,11 @@ package body Elab.Vhdl_Expr is when Iir_Kind_High_Type_Attribute => return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); when Iir_Kind_Value_Attribute => - return Synth_Value_Attribute (Syn_Inst, Expr); + return Exec_Value_Attribute (Syn_Inst, Expr); when Iir_Kind_Image_Attribute => - return Synth_Image_Attribute (Syn_Inst, Expr); + return Exec_Image_Attribute (Syn_Inst, Expr); when Iir_Kind_Instance_Name_Attribute => - return Synth_Instance_Name_Attribute (Syn_Inst, Expr); + return Exec_Instance_Name_Attribute (Syn_Inst, Expr); when Iir_Kind_Null_Literal => return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads index 723f5bf91..6427a5de7 100644 --- a/src/synth/elab-vhdl_expr.ads +++ b/src/synth/elab-vhdl_expr.ads @@ -75,4 +75,18 @@ package Elab.Vhdl_Expr is Loc : Node) return Valtyp; + function Exec_String_Literal (Syn_Inst : Synth_Instance_Acc; + Str : Node; + Str_Typ : Type_Acc) return Valtyp; + + function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp; + function Exec_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp; + function Exec_Instance_Name_Attribute + (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp; + + function Exec_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node) return Valtyp; + end Elab.Vhdl_Expr; diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index e84c00d42..c2a8dc35f 100644 --- a/src/synth/elab-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -56,13 +56,13 @@ package body Elab.Vhdl_Files is procedure Convert_String (Val : Valtyp; Res : out String) is Vtyp : constant Type_Acc := Val.Typ; - Vlen : constant Uns32 := Vtyp.Abounds.D (1).Len; + Vlen : constant Uns32 := Vtyp.Abound.Len; begin pragma Assert (Vtyp.Kind = Type_Array); pragma Assert (Vtyp.Arr_El.Kind = Type_Discrete); pragma Assert (Vtyp.Arr_El.W in 7 .. 8); -- Could be 7 in vhdl87 - pragma Assert (Vtyp.Abounds.Ndim = 1); - pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); + pragma Assert (Vtyp.Alast); + pragma Assert (Vtyp.Abound.Len = Res'Length); for I in 1 .. Vlen loop Res (Res'First + Natural (I - 1)) := @@ -79,7 +79,7 @@ package body Elab.Vhdl_Files is Name : constant Valtyp := Strip_Alias_Const (Val); pragma Unreferenced (Val); begin - Len := Natural (Name.Typ.Abounds.D (1).Len); + Len := Natural (Name.Typ.Abound.Len); if Len >= Res'Length - 1 then Status := Op_Filename_Error; @@ -395,6 +395,20 @@ package body Elab.Vhdl_Files is end if; end Synth_File_Close; + procedure Synth_File_Flush + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) + is + Inters : constant Node := Get_Interface_Declaration_Chain (Imp); + F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; + Status : Op_Status; + begin + Ghdl_File_Flush (F, Status); + + if Status /= Op_Ok then + File_Error (Loc, Status); + end if; + end Synth_File_Flush; + -- Declaration: -- procedure untruncated_text_read --!V87 -- (file f : text; str : out string; len : out natural); --!V87 @@ -408,7 +422,7 @@ package body Elab.Vhdl_Files is Str : constant Valtyp := Get_Value (Syn_Inst, Param2); Param3 : constant Node := Get_Chain (Param2); Param_Len : constant Valtyp := Get_Value (Syn_Inst, Param3); - Buf : String (1 .. Natural (Str.Typ.Abounds.D (1).Len)); + Buf : String (1 .. Natural (Str.Typ.Abound.Len)); Len : Std_Integer; Status : Op_Status; begin @@ -447,7 +461,7 @@ package body Elab.Vhdl_Files is Off : Size_Type; begin Off := 0; - for I in 1 .. Get_Array_Flat_Length (Val.Typ) loop + for I in 1 .. Get_Bound_Length (Val.Typ) loop File_Read_Value (File, (El_Typ, Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; end loop; @@ -455,8 +469,8 @@ package body Elab.Vhdl_Files is when Type_Record => for I in Val.Typ.Rec.E'Range loop File_Read_Value - (File, - (Val.Typ.Rec.E (I).Typ, Val.Mem + Val.Typ.Rec.E (I).Moff), + (File, (Val.Typ.Rec.E (I).Typ, + Val.Mem + Val.Typ.Rec.E (I).Offs.Mem_Off), Loc); end loop; when Type_Unbounded_Record @@ -502,17 +516,17 @@ package body Elab.Vhdl_Files is Off : Size_Type; begin Off := 0; - for I in 1 .. Get_Array_Flat_Length (Val.Typ) loop + for I in 1 .. Get_Bound_Length (Val.Typ) loop File_Write_Value (File, (El_Typ, Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; end loop; end; when Type_Record => for I in Val.Typ.Rec.E'Range loop - File_Write_Value - (File, - (Val.Typ.Rec.E (I).Typ, Val.Mem + Val.Typ.Rec.E (I).Moff), - Loc); + File_Write_Value (File, + (Val.Typ.Rec.E (I).Typ, + Val.Mem + Val.Typ.Rec.E (I).Offs.Mem_Off), + Loc); end loop; when Type_Unbounded_Record | Type_Unbounded_Array @@ -542,7 +556,7 @@ package body Elab.Vhdl_Files is Str : Std_String; Bnd : Std_String_Bound; begin - B := Val.Typ.Abounds.D (1); + B := Val.Typ.Abound; Bnd.Dim_1 := (Left => Ghdl_I32 (B.Left), Right => Ghdl_I32 (B.Right), Dir => Dir_To_Dir (B.Dir), diff --git a/src/synth/elab-vhdl_files.ads b/src/synth/elab-vhdl_files.ads index 959add1b0..7d48f6b08 100644 --- a/src/synth/elab-vhdl_files.ads +++ b/src/synth/elab-vhdl_files.ads @@ -40,6 +40,8 @@ package Elab.Vhdl_Files is (Syn_Inst : Synth_Instance_Acc; Imp : Node); procedure Synth_File_Close (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); + procedure Synth_File_Flush + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); procedure Synth_Untruncated_Text_Read (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb index 820e20ff1..a86c94eb1 100644 --- a/src/synth/elab-vhdl_insts.adb +++ b/src/synth/elab-vhdl_insts.adb @@ -71,8 +71,7 @@ package body Elab.Vhdl_Insts is Inter := Get_Association_Interface (Assoc, Assoc_Inter); case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration => - Elab_Declaration_Type (Sub_Inst, Inter); - Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); + Inter_Type := Elab_Declaration_Type (Sub_Inst, Inter); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => @@ -326,7 +325,10 @@ package body Elab.Vhdl_Insts is function Elab_Port_Association_Type (Sub_Inst : Synth_Instance_Acc; Syn_Inst : Synth_Instance_Acc; Inter : Node; - Assoc : Node) return Type_Acc is + Assoc : Node) return Type_Acc + is + Inter_Typ : Type_Acc; + Val : Valtyp; begin if not Is_Fully_Constrained_Type (Get_Type (Inter)) then -- TODO @@ -336,7 +338,18 @@ package body Elab.Vhdl_Insts is if Assoc = Null_Node then raise Internal_Error; end if; - case Get_Kind (Assoc) is + + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression + and then not Get_Inertial_Flag (Assoc) + then + -- For expression: just compute the expression and associate. + Inter_Typ := Elab_Declaration_Type (Sub_Inst, Inter); + Val := Exec_Expression_With_Type + (Syn_Inst, Get_Actual (Assoc), Inter_Typ); + return Val.Typ; + end if; + + case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is when Iir_Kinds_Association_Element_By_Actual => return Exec_Type_Of_Object (Syn_Inst, Get_Actual (Assoc)); when Iir_Kind_Association_Element_By_Individual => @@ -345,12 +358,9 @@ package body Elab.Vhdl_Insts is when Iir_Kind_Association_Element_Open => return Exec_Type_Of_Object (Syn_Inst, Get_Default_Value (Inter)); - when others => - raise Internal_Error; end case; else - Elab_Declaration_Type (Sub_Inst, Inter); - return Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); + return Elab_Declaration_Type (Sub_Inst, Inter); end if; end Elab_Port_Association_Type; @@ -659,8 +669,7 @@ package body Elab.Vhdl_Insts is Inter_Typ := Elab_Port_Association_Type (Comp_Inst, Syn_Inst, Inter, Assoc); - - Create_Signal (Comp_Inst, Assoc_Inter, Inter_Typ, null); + Create_Signal (Comp_Inst, Inter, Inter_Typ, null); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; @@ -789,12 +798,11 @@ package body Elab.Vhdl_Insts is -- Compute generics. Inter := Get_Generic_Chain (Entity); while Is_Valid (Inter) loop - Elab_Declaration_Type (Top_Inst, Inter); declare Val : Valtyp; Inter_Typ : Type_Acc; begin - Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter)); + Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter); Val := Exec_Expression_With_Type (Top_Inst, Get_Default_Value (Inter), Inter_Typ); pragma Assert (Is_Static (Val.Val)); @@ -815,8 +823,7 @@ package body Elab.Vhdl_Insts is declare Inter_Typ : Type_Acc; begin - Elab_Declaration_Type (Top_Inst, Inter); - Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter)); + Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter); Create_Signal (Top_Inst, Inter, Inter_Typ, null); end; Inter := Get_Chain (Inter); diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb index 3715e0532..bea919a4d 100644 --- a/src/synth/elab-vhdl_objtypes.adb +++ b/src/synth/elab-vhdl_objtypes.adb @@ -22,9 +22,6 @@ with System; use System; with Mutils; use Mutils; package body Elab.Vhdl_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); @@ -77,26 +74,24 @@ package body Elab.Vhdl_Objtypes is 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 + when Type_Array + | Type_Vector => + if L.Alast /= R.Alast then + return False; + end if; + if L.Abound /= R.Abound 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_Unbounded_Array + | Type_Unbounded_Vector => + if L.Ulast /= R.Ulast then + return False; + end if; + -- Also check index ? + return Are_Types_Equal (L.Uarr_El, R.Uarr_El); + when Type_Slice => + return Are_Types_Equal (L.Slice_El, R.Slice_El); when Type_Record | Type_Unbounded_Record => if L.Rec.Len /= R.Rec.Len then @@ -117,6 +112,21 @@ package body Elab.Vhdl_Objtypes is end case; end Are_Types_Equal; + function Is_Last_Dimension (Arr : Type_Acc) return Boolean is + begin + case Arr.Kind is + when Type_Vector + | Type_Array => + return Arr.Alast; + when Type_Unbounded_Vector => + return True; + when Type_Unbounded_Array => + return Arr.Ulast; + when others => + raise Internal_Error; + end case; + end Is_Last_Dimension; + function Is_Null_Range (Rng : Discrete_Range_Type) return Boolean is begin case Rng.Dir is @@ -219,7 +229,11 @@ package body Elab.Vhdl_Objtypes is 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, + Wkind => Wkind_Net, + Drange => (Left => 0, + Right => 1, + Dir => Dir_To, + Is_Signed => False), Al => 0, Sz => 1, W => 1))); @@ -231,7 +245,11 @@ package body Elab.Vhdl_Objtypes is 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, + Wkind => Wkind_Net, + Drange => (Left => 0, + Right => 8, + Dir => Dir_To, + Is_Signed => False), Al => 0, Sz => 1, W => 1))); @@ -255,7 +273,7 @@ package body Elab.Vhdl_Objtypes is Al := 3; end if; return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete, - Is_Synth => True, + Wkind => Wkind_Net, Al => Al, Sz => Sz, W => W, @@ -268,7 +286,7 @@ package body Elab.Vhdl_Objtypes is 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, + Wkind => Wkind_Net, Al => 3, Sz => 8, W => 64, @@ -281,14 +299,16 @@ package body Elab.Vhdl_Objtypes is subtype Vector_Type_Type is Type_Type (Type_Vector); function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type); begin + pragma Assert (El_Type.Kind in Type_Nets); return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Vector, - Is_Synth => True, + Wkind => Wkind_Net, Al => El_Type.Al, Sz => El_Type.Sz * Size_Type (Bnd.Len), W => Bnd.Len, - Vbound => Bnd, - Vec_El => El_Type))); + Alast => True, + Abound => Bnd, + Arr_El => El_Type))); end Create_Vector_Type; function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) @@ -299,7 +319,7 @@ package body Elab.Vhdl_Objtypes is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Slice, - Is_Synth => El_Type.Is_Synth, + Wkind => El_Type.Wkind, Al => El_Type.Al, Sz => Size_Type (Len) * El_Type.Sz, W => Len * El_Type.W, @@ -316,127 +336,90 @@ package body Elab.Vhdl_Objtypes is El); end Create_Vec_Type_By_Length; - function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc - is - 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 + function Create_Array_Type + (Bnd : Bound_Type; Last : Boolean; 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, + Wkind => El_Type.Wkind, Al => El_Type.Al, - Sz => El_Type.Sz * Size_Type (L), - W => El_Type.W * L, - Abounds => Bnd, + Sz => El_Type.Sz * Size_Type (Bnd.Len), + W => El_Type.W * Bnd.Len, + Abound => Bnd, + Alast => Last, Arr_El => El_Type))); end Create_Array_Type; function Create_Unbounded_Array - (Ndim : Dim_Type; El_Type : Type_Acc; Idx1 : Type_Acc) return Type_Acc + (Idx : Type_Acc; Last : Boolean; 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, + Wkind => El_Type.Wkind, Al => El_Type.Al, Sz => 0, W => 0, - Uarr_Ndim => Ndim, + Ulast => Last, Uarr_El => El_Type, - Uarr_Idx1 => Idx1))); + Uarr_Idx => Idx))); end Create_Unbounded_Array; - function Create_Unbounded_Vector (El_Type : Type_Acc; Idx1 : Type_Acc) + function Create_Unbounded_Vector (El_Type : Type_Acc; Idx : 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, + Wkind => El_Type.Wkind, Al => El_Type.Al, Sz => 0, W => 0, - Uvec_El => El_Type, - Uvec_Idx1 => Idx1))); + Ulast => True, + Uarr_El => El_Type, + Uarr_Idx => Idx))); 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 => + when Type_Vector + | Type_Array => return Arr_Type.Arr_El; - when Type_Unbounded_Array => + when Type_Unbounded_Array + | Type_Unbounded_Vector => 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 + function Get_Array_Bound (Typ : Type_Acc) 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 Type_Vector + | Type_Array => + return Typ.Abound; when others => raise Internal_Error; end case; end Get_Array_Bound; - function Get_Uarray_First_Index (Typ : Type_Acc) return Type_Acc is + function Get_Uarray_Index (Typ : Type_Acc) return Type_Acc is begin case Typ.Kind is - when Type_Unbounded_Vector => - return Typ.Uvec_Idx1; - when Type_Unbounded_Array => - return Typ.Uarr_Idx1; + when Type_Unbounded_Vector + | Type_Unbounded_Array => + return Typ.Uarr_Idx; when others => raise Internal_Error; end case; - end Get_Uarray_First_Index; + end Get_Uarray_Index; function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32 is @@ -492,13 +475,13 @@ package body Elab.Vhdl_Objtypes is 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; + Wkind : Wkind_Type; W : Uns32; Al : Palign_Type; Sz : Size_Type; begin -- Layout the record. - Is_Synth := True; + Wkind := Wkind_Net; Al := 0; Sz := 0; W := 0; @@ -507,21 +490,23 @@ package body Elab.Vhdl_Objtypes is E : Rec_El_Type renames Els.E (I); begin -- For nets. - E.Boff := W; - Is_Synth := Is_Synth and E.Typ.Is_Synth; + E.Offs.Net_Off := W; + if E.Typ.Wkind /= Wkind_Net then + Wkind := Wkind_Undef; + end if; W := W + E.Typ.W; -- For memory. Al := Palign_Type'Max (Al, E.Typ.Al); Sz := Align (Sz, E.Typ.Al); - E.Moff := Sz; + E.Offs.Mem_Off := 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, + Wkind => Wkind, Al => Al, Sz => Sz, W => W, @@ -535,7 +520,7 @@ package body Elab.Vhdl_Objtypes is new Areapools.Alloc_On_Pool_Addr (Unbounded_Record_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Record, - Is_Synth => True, + Wkind => Wkind_Net, Al => 0, Sz => 0, W => 0, @@ -548,10 +533,10 @@ package body Elab.Vhdl_Objtypes is 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, + Wkind => Wkind_Sim, Al => 2, Sz => 4, - W => 32, + W => 1, Acc_Acc => Acc_Type))); end Create_Access_Type; @@ -561,10 +546,10 @@ package body Elab.Vhdl_Objtypes is 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, + Wkind => Wkind_Sim, Al => 2, Sz => 4, - W => 32, + W => 1, File_Typ => File_Type, File_Signature => null))); end Create_File_Type; @@ -575,29 +560,33 @@ package body Elab.Vhdl_Objtypes is function Alloc is new Areapools.Alloc_On_Pool_Addr (Protected_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Protected, - Is_Synth => False, + Wkind => Wkind_Sim, Al => 2, Sz => 4, - W => 32))); + W => 1))); end Create_Protected_Type; function Vec_Length (Typ : Type_Acc) return Iir_Index32 is begin - return Iir_Index32 (Typ.Vbound.Len); + return Iir_Index32 (Typ.Abound.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); + return Iir_Index32 (Typ.Abound.Len); when Type_Array => declare Len : Uns32; + T : Type_Acc; begin Len := 1; - for I in Typ.Abounds.D'Range loop - Len := Len * Typ.Abounds.D (I).Len; + T := Typ; + loop + Len := Len * T.Abound.Len; + exit when T.Alast; + T := T.Arr_El; end loop; return Iir_Index32 (Len); end; @@ -612,21 +601,14 @@ package body Elab.Vhdl_Objtypes is return Atype.W; end Get_Type_Width; - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32 is + function Get_Bound_Length (T : Type_Acc) return Uns32 is begin case T.Kind is - when Type_Vector => - if Dim /= 1 then - raise Internal_Error; - end if; - return T.Vbound.Len; + when Type_Vector + | Type_Array => + return T.Abound.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; @@ -643,14 +625,16 @@ package body Elab.Vhdl_Objtypes is return True; when Type_Vector | Type_Slice => - return Get_Bound_Length (L, 1) = Get_Bound_Length (R, 1); + return Get_Bound_Length (L) = Get_Bound_Length (R); 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; + pragma Assert (L.Alast = R.Alast); + if Get_Bound_Length (L) /= Get_Bound_Length (R) then + return False; + end if; + if L.Alast then + return True; + end if; + return Get_Bound_Length (L.Arr_El) = Get_Bound_Length (R.Arr_El); when Type_Unbounded_Array | Type_Unbounded_Vector | Type_Unbounded_Record => @@ -712,17 +696,21 @@ package body Elab.Vhdl_Objtypes is end case; end Write_Discrete; - function Alloc_Memory (Vtype : Type_Acc) return Memory_Ptr + function Alloc_Memory (Sz : Size_Type; Align2 : Natural) return Memory_Ptr is function To_Memory_Ptr is new Ada.Unchecked_Conversion (System.Address, Memory_Ptr); M : System.Address; begin - Areapools.Allocate (Current_Pool.all, M, - Vtype.Sz, Size_Type (2 ** Natural (Vtype.Al))); + Areapools.Allocate (Current_Pool.all, M, Sz, Size_Type (2 ** Align2)); return To_Memory_Ptr (M); end Alloc_Memory; + function Alloc_Memory (Vtype : Type_Acc) return Memory_Ptr is + begin + return Alloc_Memory (Vtype.Sz, Natural (Vtype.Al)); + end Alloc_Memory; + function Create_Memory (Vtype : Type_Acc) return Memtyp is begin return (Vtype, Alloc_Memory (Vtype)); @@ -780,6 +768,15 @@ package body Elab.Vhdl_Objtypes is return (Vtype, Res); end Create_Memory_Discrete; + function Create_Memory_U32 (Val : Uns32) return Memtyp + is + Res : Memory_Ptr; + begin + Res := Alloc_Memory (4, 2); + Write_U32 (Res, Ghdl_U32 (Val)); + return (null, Res); + end Create_Memory_U32; + function Is_Equal (L, R : Memtyp) return Boolean is begin if L = R then @@ -807,6 +804,18 @@ package body Elab.Vhdl_Objtypes is end loop; end Copy_Memory; + function Unshare (Src : Memtyp; Pool : Areapool_Acc) return Memtyp + is + Prev_Pool : constant Areapool_Acc := Current_Pool; + Res : Memory_Ptr; + begin + Current_Pool := Pool; + Res := Alloc_Memory (Src.Typ); + Copy_Memory (Res, Src.Mem, Src.Typ.Sz); + Current_Pool := Prev_Pool; + return (Src.Typ, Res); + end Unshare; + function Unshare (Src : Memtyp) return Memtyp is Res : Memory_Ptr; @@ -832,6 +841,7 @@ package body Elab.Vhdl_Objtypes is Boolean_Type := Create_Bit_Type; Logic_Type := Create_Logic_Type; Bit_Type := Create_Bit_Type; + Protected_Type := Create_Protected_Type; Bit0 := (Bit_Type, To_Memory_Ptr (Bit0_Mem'Address)); Bit1 := (Bit_Type, To_Memory_Ptr (Bit1_Mem'Address)); @@ -846,6 +856,7 @@ package body Elab.Vhdl_Objtypes is Boolean_Type := null; Logic_Type := null; Bit_Type := null; + Protected_Type := null; Bit0 := Null_Memtyp; Bit1 := Null_Memtyp; diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads index 476264f37..6ff20d3b4 100644 --- a/src/synth/elab-vhdl_objtypes.ads +++ b/src/synth/elab-vhdl_objtypes.ads @@ -56,13 +56,15 @@ package Elab.Vhdl_Objtypes is Len : Uns32; 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); + -- Offsets for a value. + type Value_Offsets is record + Net_Off : Uns32; + Mem_Off : Size_Type; end record; - type Bound_Array_Acc is access Bound_Array; + No_Value_Offsets : constant Value_Offsets := (0, 0); + + function "+" (L, R : Value_Offsets) return Value_Offsets; type Type_Kind is ( @@ -95,11 +97,8 @@ package Elab.Vhdl_Objtypes is 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; + -- Offset of the element. + Offs : Value_Offsets; -- Type of the element. Typ : Type_Acc; @@ -115,9 +114,24 @@ package Elab.Vhdl_Objtypes is -- Power of 2 alignment. type Palign_Type is range 0 .. 3; + -- What does the width (W) represent in Type_Type. + type Wkind_Type is + ( + -- Not defined. + Wkind_Undef, + + -- Number of net (or number of bits used to represent the type). + -- Valid only if the type can be synthesized. + Wkind_Net, + + -- Number of scalar elements. + -- For simulation or non-synthesizable types. + Wkind_Sim + ); + type Type_Type (Kind : Type_Kind) is record - -- False if the type is not synthesisable: is or contains access/file. - Is_Synth : Boolean; + -- Representation of W. + Wkind : Wkind_Type; -- Alignment (in bytes) for this type. Al : Palign_Type; @@ -134,31 +148,25 @@ package Elab.Vhdl_Objtypes is case Kind is when Type_Bit - | Type_Logic => - null; - when Type_Discrete => + | Type_Logic + | 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; - Uvec_Idx1 : Type_Acc; when Type_Slice => Slice_El : Type_Acc; - when Type_Array => - Abounds : Bound_Array_Acc; + when Type_Array + | Type_Vector => + Abound : Bound_Type; + Alast : Boolean; -- True for the last dimension Arr_El : Type_Acc; - when Type_Unbounded_Array => - Uarr_Ndim : Dim_Type; + when Type_Unbounded_Array + | Type_Unbounded_Vector => Uarr_El : Type_Acc; - -- Type of the first index. The only place we need the index is - -- for concatenation. - Uarr_Idx1 : Type_Acc; + Ulast : Boolean; + Uarr_Idx : Type_Acc; when Type_Record - | Type_Unbounded_Record => + | Type_Unbounded_Record => Rec : Rec_El_Array_Acc; when Type_Access => Acc_Acc : Type_Acc; @@ -177,16 +185,6 @@ package Elab.Vhdl_Objtypes is Null_Memtyp : constant Memtyp := (null, null); - -- Offsets for a value. - type Value_Offsets is record - Net_Off : Uns32; - Mem_Off : Size_Type; - end record; - - No_Value_Offsets : constant Value_Offsets := (0, 0); - - function "+" (L, R : Value_Offsets) return Value_Offsets; - Global_Pool : aliased Areapool; Expr_Pool : aliased Areapool; @@ -207,15 +205,14 @@ package Elab.Vhdl_Objtypes is 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; Idx1 : Type_Acc) + function Create_Unbounded_Vector (El_Type : Type_Acc; Idx : 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_Array_Type + (Bnd : Bound_Type; Last : Boolean; El_Type : Type_Acc) return Type_Acc; function Create_Unbounded_Array - (Ndim : Dim_Type; El_Type : Type_Acc; Idx1 : Type_Acc) return Type_Acc; + (Idx : Type_Acc; Last : Boolean; 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; @@ -230,13 +227,14 @@ package Elab.Vhdl_Objtypes is function In_Bounds (Bnd : Bound_Type; V : Int32) return Boolean; function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean; - -- Return the first index of an unbounded array or vector. - function Get_Uarray_First_Index (Typ : Type_Acc) return Type_Acc; + -- Index type of unbounded array or unbounded vector. + function Get_Uarray_Index (Typ : Type_Acc) return Type_Acc; + + -- Return True iff ARR is the last dimension of a multidimensional array. + function Is_Last_Dimension (Arr : Type_Acc) return Boolean; - -- 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 bounds of a vector/array. + function Get_Array_Bound (Typ : Type_Acc) return Bound_Type; -- Return the length of RNG. function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32; @@ -260,7 +258,8 @@ package Elab.Vhdl_Objtypes is 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 Uns32; +-- function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32; + function Get_Bound_Length (T : Type_Acc) return Uns32; function Is_Matching_Bounds (L, R : Type_Acc) return Boolean; @@ -285,6 +284,9 @@ package Elab.Vhdl_Objtypes is function Create_Memory_Discrete (Val : Int64; Vtype : Type_Acc) return Memtyp; + -- For states. + function Create_Memory_U32 (Val : Uns32) return Memtyp; + function Alloc_Memory (Vtype : Type_Acc) return Memory_Ptr; function Create_Memory (Vtype : Type_Acc) return Memtyp; @@ -297,6 +299,7 @@ package Elab.Vhdl_Objtypes is procedure Copy_Memory (Dest : Memory_Ptr; Src : Memory_Ptr; Sz : Size_Type); function Unshare (Src : Memtyp) return Memtyp; + function Unshare (Src : Memtyp; Pool : Areapool_Acc) return Memtyp; procedure Initialize; procedure Finalize; @@ -305,6 +308,7 @@ package Elab.Vhdl_Objtypes is Boolean_Type : Type_Acc := null; Logic_Type : Type_Acc := null; Bit_Type : Type_Acc := null; + Protected_Type : Type_Acc := null; -- Also set by initialize. Bit0 : Memtyp; diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb index ca38e840b..3844704ee 100644 --- a/src/synth/elab-vhdl_types.adb +++ b/src/synth/elab-vhdl_types.adb @@ -82,10 +82,15 @@ package body Elab.Vhdl_Types is -- TODO: does this cover all the cases ? Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix)); else + -- The expression cannot be fully executed as it can be a signal + -- (whose evaluation is not allowed during elaboration). Typ := Exec_Name_Subtype (Syn_Inst, Prefix_Name); end if; - return Get_Array_Bound (Typ, Dim_Type (Dim)); + for I in 2 .. Dim loop + Typ := Typ.Arr_El; + end loop; + return Get_Array_Bound (Typ); end Synth_Array_Attribute; procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; @@ -217,6 +222,7 @@ package body Elab.Vhdl_Types is function Synth_Array_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc is + El_St : constant Node := Get_Element_Subtype_Indication (Def); El_Type : constant Node := Get_Element_Subtype (Def); Ndims : constant Natural := Get_Nbr_Dimensions (Def); Idx : Node; @@ -224,16 +230,22 @@ package body Elab.Vhdl_Types is Idx_Typ : Type_Acc; Typ : Type_Acc; begin - Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); + if Get_Kind (El_St) in Iir_Kinds_Subtype_Definition then + Synth_Subtype_Indication (Syn_Inst, El_Type); + end if; El_Typ := Get_Subtype_Object (Syn_Inst, El_Type); - Idx := Get_Index_Type (Def, 0); - Idx_Typ := Get_Subtype_Object (Syn_Inst, Idx); - if El_Typ.Kind in Type_Nets and then Ndims = 1 then + Idx := Get_Index_Type (Def, 0); + Idx_Typ := Get_Subtype_Object (Syn_Inst, Idx); Typ := Create_Unbounded_Vector (El_Typ, Idx_Typ); else - Typ := Create_Unbounded_Array (Dim_Type (Ndims), El_Typ, Idx_Typ); + Typ := El_Typ; + for I in reverse 1 .. Ndims loop + Idx := Get_Index_Type (Def, 0); + Idx_Typ := Get_Subtype_Object (Syn_Inst, Idx); + Typ := Create_Unbounded_Array (Idx_Typ, I = Ndims, Typ); + end loop; end if; return Typ; end Synth_Array_Type_Definition; @@ -482,7 +494,6 @@ package body Elab.Vhdl_Types is Get_Subtype_Object (Syn_Inst, Parent_Type); St_El : Node; El_Typ : Type_Acc; - Bnds : Bound_Array_Acc; begin -- VHDL08 if Has_Element_Subtype_Indication (Atype) then @@ -490,7 +501,15 @@ package body Elab.Vhdl_Types is -- element. El_Typ := Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); else - El_Typ := Get_Array_Element (Parent_Typ); + El_Typ := Parent_Typ; + loop + if Is_Last_Dimension (El_Typ) then + El_Typ := Get_Array_Element (El_Typ); + exit; + else + El_Typ := Get_Array_Element (El_Typ); + end if; + end loop; end if; if not Get_Index_Constraint_Flag (Atype) then @@ -519,14 +538,19 @@ package body Elab.Vhdl_Types is when Type_Unbounded_Array => -- FIXME: partially constrained arrays, subtype in indexes... if Get_Index_Constraint_Flag (Atype) then - Bnds := Create_Bound_Array - (Dim_Type (Get_Nbr_Elements (St_Indexes))); - for I in Flist_First .. Flist_Last (St_Indexes) loop - St_El := Get_Index_Type (St_Indexes, I); - Bnds.D (Dim_Type (I + 1)) := - Synth_Bounds_From_Range (Syn_Inst, St_El); - end loop; - return Create_Array_Type (Bnds, El_Typ); + declare + Res_Typ : Type_Acc; + Bnd : Bound_Type; + begin + Res_Typ := El_Typ; + for I in reverse Flist_First .. Flist_Last (St_Indexes) loop + St_El := Get_Index_Type (St_Indexes, I); + Bnd := Synth_Bounds_From_Range (Syn_Inst, St_El); + Res_Typ := Create_Array_Type + (Bnd, Res_Typ = El_Typ, Res_Typ); + end loop; + return Res_Typ; + end; else raise Internal_Error; end if; @@ -622,15 +646,43 @@ package body Elab.Vhdl_Types is end loop; end Get_Declaration_Type; - procedure Elab_Declaration_Type - (Syn_Inst : Synth_Instance_Acc; Decl : Node) + function Elab_Declaration_Type + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc is - Atype : constant Node := Get_Declaration_Type (Decl); + Atype : Node; + Typ : Type_Acc; begin - if Atype = Null_Node then - -- Already elaborated. - return; + Atype := Get_Subtype_Indication (Decl); + if Atype /= Null_Node then + case Get_Kind (Atype) is + when Iir_Kinds_Subtype_Definition => + if not Get_Is_Ref (Decl) then + -- That's a new type. + Typ := Synth_Subtype_Indication (Syn_Inst, Atype); + Create_Subtype_Object (Syn_Inst, Atype, Typ); + return Typ; + end if; + when Iir_Kinds_Denoting_Name => + -- Already elaborated. + Atype := Get_Type (Get_Named_Entity (Atype)); + when Iir_Kind_Subtype_Attribute => + declare + Pfx : constant Node := Get_Prefix (Atype); + Vt : Valtyp; + begin + Vt := Exec_Name (Syn_Inst, Pfx); + return Vt.Typ; + end; + when others => + Error_Kind ("elab_declaration_type", Atype); + end case; + else + Atype := Get_Type (Decl); + end if; + if Get_Kind (Atype) = Iir_Kind_Protected_Type_Declaration then + return Protected_Type; + else + return Get_Subtype_Object (Syn_Inst, Atype); end if; - Synth_Subtype_Indication (Syn_Inst, Atype); end Elab_Declaration_Type; end Elab.Vhdl_Types; diff --git a/src/synth/elab-vhdl_types.ads b/src/synth/elab-vhdl_types.ads index 7f1d2c55e..afab9e494 100644 --- a/src/synth/elab-vhdl_types.ads +++ b/src/synth/elab-vhdl_types.ads @@ -66,6 +66,6 @@ package Elab.Vhdl_Types is return Type_Acc; -- Elaborate the type of DECL. - procedure Elab_Declaration_Type - (Syn_Inst : Synth_Instance_Acc; Decl : Node); + function Elab_Declaration_Type + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc; end Elab.Vhdl_Types; diff --git a/src/synth/elab-vhdl_values-debug.adb b/src/synth/elab-vhdl_values-debug.adb index 193515e27..a7cf2f9a3 100644 --- a/src/synth/elab-vhdl_values-debug.adb +++ b/src/synth/elab-vhdl_values-debug.adb @@ -46,35 +46,72 @@ package body Elab.Vhdl_Values.Debug is end if; end Debug_Bound; + procedure Debug_Typ_Phys (T : Type_Acc) is + begin + Put ("[al="); + Put_Int32 (Int32 (T.Al)); + Put (" sz="); + Put_Uns32 (Uns32 (T.Sz)); + Put (" w="); + Put_Uns32 (T.W); + Put (']'); + end Debug_Typ_Phys; + procedure Debug_Typ1 (T : Type_Acc) is begin case T.Kind is - when Type_Bit - | Type_Logic => + when Type_Bit => + Put ("bit"); + Debug_Typ_Phys (T); + when Type_Logic => Put ("bit/logic"); + Debug_Typ_Phys (T); when Type_Vector => - Put ("vector ("); - Debug_Bound (T.Vbound, True); - Put (") of ["); - Debug_Typ1 (T.Vec_El); - Put ("]"); + Put ("vector "); + Debug_Typ_Phys (T); + Put (" ("); + Debug_Bound (T.Abound, True); + Put (") of "); + Debug_Typ1 (T.Arr_El); when Type_Array => - Put ("arr ("); - for I in 1 .. T.Abounds.Ndim loop - if I > 1 then + Put ("arr "); + Debug_Typ_Phys (T); + Put (" ("); + declare + It : Type_Acc; + begin + It := T; + loop + Debug_Bound (It.Abound, True); + exit when It.Alast; + Put (", "); + It := It.Arr_El; + end loop; + Put (") of "); + Debug_Typ1 (It.Arr_El); + end; + when Type_Record => + Put ("rec "); + Debug_Typ_Phys (T); + Put (" ("); + for I in T.Rec.E'Range loop + if I /= 1 then Put (", "); end if; - Debug_Bound (T.Abounds.D (I), True); + Put ("[noff="); + Put_Uns32 (T.Rec.E (I).Offs.Net_Off); + Put (", moff="); + Put_Uns32 (Uns32 (T.Rec.E (I).Offs.Mem_Off)); + Put ("] "); + Debug_Typ1 (T.Rec.E (I).Typ); end loop; - Put (") of "); - Debug_Typ1 (T.Arr_El); - when Type_Record => - Put ("rec: ("); Put (")"); when Type_Unbounded_Record => Put ("unbounded record"); when Type_Discrete => - Put ("discrete: "); + Put ("discrete "); + Debug_Typ_Phys (T); + Put (": "); Put_Int64 (T.Drange.Left); Put (' '); Put_Dir (T.Drange.Dir); @@ -96,17 +133,23 @@ package body Elab.Vhdl_Values.Debug is when Type_Unbounded_Vector => Put ("unbounded vector"); when Type_Unbounded_Array => - Put ("unbounded array"); + Put ("unbounded arr ("); + declare + It : Type_Acc; + begin + It := T; + loop + Put ("<>"); + exit when It.Ulast; + Put (", "); + It := It.Uarr_El; + end loop; + Put (") of "); + Debug_Typ1 (It.Uarr_El); + end; when Type_Protected => Put ("protected"); end case; - Put (' '); - Put (" al="); - Put_Int32 (Int32 (T.Al)); - Put (" sz="); - Put_Uns32 (Uns32 (T.Sz)); - Put (" w="); - Put_Uns32 (T.W); end Debug_Typ1; procedure Debug_Typ (T : Type_Acc) is @@ -123,19 +166,24 @@ package body Elab.Vhdl_Values.Debug is when Type_Logic => Put ("logic"); when Type_Vector => - Debug_Type_Short (T.Vec_El); + Debug_Type_Short (T.Arr_El); Put ("_vec("); - Debug_Bound (T.Vbound, False); + Debug_Bound (T.Abound, False); Put (")"); when Type_Array => - Put ("arr ("); - for I in 1 .. T.Abounds.Ndim loop - if I > 1 then + declare + It : Type_Acc; + begin + Put ("arr ("); + It := T; + loop + Debug_Bound (It.Abound, False); + exit when It.Alast; + It := It.Arr_El; Put (", "); - end if; - Debug_Bound (T.Abounds.D (I), False); - end loop; - Put (")"); + end loop; + Put (")"); + end; when Type_Record => Put ("rec: ("); Put (")"); @@ -165,30 +213,40 @@ package body Elab.Vhdl_Values.Debug is case M.Typ.Kind is when Type_Bit | Type_Logic => - Put ("bit/logic"); + Put ("bit/logic: "); + Put_Uns32 (Uns32 (Read_U8 (M.Mem))); when Type_Vector => Put ("vector ("); - Debug_Bound (M.Typ.Vbound, True); + Debug_Bound (M.Typ.Abound, True); Put ("): "); - for I in 1 .. M.Typ.Vbound.Len loop + for I in 1 .. M.Typ.Abound.Len loop Put_Uns32 (Uns32 (Read_U8 (M.Mem + Size_Type (I - 1)))); end loop; when Type_Array => - Put ("arr ("); - for I in 1 .. M.Typ.Abounds.Ndim loop - if I > 1 then + declare + T : Type_Acc; + El : Type_Acc; + Len : Uns32; + begin + Put ("arr ("); + T := M.Typ; + Len := 1; + loop + Debug_Bound (T.Abound, True); + Len := Len * T.Abound.Len; + El := T.Arr_El; + exit when T.Alast; + T := El; Put (", "); - end if; - Debug_Bound (M.Typ.Abounds.D (I), True); - end loop; - Put ("): "); - for I in 1 .. Get_Array_Flat_Length (M.Typ) loop - if I > 1 then - Put (", "); - end if; - Debug_Memtyp - ((M.Typ.Arr_El, M.Mem + Size_Type (I - 1) * M.Typ.Arr_El.Sz)); - end loop; + end loop; + Put ("): "); + for I in 1 .. Len loop + if I > 1 then + Put (", "); + end if; + Debug_Memtyp ((El, M.Mem + Size_Type (I - 1) * El.Sz)); + end loop; + end; when Type_Record => Put ("rec: ("); for I in M.Typ.Rec.E'Range loop @@ -196,7 +254,7 @@ package body Elab.Vhdl_Values.Debug is Put (", "); end if; Debug_Memtyp - ((M.Typ.Rec.E (I).Typ, M.Mem + M.Typ.Rec.E (I).Moff)); + ((M.Typ.Rec.E (I).Typ, M.Mem + M.Typ.Rec.E (I).Offs.Mem_Off)); end loop; Put (")"); when Type_Discrete => @@ -236,6 +294,8 @@ package body Elab.Vhdl_Values.Debug is New_Line; when Value_Signal => Put ("signal "); + Put_Uns32 (Uns32 (V.Val.S)); + Put (": "); Debug_Typ1 (V.Typ); New_Line; when Value_Wire => @@ -249,6 +309,9 @@ package body Elab.Vhdl_Values.Debug is Debug_Typ1 (V.Typ); Put (" of "); Debug_Valtyp ((V.Typ, V.Val.A_Obj)); + when Value_Dyn_Alias => + Put ("dyn alias: "); + Debug_Typ1 (V.Typ); end case; end Debug_Valtyp; 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); diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index 1838fef9c..b1aad9ce1 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -55,7 +55,10 @@ package Elab.Vhdl_Values is -- An alias. This is a reference to another value with a different -- (but compatible) type. - Value_Alias + Value_Alias, + + -- Used only for associations. + Value_Dyn_Alias ); type Value_Type (Kind : Value_Kind); @@ -67,7 +70,8 @@ package Elab.Vhdl_Values is subtype File_Index is Grt.Files_Operations.Ghdl_File_Index; - subtype Signal_Index_Type is Uns32; + type Signal_Index_Type is new Uns32; + No_Signal_Index : constant Signal_Index_Type := 0; type Value_Type (Kind : Value_Kind) is record case Kind is @@ -89,6 +93,12 @@ package Elab.Vhdl_Values is A_Obj : Value_Acc; A_Typ : Type_Acc; -- The type of A_Obj. A_Off : Value_Offsets; + when Value_Dyn_Alias => + D_Obj : Value_Acc; + D_Poff : Uns32; -- Offset from D_Obj + D_Ptyp : Type_Acc; -- Type of the prefix (after offset). + D_Voff : Uns32; -- Variable offset + D_Eoff : Uns32; -- Fixed offset. end case; end record; @@ -119,7 +129,8 @@ package Elab.Vhdl_Values is -- Create a Value_Wire. function Create_Value_Wire (S : Uns32) return Value_Acc; - 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; function Create_Value_Memory (Vtype : Type_Acc) return Valtyp; function Create_Value_Memory (Mt : Memtyp) return Valtyp; @@ -140,6 +151,12 @@ package Elab.Vhdl_Values is function Create_Value_Alias (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp; + function Create_Value_Dyn_Alias (Obj : Value_Acc; + Poff : Uns32; + Ptyp : Type_Acc; + Voff : Uns32; + Eoff : Uns32) return Value_Acc; + function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp; -- If VAL is a const, replace it by its value. @@ -150,6 +167,10 @@ package Elab.Vhdl_Values is -- is not correct anymore. function Strip_Alias_Const (V : Valtyp) return Valtyp; + -- Return the memory of a Value_Memory value, but also handle const and + -- aliases. + function Get_Memory (V : Valtyp) return Memory_Ptr; + -- Return the memtyp of V; also strip const and aliases. function Get_Memtyp (V : Valtyp) return Memtyp; diff --git a/src/synth/netlists-cleanup.adb b/src/synth/netlists-cleanup.adb index c2fc603b4..52b3c87e0 100644 --- a/src/synth/netlists-cleanup.adb +++ b/src/synth/netlists-cleanup.adb @@ -385,4 +385,31 @@ package body Netlists.Cleanup is end; end Mark_And_Sweep; + procedure Replace_Null_Inputs (Ctxt : Context_Acc; M : Module) + is + Inst : Instance; + Drv : Net; + Inp : Input; + Null_X : Net; + begin + Null_X := No_Net; + + Inst := Get_First_Instance (M); + while Inst /= No_Instance loop + for I in 1 .. Get_Nbr_Inputs (Inst) loop + Inp := Get_Input (Inst, I - 1); + Drv := Get_Driver (Inp); + if Drv /= No_Net and then Get_Width (Drv) = 0 then + if Null_X = No_Net then + Null_X := Build_Const_X (Ctxt, 0); + end if; + Disconnect (Inp); + Connect (Inp, Null_X); + end if; + end loop; + + Inst := Get_Next_Instance (Inst); + end loop; + end Replace_Null_Inputs; + end Netlists.Cleanup; diff --git a/src/synth/netlists-cleanup.ads b/src/synth/netlists-cleanup.ads index be4f0e0fb..a13e66c47 100644 --- a/src/synth/netlists-cleanup.ads +++ b/src/synth/netlists-cleanup.ads @@ -16,6 +16,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Netlists.Builders; use Netlists.Builders; + package Netlists.Cleanup is -- Remove instances of module M whose outputs are not connected. -- Their inputs will be deconnected, which can result in new instances @@ -26,6 +28,10 @@ package Netlists.Cleanup is -- sweep algorithm. procedure Mark_And_Sweep (M : Module); + -- Reconnection inputs of width 0 (the null inputs) to an Const_X gate. + -- This will make all the null logic unconnected and ready to be cleaned. + procedure Replace_Null_Inputs (Ctxt : Context_Acc; M : Module); + -- Remove Id_Output gates. procedure Remove_Output_Gates (M : Module); end Netlists.Cleanup; diff --git a/src/synth/netlists-disp_verilog.adb b/src/synth/netlists-disp_verilog.adb index 18c5091df..cd13a6d77 100644 --- a/src/synth/netlists-disp_verilog.adb +++ b/src/synth/netlists-disp_verilog.adb @@ -31,6 +31,10 @@ package body Netlists.Disp_Verilog is Flag_Merge_Lit : constant Boolean := True; Flag_Merge_Edge : constant Boolean := True; + -- Wires/regs/parameters of size 0 are not possible in verilog. + -- Do not display them. + Flag_Null_Wires : constant Boolean := False; + procedure Put_Type (W : Width) is begin if W > 1 then @@ -158,10 +162,12 @@ package body Netlists.Disp_Verilog is is Imod : constant Module := Get_Module (Inst); Idx : Port_Idx; + Drv : Net; Max_Idx : Port_Idx; Name : Sname; First : Boolean; Param : Param_Desc; + Desc : Port_Desc; begin Put (" "); @@ -217,33 +223,37 @@ package body Netlists.Disp_Verilog is Idx := 0; Max_Idx := Get_Nbr_Inputs (Imod); for I of Inputs (Inst) loop - if First then - First := False; - else - Put_Line (","); - end if; - Put (" "); - if Idx < Max_Idx then - Put ("."); - Put_Interface_Name (Get_Input_Desc (Imod, Idx).Name); - Put ("("); - end if; - Disp_Net_Name (Get_Driver (I)); - if Idx < Max_Idx then - Put (")"); - Idx := Idx + 1; + Drv := Get_Driver (I); + if Flag_Null_Wires or else Get_Width (Drv) /= 0 then + if First then + First := False; + else + Put_Line (","); + end if; + Put (" "); + if Idx < Max_Idx then + Put ("."); + Put_Interface_Name (Get_Input_Desc (Imod, Idx).Name); + Put ("("); + end if; + Disp_Net_Name (Get_Driver (I)); + if Idx < Max_Idx then + Put (")"); + end if; end if; + Idx := Idx + 1; end loop; -- Outputs Idx := 0; for O of Outputs (Inst) loop + Desc := Get_Output_Desc (Imod, Idx); if First then First := False; else Put_Line (","); end if; Put (" ."); - Put_Interface_Name (Get_Output_Desc (Imod, Idx).Name); + Put_Interface_Name (Desc.Name); Idx := Idx + 1; Put ("("); declare @@ -434,9 +444,14 @@ package body Netlists.Disp_Verilog is -- a name. In that case, a signal will be created and driven. function Need_Signal (Inst : Instance) return Boolean is + O : constant Net := Get_Output (Inst, 0); I : Input; begin - I := Get_First_Sink (Get_Output (Inst, 0)); + if not Flag_Null_Wires and then Get_Width (O) = 0 then + return False; + end if; + + I := Get_First_Sink (O); while I /= No_Input loop if Need_Name (Get_Input_Parent (I)) then return True; @@ -759,12 +774,12 @@ package body Netlists.Disp_Verilog is Put ('0'); end if; end loop; - Disp_Template (": \o0 <= ", Inst); + Disp_Template (": \o0 = ", Inst); Disp_Net_Expr (Get_Input_Net (Inst, Port_Idx (2 + W - I)), Inst, Conv_None); Put_Line (";"); end loop; - Disp_Template (" default: \o0 <= \i1;" & NL, Inst); + Disp_Template (" default: \o0 = \i1;" & NL, Inst); Disp_Template (" endcase" & NL, Inst); end Disp_Pmux; @@ -826,7 +841,7 @@ package body Netlists.Disp_Verilog is " \o0 = \i0; // (isignal)" & NL, Inst); end if; Disp_Template (" initial" & NL & - " \o0 <= \i1;" & NL, Inst); + " \o0 = \i1;" & NL, Inst); end; when Id_Port => Disp_Template (" \o0 <= \i0; -- (port)" & NL, Inst); @@ -889,13 +904,13 @@ package body Netlists.Disp_Verilog is Iw : constant Width := Get_Width (Get_Input_Net (Inst, 1)); begin Put (" always @* begin // (dyn_insert)" & NL); - Disp_Template (" \o0 <= \i0;" & NL, Inst); + Disp_Template (" \o0 = \i0;" & NL, Inst); if Id = Id_Dyn_Insert_En then -- TODO: fix indentation. Disp_Template (" if (\i3)" & NL, Inst); end if; Disp_Template - (" \o0 [\i2 + \p0 -: \n0] <= \i1;" & NL, + (" \o0 [\i2 + \p0 -: \n0] = \i1;" & NL, Inst, (0 => Iw - 1)); Disp_Template (" end" & NL, Inst); end; @@ -921,17 +936,17 @@ package body Netlists.Disp_Verilog is " \o0 <= \i1;" & NL, Inst); if Id = Id_Idff then Disp_Template (" initial" & NL & - " \o0 <= \i2;" & NL, Inst); + " \o0 = \i2;" & NL, Inst); end if; when Id_Mux2 => Disp_Template (" assign \o0 = \i0 ? \i2 : \i1;" & NL, Inst); when Id_Mux4 => Disp_Template (" always @*" & NL & " case (\i0)" & NL & - " 2'b00: \o0 <= \i1;" & NL & - " 2'b01: \o0 <= \i2;" & NL & - " 2'b10: \o0 <= \i3;" & NL & - " 2'b11: \o0 <= \i4;" & NL & + " 2'b00: \o0 = \i1;" & NL & + " 2'b01: \o0 = \i2;" & NL & + " 2'b10: \o0 = \i3;" & NL & + " 2'b11: \o0 = \i4;" & NL & " endcase" & NL, Inst); when Id_Pmux => Disp_Pmux (Inst); @@ -1212,14 +1227,18 @@ package body Netlists.Disp_Verilog is -- Output assignments. declare Idx : Port_Idx; + Desc : Port_Desc; begin Idx := 0; for I of Inputs (Self_Inst) loop - Put (" assign "); - Put_Name (Get_Output_Desc (M, Idx).Name); - Put (" = "); - Disp_Net_Name (Get_Driver (I)); - Put_Line (";"); + Desc := Get_Output_Desc (M, Idx); + if Desc.W /= 0 or Flag_Null_Wires then + Put (" assign "); + Put_Name (Desc.Name); + Put (" = "); + Disp_Net_Name (Get_Driver (I)); + Put_Line (";"); + end if; Idx := Idx + 1; end loop; end; @@ -1246,6 +1265,10 @@ package body Netlists.Disp_Verilog is is Attr : Attribute; begin + if not (Desc.W /= 0 or Flag_Null_Wires) then + return; + end if; + if First then Put (" ("); First := False; @@ -1328,6 +1351,11 @@ package body Netlists.Disp_Verilog is is Self_Inst : constant Instance := Get_Self_Instance (M); begin + if Self_Inst = No_Instance then + -- Blackbox + return; + end if; + -- Module id and name. Put ("module "); Put_Name (Get_Module_Name (M)); diff --git a/src/synth/netlists-expands.adb b/src/synth/netlists-expands.adb index efb9fc93f..0f69dd93d 100644 --- a/src/synth/netlists-expands.adb +++ b/src/synth/netlists-expands.adb @@ -46,6 +46,9 @@ package body Netlists.Expands is N := Addr_Net; Nbr_Els := 1; P := Memidx_Arr'Last; + if P = 0 then + return; + end if; loop Ninst := Get_Net_Parent (N); case Get_Id (Ninst) is @@ -213,34 +216,47 @@ package body Netlists.Expands is -- 2. compute number of cells. Gather_Memidx (Addr_Net, Memidx_Arr, Nbr_Els); - -- 2. build extract gates - Els := new Case_Element_Array (1 .. Nbr_Els); - declare - Idx : Positive; - Off : Uns32; - Sel : Uns64; - begin - Idx := 1; - Off := Get_Param_Uns32 (Inst, 0); - Sel := 0; - Fill_Els (Ctxt, Memidx_Arr, 1, Val, Els, Idx, Addr_Net, Off, W, Sel); - end; + if Nbr_Els = 1 then + -- There is only one element, so it's not really dynamic. + -- Just return the value. + Res := Get_Input_Net (Inst, 0); + -- Disconnect the address + Addr := Disconnect_And_Get (Inst, 1); + if not Is_Connected (Addr) then + -- Should be a Const_X. + Remove_Instance (Get_Net_Parent (Addr)); + end if; + else + -- 2. build extract gates + Els := new Case_Element_Array (1 .. Nbr_Els); + declare + Idx : Positive; + Off : Uns32; + Sel : Uns64; + begin + Idx := 1; + Off := Get_Param_Uns32 (Inst, 0); + Sel := 0; + Fill_Els (Ctxt, Memidx_Arr, + 1, Val, Els, Idx, Addr_Net, Off, W, Sel); + end; - -- 3. build mux tree - Disconnect (Get_Input (Inst, 1)); - Extract_Address (Ctxt, Addr_Net, Ndims, Addr); - Truncate_Address (Ctxt, Addr, Nbr_Els); - Def := No_Net; - Synth_Case (Ctxt, Addr, Els.all, Def, Res, Loc); + -- 3. build mux tree + Disconnect (Get_Input (Inst, 1)); + Extract_Address (Ctxt, Addr_Net, Ndims, Addr); + Truncate_Address (Ctxt, Addr, Nbr_Els); + Def := No_Net; + Synth_Case (Ctxt, Addr, Els.all, Def, Res, Loc); + + -- 4. remove old dyn_extract. + Remove_Memidx (Memidx_Arr); + + Free_Case_Element_Array (Els); + end if; - -- 4. remove old dyn_extract. Disconnect (Get_Input (Inst, 0)); Redirect_Inputs (Get_Output (Inst, 0), Res); Remove_Instance (Inst); - - Remove_Memidx (Memidx_Arr); - - Free_Case_Element_Array (Els); end Expand_Dyn_Extract; procedure Generate_Decoder (Ctxt : Context_Acc; diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads index 6e78054af..305bd5158 100644 --- a/src/synth/netlists-gates.ads +++ b/src/synth/netlists-gates.ads @@ -264,8 +264,8 @@ package Netlists.Gates is -- addidx. -- Inputs: 0: index -- Params: 0: step - -- 1: max - -- OUT := IN0 * STEP, IN0 < MAX + -- 1: max (maximum value for index, so length - 1). + -- OUT := IN0 * STEP, IN0 <= MAX Id_Memidx : constant Module_Id := 90; -- Combine (simply add) indexes for dynamic insert or extract. diff --git a/src/synth/netlists-memories.adb b/src/synth/netlists-memories.adb index 55bcf0ba4..ffc3316ba 100644 --- a/src/synth/netlists-memories.adb +++ b/src/synth/netlists-memories.adb @@ -243,6 +243,11 @@ package body Netlists.Memories is end if; Res := Res + 1; N := Get_Input_Net (Inst, 0); + when Id_Const_X => + -- For a null wire. + pragma Assert (Res = 0); + pragma Assert (Get_Width (N) = 0); + return 0; when others => raise Internal_Error; end case; @@ -1414,14 +1419,9 @@ package body Netlists.Memories is Inst : Instance; N : Net; begin - if Negate then - -- TODO. - raise Internal_Error; - end if; - -- Simple case (but important for the memories) if V = Conj then - return True; + return (not Negate); end if; N := Conj; @@ -1429,12 +1429,12 @@ package body Netlists.Memories is loop Inst := Get_Net_Parent (N); if Get_Id (Inst) /= Id_And then - return N = V; + return (N = V) xor Negate; end if; -- Inst is AND2. if Get_Input_Net (Inst, 0) = V then - return True; + return (not Negate); end if; N := Get_Input_Net (Inst, 1); end loop; diff --git a/src/synth/netlists-rename.adb b/src/synth/netlists-rename.adb new file mode 100644 index 000000000..7b0c8e5f9 --- /dev/null +++ b/src/synth/netlists-rename.adb @@ -0,0 +1,126 @@ +-- Renaming to avoid use of keywords. +-- Copyright (C) 2022 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, see <gnu.org/licenses>. + +with Name_Table; +with Std_Names; + +with Netlists.Gates; use Netlists.Gates; +with Netlists.Utils; use Netlists.Utils; + +package body Netlists.Rename is + function Rename_Sname (Name : Sname; Lang : Language_Type) return Sname + is + use Name_Table; + use Std_Names; + Id : Name_Id; + Res : String (1 .. 12); + Len : Positive; + begin + if Get_Sname_Kind (Name) /= Sname_User then + return Name; + end if; + if Get_Sname_Prefix (Name) /= No_Sname then + return Name; + end if; + + Id := Get_Sname_Suffix (Name); + + pragma Assert (Lang = Language_Verilog); + + case Id is + when Name_First_Verilog .. Name_Last_V2001 => + null; + when Name_Xnor + | Name_Nor + | Name_Nand + | Name_Xor + | Name_Or + | Name_And + | Name_Begin + | Name_Case + | Name_Else + | Name_End + | Name_For + | Name_Function + | Name_If + | Name_Inout + | Name_Not + | Name_While + | Name_Wait => + null; + when others => + -- Not a keyword + return Name; + end case; + + Len := Get_Name_Length (Id); + Res (2 .. Len + 1) := Image (Id); + Res (1) := '\'; + Res (Len + 2) := ' '; + Id := Get_Identifier (Res (1 .. Len + 2)); + return New_Sname_User (Id, No_Sname); + end Rename_Sname; + + procedure Rename_User_Module (M : Module; Lang : Language_Type) + is + Port : Port_Desc; + Inst : Instance; + begin + -- Rename inputs and outputs. + for I in 1 .. Get_Nbr_Inputs (M) loop + Port := Get_Input_Desc (M, I - 1); + Port.Name := Rename_Sname (Port.Name, Lang); + Set_Input_Desc (M, I - 1, Port); + end loop; + for I in 1 .. Get_Nbr_Outputs (M) loop + Port := Get_Output_Desc (M, I - 1); + Port.Name := Rename_Sname (Port.Name, Lang); + Set_Output_Desc (M, I - 1, Port); + end loop; + + -- Rename some instances. + Inst := Get_First_Instance (M); + while Inst /= No_Instance loop + case Get_Id (Inst) is + when Id_Signal + | Id_Isignal => + Set_Instance_Name + (Inst, Rename_Sname (Get_Instance_Name (Inst), Lang)); + when others => + null; + end case; + Inst := Get_Next_Instance (Inst); + end loop; + + -- rename module name ? + -- rename parameters ? + end Rename_User_Module; + + procedure Rename_Module (M : Module; Lang : Language_Type) + is + Sm : Module; + begin + Sm := Get_First_Sub_Module (M); + while Sm /= No_Module loop + if Get_Id (Sm) >= Id_User_None then + Rename_User_Module (Sm, Lang); + end if; + Sm := Get_Next_Sub_Module (Sm); + end loop; + end Rename_Module; +end Netlists.Rename; diff --git a/src/synth/netlists-rename.ads b/src/synth/netlists-rename.ads new file mode 100644 index 000000000..45e5008b5 --- /dev/null +++ b/src/synth/netlists-rename.ads @@ -0,0 +1,21 @@ +-- Renaming to avoid use of keywords. +-- Copyright (C) 2022 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, see <gnu.org/licenses>. + +package Netlists.Rename is + procedure Rename_Module (M : Module; Lang : Language_Type); +end Netlists.Rename; diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb index 5ea2b9b90..3a5b0b3dd 100644 --- a/src/synth/netlists.adb +++ b/src/synth/netlists.adb @@ -721,6 +721,12 @@ package body Netlists is return Instances_Table.Table (Inst).Name; end Get_Instance_Name; + procedure Set_Instance_Name (Inst : Instance; Name : Sname) is + begin + pragma Assert (Is_Valid (Inst)); + Instances_Table.Table (Inst).Name := Name; + end Set_Instance_Name; + function Get_Instance_Parent (Inst : Instance) return Module is begin pragma Assert (Is_Valid (Inst)); @@ -878,7 +884,6 @@ package body Netlists is pragma Assert (I < Get_Nbr_Inputs (M)); Idx : constant Port_Desc_Idx := F + Port_Desc_Idx (I); begin - pragma Assert (Get_Port_Desc (Idx).Name = No_Sname); Set_Port_Desc (Idx, Desc); end Set_Input_Desc; @@ -888,7 +893,6 @@ package body Netlists is pragma Assert (O < Get_Nbr_Outputs (M)); Idx : constant Port_Desc_Idx := F + Port_Desc_Idx (O); begin - pragma Assert (Get_Port_Desc (Idx).Name = No_Sname); Set_Port_Desc (Idx, Desc); end Set_Output_Desc; diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads index 661c2ae3d..5d2106608 100644 --- a/src/synth/netlists.ads +++ b/src/synth/netlists.ads @@ -253,6 +253,7 @@ package Netlists is function Get_Self_Instance (M : Module) return Instance; function Get_First_Instance (M : Module) return Instance; + function Get_Next_Instance (Inst : Instance) return Instance; -- Linked list of sub-modules. -- Use Modules to iterate. @@ -280,7 +281,6 @@ package Netlists is function Get_Instance_Parent (Inst : Instance) return Module; function Get_Output (Inst : Instance; Idx : Port_Idx) return Net; function Get_Input (Inst : Instance; Idx : Port_Idx) return Input; - function Get_Next_Instance (Inst : Instance) return Instance; function Get_Param_Uns32 (Inst : Instance; Param : Param_Idx) return Uns32; procedure Set_Param_Uns32 (Inst : Instance; Param : Param_Idx; Val : Uns32); @@ -470,6 +470,9 @@ private procedure Set_Next_Instance (Inst : Instance; Next : Instance); procedure Set_Prev_Instance (Inst : Instance; Prev : Instance); + -- Used by Rename. + procedure Set_Instance_Name (Inst : Instance; Name : Sname); + -- Procedures to rewrite the list of instances of a module: -- * first extract the chain of instances from module M (and reset the -- list of instances - so there is none), diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index 8a5f4f863..f7ef56c50 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -157,7 +157,7 @@ package body Synth.Disp_Vhdl is when Iir_Kind_Array_Type_Definition => if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type then -- Nothing to do. - W := Typ.Vbound.Len; + W := Typ.Abound.Len; Disp_In_Lhs (Mname, Off, W, Full); Put (Pfx); if W = 1 then @@ -167,7 +167,7 @@ package body Synth.Disp_Vhdl is end if; Put_Line (";"); elsif Is_Std_Logic_Array (Btype) then - W := Typ.Vbound.Len; + W := Typ.Abound.Len; Disp_In_Lhs (Mname, Off, W, Full); if W > 1 then if Full then @@ -189,14 +189,14 @@ package body Synth.Disp_Vhdl is end if; Put_Line (";"); elsif Btype = Vhdl.Std_Package.Bit_Vector_Type_Definition then - W := Typ.Vbound.Len; + W := Typ.Abound.Len; Disp_In_Lhs (Mname, Off, W, Full); Put ("to_stdlogicvector (" & Pfx & ")"); Put_Line (";"); else -- Any array. declare - Bnd : Bound_Type renames Typ.Abounds.D (1); + Bnd : Bound_Type renames Typ.Abound; El_Type : constant Node := Get_Element_Subtype (Ptype); El_W : constant Width := Get_Type_Width (Typ.Arr_El); Idx : Int32; @@ -230,7 +230,8 @@ package body Synth.Disp_Vhdl is Disp_In_Converter (Mname, Pfx & '.' & Name_Table.Image (Get_Identifier (El)), - Off + Et.Boff, Get_Type (El), Et.Typ, Rec_Full); + Off + Et.Offs.Net_Off, + Get_Type (El), Et.Typ, Rec_Full); end; end loop; end; @@ -340,7 +341,7 @@ package body Synth.Disp_Vhdl is when Iir_Kind_Array_Type_Definition => if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type then -- Nothing to do. - W := Typ.Vbound.Len; + W := Typ.Abound.Len; Put (" " & Pfx); if W = 1 then Put (" (" & Pfx & "'left)"); @@ -350,7 +351,7 @@ package body Synth.Disp_Vhdl is Put_Line (";"); elsif Btype = Vhdl.Std_Package.Bit_Vector_Type_Definition then -- Nothing to do. - W := Typ.Vbound.Len; + W := Typ.Abound.Len; Put (" " & Pfx & " <= "); if W = 1 then -- This is an array of length 1. A scalar is used in the @@ -366,7 +367,7 @@ package body Synth.Disp_Vhdl is Put_Line (");"); elsif Is_Std_Logic_Array (Btype) then -- unsigned, signed or a compatible array. - W := Typ.Vbound.Len; + W := Typ.Abound.Len; Put (" " & Pfx & " <= "); Put (Name_Table.Image (Get_Identifier (Get_Type_Declarator (Btype)))); @@ -375,7 +376,7 @@ package body Synth.Disp_Vhdl is Put_Line (");"); else declare - Bnd : Bound_Type renames Typ.Abounds.D (1); + Bnd : Bound_Type renames Typ.Abound; El_Type : constant Node := Get_Element_Subtype (Ptype); El_W : constant Width := Get_Type_Width (Typ.Arr_El); Idx : Int32; @@ -409,7 +410,8 @@ package body Synth.Disp_Vhdl is Disp_Out_Converter (Mname, Pfx & '.' & Name_Table.Image (Get_Identifier (El)), - Off + Et.Boff, Get_Type (El), Et.Typ, Rec_Full); + Off + Et.Offs.Net_Off, + Get_Type (El), Et.Typ, Rec_Full); end; end loop; end; diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index b0bf4d6dd..7e809e7cc 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -1447,7 +1447,9 @@ package body Synth.Environment is -- TODO: also handle dyn_insert_en -- TODO: negative SEL ? V := Get_Input_Net (N1_Inst, 0); - if Same_Net (V, N0) then + -- NOTE: do not try to transform as a dyn_insert_en, as this element + -- is not recognized by Infere; so we got spurious latch detected. + if False and then Same_Net (V, N0) then New_Inst := Add_Enable_To_Dyn_Insert (Ctxt, N1_Inst, Sel); return Get_Output (New_Inst, 0); else diff --git a/src/synth/synth-errors.adb b/src/synth/synth-errors.adb index e8d693d0b..a0b672770 100644 --- a/src/synth/synth-errors.adb +++ b/src/synth/synth-errors.adb @@ -33,12 +33,12 @@ package body Synth.Errors is +Loc, Msg, Args); end Error_Msg_Synth; - procedure Warning_Msg_Synth (Loc : Location_Type; + procedure Warning_Msg_Synth (Warnid : Msgid_Warnings; + Loc : Location_Type; Msg : String; Arg1 : Earg_Type) is begin - Report_Msg (Msgid_Warning, Errorout.Elaboration, - +Loc, Msg, (1 => Arg1)); + Report_Msg (Warnid, Errorout.Elaboration, +Loc, Msg, (1 => Arg1)); end Warning_Msg_Synth; procedure Warning_Msg_Synth (Loc : Location_Type; diff --git a/src/synth/synth-errors.ads b/src/synth/synth-errors.ads index 800f3232e..448ab6be1 100644 --- a/src/synth/synth-errors.ads +++ b/src/synth/synth-errors.ads @@ -26,7 +26,8 @@ package Synth.Errors is procedure Error_Msg_Synth (Loc : Location_Type; Msg : String; Args : Earg_Arr := No_Eargs); - procedure Warning_Msg_Synth (Loc : Location_Type; + procedure Warning_Msg_Synth (Warnid : Msgid_Warnings; + Loc : Location_Type; Msg : String; Arg1 : Earg_Type); procedure Warning_Msg_Synth (Loc : Location_Type; diff --git a/src/synth/synth-flags.ads b/src/synth/synth-flags.ads index a4034a073..211c01c1d 100644 --- a/src/synth/synth-flags.ads +++ b/src/synth/synth-flags.ads @@ -51,8 +51,12 @@ package Synth.Flags is Flag_Debug_Nomemory2 : Boolean := False; + -- Do not expand dynamic gates. Flag_Debug_Noexpand : Boolean := False; + -- Do not transform null net to null X. + Flag_Debug_Nonull : Boolean := False; + Flag_Trace_Statements : Boolean := False; -- Display source of elaborated design. @@ -61,9 +65,6 @@ package Synth.Flags is -- True to start debugger at elaboration. Flag_Debug_Init : Boolean := False; - -- True to start debugger on error. - Flag_Debug_Enable : Boolean := False; - -- Maximum number of iterations for (while)/loop. 0 means unlimited. Flag_Max_Loop : Natural := 1000; diff --git a/src/synth/synth-ieee-numeric_std.adb b/src/synth/synth-ieee-numeric_std.adb index f8b7bc960..f850456b0 100644 --- a/src/synth/synth-ieee-numeric_std.adb +++ b/src/synth/synth-ieee-numeric_std.adb @@ -21,7 +21,6 @@ with Types_Utils; use Types_Utils; with Elab.Memtype; use Elab.Memtype; with Synth.Errors; use Synth.Errors; -with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; package body Synth.Ieee.Numeric_Std is subtype Sl_01 is Std_Ulogic range '0' .. '1'; @@ -48,35 +47,36 @@ package body Synth.Ieee.Numeric_Std is function Create_Res_Type (Otyp : Type_Acc; Len : Uns32) return Type_Acc is begin - if Otyp.Vbound.Len = Len - and then Otyp.Vbound.Right = 0 - and then Otyp.Vbound.Dir = Dir_Downto + if Otyp.Abound.Len = Len + and then Otyp.Abound.Right = 0 + and then Otyp.Abound.Dir = Dir_Downto then - pragma Assert (Otyp.Vbound.Left = Int32 (Len) - 1); + pragma Assert (Otyp.Abound.Left = Int32 (Len) - 1); return Otyp; end if; - return Create_Vec_Type_By_Length (Len, Otyp.Vec_El); + return Create_Vec_Type_By_Length (Len, Otyp.Arr_El); end Create_Res_Type; procedure Fill (Res : Memtyp; V : Std_Ulogic) is begin - for I in 1 .. Res.Typ.Vbound.Len loop + for I in 1 .. Res.Typ.Abound.Len loop Write_Std_Logic (Res.Mem, I - 1, V); end loop; end Fill; - procedure Warn_Compare_Null (Loc : Syn_Src) is + procedure Warn_Compare_Null (Loc : Location_Type) is begin - Warning_Msg_Synth (+Loc, "null argument detected, returning false"); + Warning_Msg_Synth (Loc, "null argument detected, returning false"); end Warn_Compare_Null; - procedure Warn_Compare_Meta (Loc : Syn_Src) is + procedure Warn_Compare_Meta (Loc : Location_Type) is begin - Warning_Msg_Synth (+Loc, "metavalue detected, returning false"); + Warning_Msg_Synth (Loc, "metavalue detected, returning false"); end Warn_Compare_Meta; - function Compare_Uns_Uns - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type + function Compare_Uns_Uns (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type is Lw : constant Uns32 := Left.Typ.W; Rw : constant Uns32 := Right.Typ.W; @@ -129,8 +129,9 @@ package body Synth.Ieee.Numeric_Std is return Equal; end Compare_Uns_Uns; - function Compare_Uns_Nat - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type + function Compare_Uns_Nat (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type is Lw : constant Uns32 := Left.Typ.W; Rval : constant Uns64 := To_Uns64 (Read_Discrete (Right)); @@ -183,8 +184,9 @@ package body Synth.Ieee.Numeric_Std is return Equal; end Compare_Uns_Nat; - function Compare_Nat_Uns - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type + function Compare_Nat_Uns (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type is Rw : constant Uns32 := Right.Typ.W; Lval : constant Uns64 := To_Uns64 (Read_Discrete (Left)); @@ -237,8 +239,9 @@ package body Synth.Ieee.Numeric_Std is return Equal; end Compare_Nat_Uns; - function Compare_Sgn_Sgn - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type + function Compare_Sgn_Sgn (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type is Lw : constant Uns32 := Left.Typ.W; Rw : constant Uns32 := Right.Typ.W; @@ -293,8 +296,9 @@ package body Synth.Ieee.Numeric_Std is return Res; end Compare_Sgn_Sgn; - function Compare_Sgn_Int - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type + function Compare_Sgn_Int (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type is Lw : constant Uns32 := Left.Typ.W; Rval : constant Int64 := Read_Discrete (Right); @@ -341,23 +345,25 @@ package body Synth.Ieee.Numeric_Std is return Res; end Compare_Sgn_Int; - function Add_Vec_Vec (L, R : Memtyp; Signed : Boolean; Loc : Syn_Src) + function Add_Vec_Vec (L, R : Memtyp; Signed : Boolean; Loc : Location_Type) return Memtyp is - Llen : constant Uns32 := L.Typ.Vbound.Len; - Rlen : constant Uns32 := R.Typ.Vbound.Len; + Llen : constant Uns32 := L.Typ.Abound.Len; + Rlen : constant Uns32 := R.Typ.Abound.Len; Len : constant Uns32 := Uns32'Max (Llen, Rlen); Res : Memtyp; Lb, Rb, Carry : Sl_X01; R_Ext, L_Ext : Sl_X01; begin - Res.Typ := Create_Res_Type (L.Typ, Len); - Res := Create_Memory (Res.Typ); - - if Len = 0 then + if Rlen = 0 or Llen = 0 then + Res.Typ := Create_Res_Type (L.Typ, 0); + Res := Create_Memory (Res.Typ); return Res; end if; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + if Signed then -- Extend with the sign bit. L_Ext := Sl_To_X01 (Read_Std_Logic (L.Mem, 0)); @@ -392,20 +398,37 @@ package body Synth.Ieee.Numeric_Std is return Res; end Add_Vec_Vec; - function Add_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + function Add_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp is begin return Add_Vec_Vec (L, R, False, Loc); end Add_Uns_Uns; - function Add_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + function Log_To_Vec (Val : Memtyp; Vec : Memtyp) return Memtyp + is + Len : constant Uns32 := Vec.Typ.Abound.Len; + Res : Memtyp; + begin + if Len = 0 then + -- FIXME: is it an error ? + return Vec; + end if; + Res := Create_Memory (Vec.Typ); + Fill (Res, '0'); + Write_U8 (Res.Mem + Size_Type (Len - 1), Read_U8 (Val.Mem)); + return Res; + end Log_To_Vec; + + function Add_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp is begin return Add_Vec_Vec (L, R, True, Loc); end Add_Sgn_Sgn; - function Add_Vec_Int - (L : Memtyp; R : Uns64; Signed : Boolean; Loc : Syn_Src) return Memtyp + function Add_Vec_Int (L : Memtyp; + R : Uns64; + Signed : Boolean; + Loc : Location_Type) return Memtyp is - Len : constant Uns32 := L.Typ.Vbound.Len; + Len : constant Uns32 := L.Typ.Abound.Len; Res : Memtyp; V : Uns64; Lb, Rb, Carry : Sl_X01; @@ -437,33 +460,37 @@ package body Synth.Ieee.Numeric_Std is return Res; end Add_Vec_Int; - function Add_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp is + function Add_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp is begin return Add_Vec_Int (L, To_Uns64 (R), True, Loc); end Add_Sgn_Int; - function Add_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp is + function Add_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp is begin return Add_Vec_Int (L, R, True, Loc); end Add_Uns_Nat; - function Sub_Vec_Vec (L, R : Memtyp; Signed : Boolean; Loc : Syn_Src) + function Sub_Vec_Vec (L, R : Memtyp; Signed : Boolean; Loc : Location_Type) return Memtyp is - Llen : constant Uns32 := L.Typ.Vbound.Len; - Rlen : constant Uns32 := R.Typ.Vbound.Len; + Llen : constant Uns32 := L.Typ.Abound.Len; + Rlen : constant Uns32 := R.Typ.Abound.Len; Len : constant Uns32 := Uns32'Max (Llen, Rlen); Res : Memtyp; Lb, Rb, Carry : Sl_X01; R_Ext, L_Ext : Sl_X01; begin - Res.Typ := Create_Res_Type (L.Typ, Len); - Res := Create_Memory (Res.Typ); - - if Len = 0 then + if Llen = 0 or Rlen = 0 then + Res.Typ := Create_Res_Type (L.Typ, 0); + Res := Create_Memory (Res.Typ); return Res; end if; + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + if Signed then -- Extend with the sign bit. L_Ext := Sl_To_X01 (Read_Std_Logic (L.Mem, 0)); @@ -499,20 +526,22 @@ package body Synth.Ieee.Numeric_Std is return Res; end Sub_Vec_Vec; - function Sub_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + function Sub_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp is begin return Sub_Vec_Vec (L, R, False, Loc); end Sub_Uns_Uns; - function Sub_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp is + function Sub_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp is begin return Sub_Vec_Vec (L, R, True, Loc); end Sub_Sgn_Sgn; - function Sub_Vec_Int - (L : Memtyp; R : Uns64; Signed : Boolean; Loc : Syn_Src) return Memtyp + function Sub_Vec_Int (L : Memtyp; + R : Uns64; + Signed : Boolean; + Loc : Location_Type) return Memtyp is - Len : constant Uns32 := L.Typ.Vbound.Len; + Len : constant Uns32 := L.Typ.Abound.Len; Res : Memtyp; V : Uns64; Lb, Rb, Carry : Sl_X01; @@ -545,20 +574,73 @@ package body Synth.Ieee.Numeric_Std is return Res; end Sub_Vec_Int; - function Sub_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp is + function Sub_Sgn_Int (L : Memtyp; + R : Int64; + Loc : Location_Type) return Memtyp is begin return Sub_Vec_Int (L, To_Uns64 (R), True, Loc); end Sub_Sgn_Int; - function Sub_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp is + function Sub_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp is begin return Sub_Vec_Int (L, R, True, Loc); end Sub_Uns_Nat; - function Mul_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp + function Sub_Int_Vec (L : Uns64; + R : Memtyp; + Signed : Boolean; + Loc : Location_Type) return Memtyp + is + Len : constant Uns32 := R.Typ.Abound.Len; + Res : Memtyp; + V : Uns64; + Lb, Rb, Carry : Sl_X01; + begin + Res.Typ := Create_Res_Type (R.Typ, Len); + Res := Create_Memory (Res.Typ); + if Len < 1 then + return Res; + end if; + V := L; + Carry := '1'; + for I in 1 .. Len loop + Lb := Uns_To_01 (V and 1); + Rb := Sl_To_X01 (Read_Std_Logic (R.Mem, Len - I)); + if Rb = 'X' then + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""+"": non logical value detected"); + Fill (Res, 'X'); + exit; + end if; + Rb := Not_Table (Rb); + Write_Std_Logic (Res.Mem, Len - I, Compute_Sum (Carry, Rb, Lb)); + Carry := Compute_Carry (Carry, Rb, Lb); + if Signed then + V := Shift_Right_Arithmetic (V, 1); + else + V := Shift_Right (V, 1); + end if; + end loop; + return Res; + end Sub_Int_Vec; + + function Sub_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp is + begin + return Sub_Int_Vec (L, R, False, Loc); + end Sub_Nat_Uns; + + function Sub_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp is + begin + return Sub_Int_Vec (To_Uns64 (L), R, True, Loc); + end Sub_Int_Sgn; + + function Mul_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp is - Llen : constant Uns32 := L.Typ.Vbound.Len; - Rlen : constant Uns32 := R.Typ.Vbound.Len; + Llen : constant Uns32 := L.Typ.Abound.Len; + Rlen : constant Uns32 := R.Typ.Abound.Len; Len : constant Uns32 := Llen + Rlen; Res : Memtyp; Lb, Rb, Vb, Carry : Sl_X01; @@ -601,7 +683,7 @@ package body Synth.Ieee.Numeric_Std is function To_Unsigned (Val : Uns64; Vtyp : Type_Acc) return Memtyp is - Vlen : constant Uns32 := Vtyp.Vbound.Len; + Vlen : constant Uns32 := Vtyp.Abound.Len; Res : Memtyp; E : Std_Ulogic; begin @@ -617,32 +699,34 @@ package body Synth.Ieee.Numeric_Std is return Res; end To_Unsigned; - function Mul_Nat_Uns (L : Uns64; R : Memtyp; Loc : Syn_Src) return Memtyp + function Mul_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp is Lv : Memtyp; begin - if R.Typ.Vbound.Len = 0 then + if R.Typ.Abound.Len = 0 then return Create_Memory (R.Typ); -- FIXME: typ end if; Lv := To_Unsigned (L, R.Typ); return Mul_Uns_Uns (Lv, R, Loc); end Mul_Nat_Uns; - function Mul_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp + function Mul_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp is Rv : Memtyp; begin - if L.Typ.Vbound.Len = 0 then + if L.Typ.Abound.Len = 0 then return Create_Memory (L.Typ); -- FIXME: typ end if; Rv := To_Unsigned (R, L.Typ); return Mul_Uns_Uns (L, Rv, Loc); end Mul_Uns_Nat; - function Mul_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp + function Mul_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp is - Llen : constant Uns32 := L.Typ.Vbound.Len; - Rlen : constant Uns32 := R.Typ.Vbound.Len; + Llen : constant Uns32 := L.Typ.Abound.Len; + Rlen : constant Uns32 := R.Typ.Abound.Len; Len : constant Uns32 := Llen + Rlen; Res : Memtyp; Lb, Rb, Vb, Carry : Sl_X01; @@ -703,7 +787,7 @@ package body Synth.Ieee.Numeric_Std is function To_Signed (Val : Int64; Vtyp : Type_Acc) return Memtyp is - Vlen : constant Uns32 := Vtyp.Vbound.Len; + Vlen : constant Uns32 := Vtyp.Abound.Len; Uval : constant Uns64 := To_Uns64 (Val); Res : Memtyp; E : Std_Ulogic; @@ -720,22 +804,24 @@ package body Synth.Ieee.Numeric_Std is return Res; end To_Signed; - function Mul_Int_Sgn (L : Int64; R : Memtyp; Loc : Syn_Src) return Memtyp + function Mul_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp is Lv : Memtyp; begin - if R.Typ.Vbound.Len = 0 then + if R.Typ.Abound.Len = 0 then return Create_Memory (R.Typ); -- FIXME: typ end if; Lv := To_Signed (L, R.Typ); return Mul_Sgn_Sgn (Lv, R, Loc); end Mul_Int_Sgn; - function Mul_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp + function Mul_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp is Rv : Memtyp; begin - if L.Typ.Vbound.Len = 0 then + if L.Typ.Abound.Len = 0 then return Create_Memory (L.Typ); -- FIXME: typ end if; Rv := To_Signed (R, L.Typ); @@ -745,7 +831,7 @@ package body Synth.Ieee.Numeric_Std is -- Note: SRC = DST is allowed. procedure Neg_Vec (Src : Memory_Ptr; Dst : Memory_Ptr; Typ : Type_Acc) is - Len : constant Uns32 := Typ.Vbound.Len; + Len : constant Uns32 := Typ.Abound.Len; Vb, Carry : Sl_X01; begin Carry := '1'; @@ -772,9 +858,25 @@ package body Synth.Ieee.Numeric_Std is Neg_Vec (V.Mem, V.Mem, V.Typ); end Neg_Vec; - function Neg_Vec (V : Memtyp; Loc : Syn_Src) return Memtyp + function Has_0x (V : Memtyp) return Sl_X01 is - Len : constant Uns32 := V.Typ.Vbound.Len; + Res : Sl_X01 := '0'; + E : Sl_X01; + begin + for I in 0 .. V.Typ.Abound.Len - 1 loop + E := To_X01 (Read_Std_Logic (V.Mem, I)); + if E = 'X' then + return 'X'; + elsif E = '1' then + Res := '1'; + end if; + end loop; + return Res; + end Has_0x; + + function Neg_Vec (V : Memtyp; Loc : Location_Type) return Memtyp + is + Len : constant Uns32 := V.Typ.Abound.Len; Res : Memtyp; begin Res.Typ := Create_Res_Type (V.Typ, Len); @@ -784,10 +886,12 @@ package body Synth.Ieee.Numeric_Std is return Res; end if; - Neg_Vec (V.Mem, Res.Mem, V.Typ); - if Read_Std_Logic (Res.Mem, 0) = 'X' then + if Has_0x (V) = 'X' then Warning_Msg_Synth (+Loc, "NUMERIC_STD.""-"": non logical value detected"); + Fill (Res, 'X'); + else + Neg_Vec (V.Mem, Res.Mem, V.Typ); end if; return Res; end Neg_Vec; @@ -808,10 +912,10 @@ package body Synth.Ieee.Numeric_Std is end loop; end To_01X; - function Abs_Vec (V : Memtyp; Loc : Syn_Src) return Memtyp + function Abs_Vec (V : Memtyp; Loc : Location_Type) return Memtyp is pragma Unreferenced (Loc); - Len : constant Uns32 := V.Typ.Vbound.Len; + Len : constant Uns32 := V.Typ.Abound.Len; Res : Memtyp; Msb : Sl_X01; begin @@ -844,7 +948,6 @@ package body Synth.Ieee.Numeric_Std is Res := Create_Memory (Res.Typ); if Len = 0 then - Fill (Res, '0'); return Res; end if; @@ -883,31 +986,87 @@ package body Synth.Ieee.Numeric_Std is return Res; end Shift_Vec; - function Resize_Vec (Val : Memtyp; - Size : Uns32; - Signed : Boolean) return Memtyp + function Rotate_Vec (Val : Memtyp; + Amt : Uns32; + Right : Boolean) return Memtyp is - Old_Size : constant Uns32 := Uns32 (Vec_Length (Val.Typ)); + Len : constant Uns32 := Uns32 (Vec_Length (Val.Typ)); + Cnt : Uns32; Res : Memtyp; - Pad, B : Std_Ulogic; + B : Std_Ulogic; begin - Res.Typ := Create_Res_Type (Val.Typ, Size); + Res.Typ := Create_Res_Type (Val.Typ, Len); Res := Create_Memory (Res.Typ); + if Len = 0 then + return Res; + end if; + + Cnt := Amt rem Len; + pragma Unreferenced (Amt); + + if Right then + for I in 1 .. Len - Cnt loop + B := Read_Std_Logic (Val.Mem, I - 1); + Write_Std_Logic (Res.Mem, Cnt + I - 1, B); + end loop; + for I in 1 .. Cnt loop + B := Read_Std_Logic (Val.Mem, Len - I); + Write_Std_Logic (Res.Mem, Cnt - I, B); + end loop; + else + for I in 1 .. Cnt loop + B := Read_Std_Logic (Val.Mem, I - 1); + Write_Std_Logic (Res.Mem, Len - Cnt + I - 1, B); + end loop; + for I in 1 .. Len - Cnt loop + B := Read_Std_Logic (Val.Mem, Len - I); + Write_Std_Logic (Res.Mem, Len - Cnt - I, B); + end loop; + end if; + return Res; + end Rotate_Vec; + + procedure Resize_Vec (Dest : Memtyp; Val : Memtyp; Signed : Boolean) + is + Size : constant Uns32 := Dest.Typ.Abound.Len; + Old_Size : constant Uns32 := Val.Typ.Abound.Len; + L : Uns32; + Pad, B : Std_Ulogic; + begin + if Size = 0 then + return; + end if; + if Signed and then Old_Size > 0 then Pad := Read_Std_Logic (Val.Mem, 0); + Write_Std_Logic (Dest.Mem, 0, Pad); + L := Size - 1; else Pad := '0'; + L := Size; end if; - for I in 1 .. Size loop + for I in 1 .. L loop if I <= Old_Size then B := Read_Std_Logic (Val.Mem, Old_Size - I); else B := Pad; end if; - Write_Std_Logic (Res.Mem, Size - I, B); + Write_Std_Logic (Dest.Mem, Size - I, B); end loop; + end Resize_Vec; + + function Resize_Vec (Val : Memtyp; + Size : Uns32; + Signed : Boolean) return Memtyp + is + Res : Memtyp; + begin + Res.Typ := Create_Res_Type (Val.Typ, Size); + Res := Create_Memory (Res.Typ); + + Resize_Vec (Res, Val, Signed); return Res; end Resize_Vec; @@ -916,11 +1075,11 @@ package body Synth.Ieee.Numeric_Std is procedure Divmod (Num, Dem : Memtyp; Quot, Remain : Memtyp) is - Nlen : constant Uns32 := Num.Typ.Vbound.Len; - Dlen : constant Uns32 := Dem.Typ.Vbound.Len; + Nlen : constant Uns32 := Num.Typ.Abound.Len; + Dlen : constant Uns32 := Dem.Typ.Abound.Len; pragma Assert (Nlen > 0); pragma Assert (Dlen > 0); - pragma Assert (Quot.Typ.Vbound.Len = Nlen); + pragma Assert (Quot.Typ = null or else Quot.Typ.Abound.Len = Nlen); Reg : Std_Logic_Vector_Type (0 .. Dlen); Sub : Std_Logic_Vector_Type (0 .. Dlen - 1); Carry : Sl_X01; @@ -944,40 +1103,26 @@ package body Synth.Ieee.Numeric_Std is -- Extra REG bit. Carry := Compute_Carry (Carry, Reg (0), '1'); -- Test - Write_Std_Logic (Quot.Mem, I, Carry); + if Quot.Mem /= null then + Write_Std_Logic (Quot.Mem, I, Carry); + end if; if Carry = '1' then Reg (0) := '0'; Reg (1 .. Dlen) := Sub; end if; end loop; if Remain /= Null_Memtyp then - pragma Assert (Remain.Typ.Vbound.Len = Dlen); + pragma Assert (Remain.Typ.Abound.Len = Dlen); for I in 0 .. Dlen - 1 loop Write_Std_Logic (Remain.Mem, I, Reg (I + 1)); end loop; end if; end Divmod; - function Has_0x (V : Memtyp) return Sl_X01 + function Div_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp is - Res : Sl_X01 := '0'; - E : Sl_X01; - begin - for I in 0 .. V.Typ.Vbound.Len - 1 loop - E := To_X01 (Read_Std_Logic (V.Mem, I)); - if E = 'X' then - return 'X'; - elsif E = '1' then - Res := '1'; - end if; - end loop; - return Res; - end Has_0x; - - function Div_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp - is - Nlen : constant Uns32 := L.Typ.Vbound.Len; - Dlen : constant Uns32 := R.Typ.Vbound.Len; + Nlen : constant Uns32 := L.Typ.Abound.Len; + Dlen : constant Uns32 := R.Typ.Abound.Len; Quot : Memtyp; R0 : Sl_X01; begin @@ -1003,10 +1148,34 @@ package body Synth.Ieee.Numeric_Std is return Quot; end Div_Uns_Uns; - function Div_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp + function Div_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp + is + Rv : Memtyp; + begin + if L.Typ.Abound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ + end if; + Rv := To_Unsigned (R, L.Typ); + return Div_Uns_Uns (L, Rv, Loc); + end Div_Uns_Nat; + + function Div_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp + is + Lv : Memtyp; + begin + if R.Typ.Abound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ + end if; + Lv := To_Unsigned (L, R.Typ); + return Div_Uns_Uns (Lv, R, Loc); + end Div_Nat_Uns; + + function Div_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp is - Nlen : constant Uns32 := L.Typ.Vbound.Len; - Dlen : constant Uns32 := R.Typ.Vbound.Len; + Nlen : constant Uns32 := L.Typ.Abound.Len; + Dlen : constant Uns32 := R.Typ.Abound.Len; Quot : Memtyp; R0 : Sl_X01; Lu : Memtyp; @@ -1057,4 +1226,449 @@ package body Synth.Ieee.Numeric_Std is return Quot; end Div_Sgn_Sgn; + function Div_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp + is + Rv : Memtyp; + begin + if L.Typ.Abound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ + end if; + Rv := To_Signed (R, L.Typ); + return Div_Sgn_Sgn (L, Rv, Loc); + end Div_Sgn_Int; + + function Div_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp + is + Lv : Memtyp; + begin + if R.Typ.Abound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ + end if; + Lv := To_Signed (L, R.Typ); + return Div_Sgn_Sgn (Lv, R, Loc); + end Div_Int_Sgn; + + function Rem_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp + is + Nlen : constant Uns32 := L.Typ.Abound.Len; + Dlen : constant Uns32 := R.Typ.Abound.Len; + Rema : Memtyp; + R0 : Sl_X01; + begin + Rema.Typ := Create_Res_Type (R.Typ, Dlen); + Rema := Create_Memory (Rema.Typ); + if Nlen = 0 or Dlen = 0 then + return Rema; + end if; + + R0 := Has_0x (R); + if Has_0x (L) = 'X' or R0 = 'X' then + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""rem"": non logical value detected"); + Fill (Rema, 'X'); + return Rema; + end if; + if R0 = '0' then + Error_Msg_Synth (+Loc, "NUMERIC_STD.""rem"": division by 0"); + Fill (Rema, 'X'); + return Rema; + end if; + Divmod (L, R, Null_Memtyp, Rema); + return Rema; + end Rem_Uns_Uns; + + function Rem_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp + is + Rv : Memtyp; + begin + if L.Typ.Abound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ + end if; + Rv := To_Unsigned (R, L.Typ); + return Rem_Uns_Uns (L, Rv, Loc); + end Rem_Uns_Nat; + + function Rem_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp + is + Lv : Memtyp; + begin + if R.Typ.Abound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ + end if; + Lv := To_Unsigned (L, R.Typ); + return Rem_Uns_Uns (Lv, R, Loc); + end Rem_Nat_Uns; + + function Rem_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp + is + Nlen : constant Uns32 := L.Typ.Abound.Len; + Dlen : constant Uns32 := R.Typ.Abound.Len; + Rema : Memtyp; + R0 : Sl_X01; + Lu : Memtyp; + Ru : Memtyp; + Neg : Boolean; + begin + Rema.Typ := Create_Res_Type (L.Typ, Dlen); + Rema := Create_Memory (Rema.Typ); + if Nlen = 0 or Dlen = 0 then + return Rema; + end if; + + R0 := Has_0x (R); + if Has_0x (L) = 'X' or R0 = 'X' then + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""rem"": non logical value detected"); + Fill (Rema, 'X'); + return Rema; + end if; + if R0 = '0' then + Error_Msg_Synth (+Loc, "NUMERIC_STD.""rem"": division by 0"); + Fill (Rema, 'X'); + return Rema; + end if; + + if To_X01 (Read_Std_Logic (L.Mem, 0)) = '1' then + Lu.Typ := L.Typ; + Lu.Mem := Neg_Vec_Notyp (L); + Neg := True; + else + Neg := False; + Lu := L; + end if; + + if To_X01 (Read_Std_Logic (R.Mem, 0)) = '1' then + Ru.Typ := R.Typ; + Ru.Mem := Neg_Vec_Notyp (R); + else + Ru := R; + end if; + + Divmod (Lu, Ru, Null_Memtyp, Rema); + + -- Result of rem has the sign of the dividend. + if Neg then + Neg_Vec (Rema); + end if; + return Rema; + end Rem_Sgn_Sgn; + + function Rem_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp + is + Rv : Memtyp; + begin + if L.Typ.Abound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ + end if; + Rv := To_Signed (R, L.Typ); + return Rem_Sgn_Sgn (L, Rv, Loc); + end Rem_Sgn_Int; + + function Rem_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp + is + Lv : Memtyp; + begin + if R.Typ.Abound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ + end if; + Lv := To_Signed (L, R.Typ); + return Rem_Sgn_Sgn (Lv, R, Loc); + end Rem_Int_Sgn; + + function Mod_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp + is + Nlen : constant Uns32 := L.Typ.Abound.Len; + Dlen : constant Uns32 := R.Typ.Abound.Len; + Rema : Memtyp; + R0 : Sl_X01; + Lu : Memtyp; + Ru : Memtyp; + L_Neg, R_Neg : Boolean; + begin + Rema.Typ := Create_Res_Type (L.Typ, Dlen); + Rema := Create_Memory (Rema.Typ); + if Nlen = 0 or Dlen = 0 then + return Rema; + end if; + + R0 := Has_0x (R); + if Has_0x (L) = 'X' or R0 = 'X' then + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.""rem"": non logical value detected"); + Fill (Rema, 'X'); + return Rema; + end if; + if R0 = '0' then + Error_Msg_Synth (+Loc, "NUMERIC_STD.""rem"": division by 0"); + Fill (Rema, 'X'); + return Rema; + end if; + + if To_X01 (Read_Std_Logic (L.Mem, 0)) = '1' then + Lu.Typ := L.Typ; + Lu.Mem := Neg_Vec_Notyp (L); + L_Neg := True; + else + Lu := L; + L_Neg := False; + end if; + + if To_X01 (Read_Std_Logic (R.Mem, 0)) = '1' then + Ru.Typ := R.Typ; + Ru.Mem := Neg_Vec_Notyp (R); + R_Neg := True; + else + Ru := R; + R_Neg := False; + end if; + + Divmod (Lu, Ru, Null_Memtyp, Rema); + + if Has_0x (Rema) = '0' then + -- If the remainder is 0, then the modulus is 0. + return Rema; + else + -- Result of rem has the sign of the divisor. + if R_Neg then + if L_Neg then + Neg_Vec (Rema); + return Rema; + else + return Add_Vec_Vec (R, Rema, True, Loc); + end if; + else + if L_Neg then + return Sub_Vec_Vec (R, Rema, True, Loc); + else + return Rema; + end if; + end if; + end if; + end Mod_Sgn_Sgn; + + function Mod_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp + is + Rv : Memtyp; + begin + if L.Typ.Abound.Len = 0 then + return Create_Memory (L.Typ); -- FIXME: typ + end if; + Rv := To_Signed (R, L.Typ); + return Mod_Sgn_Sgn (L, Rv, Loc); + end Mod_Sgn_Int; + + function Mod_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp + is + Lv : Memtyp; + begin + if R.Typ.Abound.Len = 0 then + return Create_Memory (R.Typ); -- FIXME: typ + end if; + Lv := To_Signed (L, R.Typ); + return Mod_Sgn_Sgn (Lv, R, Loc); + end Mod_Int_Sgn; + + function Minmax (L, R : Memtyp; Is_Signed : Boolean; Is_Max : Boolean) + return Memtyp + is + Len : constant Uns32 := Uns32'Max (L.Typ.Abound.Len, R.Typ.Abound.Len); + Res : Memtyp; + Lt : Boolean; + begin + if L.Typ.Abound.Len = 0 or R.Typ.Abound.Len = 0 then + Res.Typ := Create_Res_Type (L.Typ, 0); + Res := Create_Memory (Res.Typ); + return Res; + end if; + + Res.Typ := Create_Res_Type (L.Typ, Len); + Res := Create_Memory (Res.Typ); + + if Has_0x (L) = 'X' or else Has_0x (R) = 'X' then + Fill (Res, 'X'); + return Res; + end if; + + if Is_Signed then + Lt := Compare_Sgn_Sgn (L, R, Less, No_Location) = Less; + else + Lt := Compare_Uns_Uns (L, R, Less, No_Location) = Less; + end if; + + if Lt xor Is_Max then + Resize_Vec (Res, L, False); + else + Resize_Vec (Res, R, False); + end if; + return Res; + end Minmax; + + function Offset_To_Index (Off : Int32; Typ : Type_Acc) return Int32 is + begin + case Typ.Abound.Dir is + when Dir_To => + return Typ.Abound.Left + Off; + when Dir_Downto => + return Typ.Abound.Left - Off; + end case; + end Offset_To_Index; + + function Find_Rightmost (Arg : Memtyp; Val : Memtyp) return Int32 + is + Len : constant Uns32 := Arg.Typ.Abound.Len; + Y : Std_Ulogic; + begin + Y := Read_Std_Logic (Val.Mem, 0); + + for I in reverse 1 .. Len loop + if Match_Eq_Table (Read_Std_Logic (Arg.Mem, I - 1), Y) = '1' then + return Offset_To_Index (Int32 (I - 1), Arg.Typ); + end if; + end loop; + return -1; + end Find_Rightmost; + + function Find_Leftmost (Arg : Memtyp; Val : Memtyp) return Int32 + is + Len : constant Uns32 := Arg.Typ.Abound.Len; + Y : Std_Ulogic; + begin + Y := Read_Std_Logic (Val.Mem, 0); + + for I in 1 .. Len loop + if Match_Eq_Table (Read_Std_Logic (Arg.Mem, I - 1), Y) = '1' then + return Offset_To_Index (Int32 (I - 1), Arg.Typ); + end if; + end loop; + return -1; + end Find_Leftmost; + + function Match_Vec (L, R : Memtyp; Loc : Location_Type) return Boolean + is + Llen : constant Uns32 := L.Typ.Abound.Len; + Rlen : constant Uns32 := R.Typ.Abound.Len; + begin + if Llen = 0 or Rlen = 0 then + Warn_Compare_Null (Loc); + return False; + end if; + if Llen /= Rlen then + Warning_Msg_Synth + (+Loc, "NUMERIC_STD.STD_MATCH: length mismatch, returning FALSE"); + return False; + end if; + + for I in 1 .. Llen loop + if Match_Eq_Table (Read_Std_Logic (L.Mem, I - 1), + Read_Std_Logic (R.Mem, I - 1)) /= '1' + then + return False; + end if; + end loop; + return True; + end Match_Vec; + + function Match_Eq_Vec_Vec (Left, Right : Memtyp; + Is_Signed : Boolean; + Loc : Location_Type) return Std_Ulogic + is + Lw : constant Uns32 := Left.Typ.W; + Rw : constant Uns32 := Right.Typ.W; + Len : constant Uns32 := Uns32'Max (Left.Typ.W, Right.Typ.W); + L, R, T : Std_Ulogic; + Res : Std_Ulogic; + begin + if Len = 0 then + Warn_Compare_Null (Loc); + return 'X'; + end if; + + Res := '1'; + for I in 1 .. Len loop + if I > Lw then + if not Is_Signed then + L := '0'; + end if; + else + L := Read_Std_Logic (Left.Mem, Lw - I); + end if; + if I > Rw then + if not Is_Signed then + R := '0'; + end if; + else + R := Read_Std_Logic (Right.Mem, Rw - I); + end if; + T := Match_Eq_Table (L, R); + if T = 'U' then + return T; + elsif T = 'X' or Res = 'X' then + -- Lower priority than 'U'. + Res := 'X'; + elsif T = '0' then + Res := '0'; + end if; + end loop; + return Res; + end Match_Eq_Vec_Vec; + + function Has_Xd (V : Memtyp) return Std_Ulogic + is + Res : Std_Ulogic; + E : Std_Ulogic; + begin + Res := '0'; + for I in 0 .. V.Typ.Abound.Len - 1 loop + E := Read_Std_Logic (V.Mem, I); + if E = '-' then + return '-'; + elsif To_X01 (E) = 'X' then + Res := 'X'; + end if; + end loop; + return Res; + end Has_Xd; + + function Match_Cmp_Vec_Vec (Left, Right : Memtyp; + Map : Order_Map_Type; + Is_Signed : Boolean; + Loc : Location_Type) return Memtyp + is + Llen : constant Uns32 := Left.Typ.Abound.Len; + Rlen : constant Uns32 := Right.Typ.Abound.Len; + L, R : Std_Ulogic; + Res : Std_Ulogic; + Cmp : Order_Type; + begin + if Rlen = 0 or Llen = 0 then + Warn_Compare_Null (Loc); + Res := 'X'; + else + L := Has_Xd (Left); + R := Has_Xd (Right); + if L = '-' or R = '-' then + Warning_Msg_Synth (+Loc, "'-' found in compare string"); + Res := 'X'; + elsif L = 'X' or R = 'X' then + Res := 'X'; + else + if Is_Signed then + Cmp := Compare_Sgn_Sgn (Left, Right, Equal, Loc); + else + Cmp := Compare_Uns_Uns (Left, Right, Equal, Loc); + end if; + Res := Map (Cmp); + end if; + end if; + + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Logic_Type); + end Match_Cmp_Vec_Vec; end Synth.Ieee.Numeric_Std; diff --git a/src/synth/synth-ieee-numeric_std.ads b/src/synth/synth-ieee-numeric_std.ads index 2d6ba68d5..81158954c 100644 --- a/src/synth/synth-ieee-numeric_std.ads +++ b/src/synth/synth-ieee-numeric_std.ads @@ -19,52 +19,103 @@ with Types; use Types; with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; -with Synth.Source; use Synth.Source; + +with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; package Synth.Ieee.Numeric_Std is -- Reminder: vectors elements are from left to right. - function Compare_Uns_Uns - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type; - function Compare_Uns_Nat - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type; - function Compare_Nat_Uns - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type; - function Compare_Sgn_Sgn - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type; - function Compare_Sgn_Int - (Left, Right : Memtyp; Err : Order_Type; Loc : Syn_Src) return Order_Type; + function Compare_Uns_Uns (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type; + function Compare_Uns_Nat (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type; + function Compare_Nat_Uns (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type; + function Compare_Sgn_Sgn (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type; + function Compare_Sgn_Int (Left, Right : Memtyp; + Err : Order_Type; + Loc : Location_Type) return Order_Type; -- Unary "-" - function Neg_Vec (V : Memtyp; Loc : Syn_Src) return Memtyp; + function Neg_Vec (V : Memtyp; Loc : Location_Type) return Memtyp; -- "abs" - function Abs_Vec (V : Memtyp; Loc : Syn_Src) return Memtyp; + function Abs_Vec (V : Memtyp; Loc : Location_Type) return Memtyp; + + -- Create a vector whose length is VEC'length, set to logic value VAL + -- at the lsb and filled with 0. + function Log_To_Vec (Val : Memtyp; Vec : Memtyp) return Memtyp; -- "+" - function Add_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Add_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Add_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp; - function Add_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp; + function Add_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Add_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Add_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp; + function Add_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp; -- "-" - function Sub_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Sub_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Sub_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp; - function Sub_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp; + function Sub_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Sub_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp; + function Sub_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp; + + function Sub_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Sub_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp; + function Sub_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp; -- "*" - function Mul_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Mul_Nat_Uns (L : Uns64; R : Memtyp; Loc : Syn_Src) return Memtyp; - function Mul_Uns_Nat (L : Memtyp; R : Uns64; Loc : Syn_Src) return Memtyp; + function Mul_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Mul_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp; + function Mul_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp; - function Mul_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Mul_Int_Sgn (L : Int64; R : Memtyp; Loc : Syn_Src) return Memtyp; - function Mul_Sgn_Int (L : Memtyp; R : Int64; Loc : Syn_Src) return Memtyp; + function Mul_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Mul_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp; + function Mul_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp; -- "/" - function Div_Uns_Uns (L, R : Memtyp; Loc : Syn_Src) return Memtyp; - function Div_Sgn_Sgn (L, R : Memtyp; Loc : Syn_Src) return Memtyp; + function Div_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Div_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp; + function Div_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp; + function Div_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Div_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp; + function Div_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp; + + -- "rem" + function Rem_Uns_Uns (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Rem_Uns_Nat (L : Memtyp; R : Uns64; Loc : Location_Type) + return Memtyp; + function Rem_Nat_Uns (L : Uns64; R : Memtyp; Loc : Location_Type) + return Memtyp; + function Rem_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) return Memtyp; + function Rem_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp; + function Rem_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp; + + -- "mod" + function Mod_Sgn_Sgn (L, R : Memtyp; Loc : Location_Type) + return Memtyp; + function Mod_Sgn_Int (L : Memtyp; R : Int64; Loc : Location_Type) + return Memtyp; + function Mod_Int_Sgn (L : Int64; R : Memtyp; Loc : Location_Type) + return Memtyp; -- Shift function Shift_Vec (Val : Memtyp; @@ -72,7 +123,41 @@ package Synth.Ieee.Numeric_Std is Right : Boolean; Arith : Boolean) return Memtyp; + -- Rotate + function Rotate_Vec (Val : Memtyp; + Amt : Uns32; + Right : Boolean) return Memtyp; + function Resize_Vec (Val : Memtyp; Size : Uns32; Signed : Boolean) return Memtyp; + + -- Minimum/Maximum. + function Minmax (L, R : Memtyp; Is_Signed : Boolean; Is_Max : Boolean) + return Memtyp; + + -- Find_Rightmost/Find_Leftmost + function Find_Rightmost (Arg : Memtyp; Val : Memtyp) return Int32; + function Find_Leftmost (Arg : Memtyp; Val : Memtyp) return Int32; + + -- Std_Match + function Match_Vec (L, R : Memtyp; Loc : Location_Type) return Boolean; + + -- Matching comparisons. + function Match_Eq_Vec_Vec (Left, Right : Memtyp; + Is_Signed : Boolean; + Loc : Location_Type) return Std_Ulogic; + + type Order_Map_Type is array (Order_Type) of X01; + + Map_Lt : constant Order_Map_Type := "100"; + Map_Le : constant Order_Map_Type := "110"; + Map_Ge : constant Order_Map_Type := "011"; + Map_Gt : constant Order_Map_Type := "001"; + + function Match_Cmp_Vec_Vec (Left, Right : Memtyp; + Map : Order_Map_Type; + Is_Signed : Boolean; + Loc : Location_Type) return Memtyp; + end Synth.Ieee.Numeric_Std; diff --git a/src/synth/synth-ieee-std_logic_1164.ads b/src/synth/synth-ieee-std_logic_1164.ads index 33a298f81..324fb2a52 100644 --- a/src/synth/synth-ieee-std_logic_1164.ads +++ b/src/synth/synth-ieee-std_logic_1164.ads @@ -44,7 +44,7 @@ package Synth.Ieee.Std_Logic_1164 is '-' -- Don't care. ); - subtype X01 is Std_Ulogic range 'X' .. '1'; + subtype X01 is Std_Ulogic range 'X' .. '1'; function Read_Std_Logic (M : Memory_Ptr; Off : Uns32) return Std_Ulogic; procedure Write_Std_Logic (M : Memory_Ptr; Off : Uns32; Val : Std_Ulogic); @@ -60,7 +60,11 @@ package Synth.Ieee.Std_Logic_1164 is type Table_1d_X01 is array (Std_Ulogic) of X01; - To_X01 : constant Table_1d_X01 := "XX01XX01X"; + -- UX01ZWLH- + To_X01 : constant Table_1d_X01 := "XX01XX01X"; + Map_X01 : constant Table_1d := "XX01XX01X"; + Map_X01Z : constant Table_1d := "XX01ZX01X"; -- Note: W => X + Map_UX01 : constant Table_1d := "UX01XX01X"; And_Table : constant Table_2d := -- UX01ZWLH- @@ -75,6 +79,19 @@ package Synth.Ieee.Std_Logic_1164 is "UX0XXX0XX" -- - ); + Nand_Table : constant Table_2d := + -- UX01ZWLH- + ("UU1UUU1UU", -- U + "UX1XXX1XX", -- X + "111111111", -- 0 + "UX10XX10X", -- 1 + "UX1XXX1XX", -- Z + "UX1XXX1XX", -- W + "111111111", -- L + "UX10XX10X", -- H + "UX1XXX1XX" -- - + ); + Or_Table : constant Table_2d := -- UX01ZWLH- ("UUU1UUU1U", -- U @@ -88,6 +105,19 @@ package Synth.Ieee.Std_Logic_1164 is "UXX1XXX1X" -- - ); + Nor_Table : constant Table_2d := + -- UX01ZWLH- + ("UUU0UUU0U", -- U + "UXX0XXX0X", -- X + "UX10XX10X", -- 0 + "000000000", -- 1 + "UXX0XXX0X", -- Z + "UXX0XXX0X", -- W + "UX10XX10X", -- L + "000000000", -- H + "UXX0XXX0X" -- - + ); + Xor_Table : constant Table_2d := -- UX01ZWLH- ("UUUUUUUUU", -- U @@ -101,8 +131,99 @@ package Synth.Ieee.Std_Logic_1164 is "UXXXXXXXX" -- - ); + Xnor_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX10XX10X", -- 0 + "UX01XX01X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX10XX10X", -- L + "UX01XX01X", -- H + "UXXXXXXXX" -- - + ); + Not_Table : constant Table_1d := -- UX01ZWLH- "UX10XX10X"; + Match_Eq_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUU1", -- U + "UXXXXXXX1", -- X + "UX10XX101", -- 0 + "UX01XX011", -- 1 + "UXXXXXXX1", -- Z + "UXXXXXXX1", -- W + "UX10XX101", -- L + "UX01XX011", -- H + "111111111" -- - + ); + + Match_Ne_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUU1", -- U + "UXXXXXXX1", -- X + "UX01XX011", -- 0 + "UX10XX101", -- 1 + "UXXXXXXX1", -- Z + "UXXXXXXX1", -- W + "UX01XX011", -- L + "UX10XX101", -- H + "111111111" -- - + ); + + Match_Le_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUU1", -- U + "UXXXXXXX1", -- X + "UX11XX111", -- 0 + "UX01XX011", -- 1 + "UXXXXXXX1", -- Z + "UXXXXXXX1", -- W + "UX11XX111", -- L + "UX01XX011", -- H + "111111111" -- - + ); + + Match_Lt_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUU1", -- U + "UXXXXXXX1", -- X + "UX01XX011", -- 0 + "UX00XX001", -- 1 + "UXXXXXXX1", -- Z + "UXXXXXXX1", -- W + "UX01XX011", -- L + "UX00XX001", -- H + "111111111" -- - + ); + + Match_Ge_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUU1", -- U + "UXXXXXXX1", -- X + "UX10XX101", -- 0 + "UX11XX111", -- 1 + "UXXXXXXX1", -- Z + "UXXXXXXX1", -- W + "UX10XX101", -- L + "UX11XX111", -- H + "111111111" -- - + ); + + Match_Gt_Table : constant Table_2d := + -- UX01ZWLH- + ("UUUUUUUU1", -- U + "UXXXXXXX1", -- X + "UX00XX001", -- 0 + "UX10XX101", -- 1 + "UXXXXXXX1", -- Z + "UXXXXXXX1", -- W + "UX00XX001", -- L + "UX10XX101", -- H + "111111111" -- - + ); + end Synth.Ieee.Std_Logic_1164; diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb index 6e7d3447f..bb355726e 100644 --- a/src/synth/synth-vhdl_aggr.adb +++ b/src/synth/synth-vhdl_aggr.adb @@ -82,17 +82,29 @@ package body Synth.Vhdl_Aggr is return (1 => 1); when Type_Array => declare - Bnds : constant Bound_Array_Acc := Typ.Abounds; - Res : Stride_Array (1 .. Bnds.Ndim); + T : Type_Acc; + Ndim : Dim_Type; + Res : Stride_Array (1 .. 16); + type Type_Acc_Array is array (Dim_Type range <>) of Type_Acc; + Arr_Typ : Type_Acc_Array (1 .. 16); Stride : Nat32; begin + T := Typ; + -- Compute number of dimensions. + Ndim := 1; + Arr_Typ (Ndim) := T; + while not T.Alast loop + Ndim := Ndim + 1; + T := T.Arr_El; + Arr_Typ (Ndim) := T; + end loop; Stride := 1; - for I in reverse 2 .. Bnds.Ndim loop - Res (Dim_Type (I)) := Stride; - Stride := Stride * Nat32 (Bnds.D (I).Len); + for I in reverse 2 .. Ndim loop + Res (I) := Stride; + Stride := Stride * Nat32 (Arr_Typ (I).Abound.Len); end loop; Res (1) := Stride; - return Res; + return Res (1 .. Ndim); end; when others => raise Internal_Error; @@ -110,7 +122,7 @@ package body Synth.Vhdl_Aggr is Err_P : out boolean) is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Bound : constant Bound_Type := Get_Array_Bound (Typ, Dim); + Bound : constant Bound_Type := Get_Array_Bound (Typ); El_Typ : constant Type_Acc := Get_Array_Element (Typ); Stride : constant Nat32 := Strides (Dim); Value : Node; @@ -126,7 +138,8 @@ package body Synth.Vhdl_Aggr is begin Nbr_Els := Nbr_Els + 1; - if Dim = Strides'Last then + if Typ.Alast then + pragma Assert (Dim = Strides'Last); Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ); Val := Synth_Subtype_Conversion (Ctxt, Val, El_Typ, False, Value); pragma Assert (Res (Pos) = No_Valtyp); @@ -140,7 +153,7 @@ package body Synth.Vhdl_Aggr is end if; else Fill_Array_Aggregate - (Syn_Inst, Value, Res, Typ, Pos, Strides, Dim + 1, + (Syn_Inst, Value, Res, El_Typ, Pos, Strides, Dim + 1, Sub_Const, Sub_Err); Const_P := Const_P and Sub_Const; Err_P := Err_P or Sub_Err; @@ -219,7 +232,7 @@ package body Synth.Vhdl_Aggr is begin Val := Synth_Expression_With_Basetype (Syn_Inst, Value); - Val_Len := Get_Bound_Length (Val.Typ, 1); + Val_Len := Get_Bound_Length (Val.Typ); pragma Assert (Stride = 1); if Pos - First_Pos > Nat32 (Bound.Len - Val_Len) then Error_Msg_Synth @@ -296,7 +309,7 @@ package body Synth.Vhdl_Aggr is (Syn_Inst, Value); -- The length must match the range. Rng_Len := Get_Range_Length (Rng); - if Get_Bound_Length (Val.Typ, 1) /= Rng_Len then + if Get_Bound_Length (Val.Typ) /= Rng_Len then Error_Msg_Synth (+Value, "length doesn't match range"); end if; @@ -502,7 +515,7 @@ package body Synth.Vhdl_Aggr is for I in Aggr_Type.Rec.E'Range loop -- Note: elements are put in reverse order in Tab_Res, -- so reverse again... - Write_Value (Res.Val.Mem + Res_Typ.Rec.E (I).Moff, + Write_Value (Res.Val.Mem + Res_Typ.Rec.E (I).Offs.Mem_Off, Tab_Res (Tab_Res'Last - Nat32 (I) + 1)); end loop; else diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index dc79aaa29..f9c1edb39 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -382,6 +382,22 @@ package body Synth.Vhdl_Context is return (Ntype, Create_Value_Net (N)); end Create_Value_Net; + function Create_Value_Dyn_Alias (Obj : Value_Acc; + Poff : Uns32; + Ptyp : Type_Acc; + Voff : Net; + Eoff : Uns32; + Typ : Type_Acc) return Valtyp is + begin + return (Typ, + Create_Value_Dyn_Alias (Obj, Poff, Ptyp, To_Uns32 (Voff), Eoff)); + end Create_Value_Dyn_Alias; + + function Get_Value_Dyn_Alias_Voff (Val : Value_Acc) return Net is + begin + return To_Net (Val.D_Voff); + end Get_Value_Dyn_Alias_Voff; + function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net is begin case Val.Val.Kind is @@ -429,7 +445,8 @@ package body Synth.Vhdl_Context is when Value_Memory => return True; when Value_Net - | Value_Signal => + | Value_Signal + | Value_Dyn_Alias => return False; when Value_Wire => declare diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads index df3e83d6a..59f18f960 100644 --- a/src/synth/synth-vhdl_context.ads +++ b/src/synth/synth-vhdl_context.ads @@ -107,6 +107,16 @@ package Synth.Vhdl_Context is -- Create a Value_Wire. For a bit wire, RNG must be null. function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp; + + -- Create a Value_Dyn_Alias + function Create_Value_Dyn_Alias (Obj : Value_Acc; + Poff : Uns32; + Ptyp : Type_Acc; + Voff : Net; + Eoff : Uns32; + Typ : Type_Acc) return Valtyp; + + function Get_Value_Dyn_Alias_Voff (Val : Value_Acc) return Net; private type Extra_Vhdl_Instance_Type is record Base : Base_Instance_Acc; diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index 840663054..56d7ab9e0 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -18,6 +18,7 @@ with Types; use Types; with Std_Names; +with Errorout; use Errorout; with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; @@ -135,7 +136,7 @@ package body Synth.Vhdl_Decls is Cst : Valtyp; Obj_Type : Type_Acc; begin - Elab_Declaration_Type (Syn_Inst, Decl); + Obj_Type := Elab_Declaration_Type (Syn_Inst, Decl); if Deferred_Decl = Null_Node or else Get_Deferred_Declaration_Flag (Decl) then @@ -169,7 +170,6 @@ package body Synth.Vhdl_Decls is end if; Last_Type := Decl_Type; end if; - Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type); Val := Synth_Expression_With_Type (Syn_Inst, Get_Default_Value (Decl), Obj_Type); if Val = No_Valtyp then @@ -379,7 +379,7 @@ package body Synth.Vhdl_Decls is Obj_Typ : Type_Acc; Wid : Wire_Id; begin - Elab_Declaration_Type (Syn_Inst, Decl); + Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl); if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then Error_Msg_Synth (+Decl, "protected type variable is not synthesizable"); @@ -388,8 +388,7 @@ package body Synth.Vhdl_Decls is return; end if; - Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type); - if not Obj_Typ.Is_Synth + if Obj_Typ.Wkind /= Wkind_Net and then not Get_Instance_Const (Syn_Inst) then Error_Msg_Synth @@ -400,7 +399,7 @@ package body Synth.Vhdl_Decls is if Is_Valid (Def) then Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); Init := Synth_Subtype_Conversion - (Ctxt, Init, Obj_Typ, False, Decl); + (Ctxt, Init, Obj_Typ, True, Decl); if not Is_Subprg and then not Is_Static (Init.Val) then @@ -597,7 +596,12 @@ package body Synth.Vhdl_Decls is (Syn_Inst, Get_Type_Definition (Decl), Get_Subtype_Definition (Decl)); when Iir_Kind_Subtype_Declaration => - Elab_Declaration_Type (Syn_Inst, Decl); + declare + T : Type_Acc; + begin + T := Elab_Declaration_Type (Syn_Inst, Decl); + pragma Unreferenced (T); + end; when Iir_Kind_Component_Declaration => null; when Iir_Kind_File_Declaration => @@ -697,10 +701,11 @@ package body Synth.Vhdl_Decls is -- TODO: maybe simply remove it. if Def_Val = No_Net then Warning_Msg_Synth - (+Decl, "%n is never assigned and has no default value", - (1 => +Decl)); + (Warnid_Nowrite, +Decl, + "%n is never assigned and has no default value", +Decl); else - Warning_Msg_Synth (+Decl, "%n is never assigned", (1 => +Decl)); + Warning_Msg_Synth + (Warnid_Nowrite, +Decl, "%n is never assigned", +Decl); end if; end if; if Def_Val = No_Net then diff --git a/src/synth/synth-vhdl_environment.adb b/src/synth/synth-vhdl_environment.adb index c7f7daccc..7e726993c 100644 --- a/src/synth/synth-vhdl_environment.adb +++ b/src/synth/synth-vhdl_environment.adb @@ -50,7 +50,7 @@ package body Synth.Vhdl_Environment is begin if Last_Off < First_Off then Warning_Msg_Synth - (+Decl.Obj, "no assignment for %n", +Decl.Obj); + (Warnid_Nowrite, +Decl.Obj, "no assignment for %n", +Decl.Obj); elsif Last_Off = First_Off then Warning_Msg_Synth (+Decl.Obj, "no assignment for offset %v of %n", (1 => +First_Off, 2 => +Decl.Obj)); @@ -124,7 +124,7 @@ package body Synth.Vhdl_Environment is Info_Msg_Synth (+Loc, " " & Prefix - & "(" & Info_Subrange_Vhdl (Off, Wd, Typ.Vbound) & ")"); + & "(" & Info_Subrange_Vhdl (Off, Wd, Typ.Abound) & ")"); end if; when Type_Slice | Type_Array => @@ -142,14 +142,14 @@ package body Synth.Vhdl_Environment is Sub_Off : Uns32; Sub_Wd : Width; begin - if Off + Wd <= El.Boff then + if Off + Wd <= El.Offs.Net_Off then -- Not covered anymore. exit; - elsif Off >= El.Boff + El.Typ.W then + elsif Off >= El.Offs.Net_Off + El.Typ.W then -- Not yet covered. null; - elsif Off <= El.Boff - and then Off + Wd >= El.Boff + El.Typ.W + elsif Off <= El.Offs.Net_Off + and then Off + Wd >= El.Offs.Net_Off + El.Typ.W then -- Fully covered. Info_Msg_Synth @@ -158,13 +158,13 @@ package body Synth.Vhdl_Environment is & Vhdl.Utils.Image_Identifier (Field)); else -- Partially covered. - if Off < El.Boff then + if Off < El.Offs.Net_Off then Sub_Off := 0; - Sub_Wd := Wd - (El.Boff - Off); + Sub_Wd := Wd - (El.Offs.Net_Off - Off); Sub_Wd := Width'Min (Sub_Wd, El.Typ.W); else - Sub_Off := Off - El.Boff; - Sub_Wd := El.Typ.W - (Off - El.Boff); + Sub_Off := Off - El.Offs.Net_Off; + Sub_Wd := El.Typ.W - (Off - El.Offs.Net_Off); Sub_Wd := Width'Min (Sub_Wd, Wd); end if; Info_Subnet_Vhdl diff --git a/src/synth/synth-vhdl_eval.adb b/src/synth/synth-vhdl_eval.adb index c6846718d..ab1304190 100644 --- a/src/synth/synth-vhdl_eval.adb +++ b/src/synth/synth-vhdl_eval.adb @@ -18,9 +18,14 @@ with Types; use Types; with Types_Utils; use Types_Utils; +with Name_Table; with Grt.Types; use Grt.Types; +with Grt.Vhdl_Types; use Grt.Vhdl_Types; +with Grt.To_Strings; +with Vhdl.Utils; +with Vhdl.Evaluation; with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164; with Elab.Memtype; use Elab.Memtype; @@ -47,20 +52,36 @@ package body Synth.Vhdl_Eval is (False => (others => False), True => (True => True, False => False)); + Tf_2d_Nand : constant Tf_Table_2d := + (False => (others => True), + True => (True => False, False => True)); + + Tf_2d_Or : constant Tf_Table_2d := + (False => (True => True, False => False), + True => (True => True, False => True)); + + Tf_2d_Nor : constant Tf_Table_2d := + (False => (True => False, False => True), + True => (True => False, False => False)); + Tf_2d_Xor : constant Tf_Table_2d := (False => (False => False, True => True), True => (False => True, True => False)); + Tf_2d_Xnor : constant Tf_Table_2d := + (False => (False => True, True => False), + True => (False => False, True => True)); + function Create_Res_Bound (Prev : Type_Acc) return Type_Acc is begin - if Prev.Vbound.Dir = Dir_Downto - and then Prev.Vbound.Right = 0 + if Prev.Abound.Dir = Dir_Downto + and then Prev.Abound.Right = 0 then -- Normalized range return Prev; end if; - return Create_Vec_Type_By_Length (Prev.W, Prev.Vec_El); + return Create_Vec_Type_By_Length (Prev.W, Prev.Arr_El); end Create_Res_Bound; function Eval_Vector_Dyadic (Left, Right : Memtyp; @@ -88,6 +109,62 @@ package body Synth.Vhdl_Eval is return Res; end Eval_Vector_Dyadic; + function Eval_Logic_Vector_Scalar (Vect, Scal : Memtyp; + Op : Table_2d) return Memtyp + is + Res : Memtyp; + Vs, Vv, Vr : Std_Ulogic; + begin + Res := Create_Memory (Create_Res_Bound (Vect.Typ)); + Vs := Read_Std_Logic (Scal.Mem, 0); + for I in 1 .. Vect.Typ.Abound.Len loop + Vv := Read_Std_Logic (Vect.Mem, I - 1); + Vr := Op (Vs, Vv); + Write_Std_Logic (Res.Mem, I - 1, Vr); + end loop; + return Res; + end Eval_Logic_Vector_Scalar; + + function Eval_Logic_Scalar (Left, Right : Memtyp; + Op : Table_2d; + Neg : Boolean := False) return Memtyp + is + Res : Std_Ulogic; + begin + Res := Op (Read_Std_Logic (Left.Mem, 0), Read_Std_Logic (Right.Mem, 0)); + if Neg then + Res := Not_Table (Res); + end if; + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Left.Typ); + end Eval_Logic_Scalar; + + function Eval_Vector_Match (Left, Right : Memtyp; + Neg : Boolean; + Loc : Syn_Src) return Memtyp + is + Res : Std_Ulogic; + begin + if Left.Typ.W /= Right.Typ.W then + Error_Msg_Synth (+Loc, "length of operands mismatch"); + return Null_Memtyp; + end if; + + Res := '1'; + for I in 1 .. Left.Typ.Abound.Len loop + declare + Ls : constant Std_Ulogic := Read_Std_Logic (Left.Mem, I - 1); + Rs : constant Std_Ulogic := Read_Std_Logic (Right.Mem, I - 1); + begin + Res := And_Table (Res, Match_Eq_Table (Ls, Rs)); + end; + end loop; + + if Neg then + Res := Not_Table (Res); + end if; + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Left.Typ.Arr_El); + end Eval_Vector_Match; + function Eval_TF_Vector_Dyadic (Left, Right : Memtyp; Op : Tf_Table_2d; Loc : Syn_Src) return Memtyp @@ -124,11 +201,189 @@ package body Synth.Vhdl_Eval is return Res; end Eval_TF_Array_Element; - function Get_Static_Ulogic (Op : Memtyp) return Std_Ulogic is + function Compare (L, R : Memtyp) return Order_Type is + begin + case L.Typ.Kind is + when Type_Bit + | Type_Logic => + declare + Lv : constant Ghdl_U8 := Read_U8 (L.Mem); + Rv : constant Ghdl_U8 := Read_U8 (R.Mem); + begin + if Lv < Rv then + return Less; + elsif Lv > Rv then + return Greater; + else + return Equal; + end if; + end; + when Type_Discrete => + pragma Assert (L.Typ.Sz = R.Typ.Sz); + if L.Typ.Sz = 1 then + declare + Lv : constant Ghdl_U8 := Read_U8 (L.Mem); + Rv : constant Ghdl_U8 := Read_U8 (R.Mem); + begin + if Lv < Rv then + return Less; + elsif Lv > Rv then + return Greater; + else + return Equal; + end if; + end; + elsif L.Typ.Sz = 4 then + declare + Lv : constant Ghdl_I32 := Read_I32 (L.Mem); + Rv : constant Ghdl_I32 := Read_I32 (R.Mem); + begin + if Lv < Rv then + return Less; + elsif Lv > Rv then + return Greater; + else + return Equal; + end if; + end; + else + raise Internal_Error; + end if; + when others => + raise Internal_Error; + end case; + end Compare; + + function Compare_Array (L, R : Memtyp) return Order_Type + is + Len : Uns32; + Res : Order_Type; + begin + Len := Uns32'Min (L.Typ.Abound.Len, R.Typ.Abound.Len); + for I in 1 .. Size_Type (Len) loop + Res := Compare + ((L.Typ.Arr_El, L.Mem + (I - 1) * L.Typ.Arr_El.Sz), + (R.Typ.Arr_El, R.Mem + (I - 1) * R.Typ.Arr_El.Sz)); + if Res /= Equal then + return Res; + end if; + end loop; + if L.Typ.Abound.Len > Len then + return Greater; + end if; + if R.Typ.Abound.Len > Len then + return Less; + end if; + return Equal; + end Compare_Array; + + -- Execute shift and rot. + -- ZERO is the value to be used for '0' (for shifts). + function Execute_Shift_Operator (Left : Memtyp; + Count : Int64; + Zero : Ghdl_U8; + Op : Iir_Predefined_Shift_Functions) + return Memtyp + is + Cnt : Uns32; + Len : constant Uns32 := Left.Typ.Abound.Len; + Dir_Left : Boolean; + P : Size_Type; + Res : Memtyp; + E : Ghdl_U8; begin - pragma Assert (Op.Typ.Kind = Type_Logic); - return Std_Ulogic'Val (Read_U8 (Op.Mem)); - end Get_Static_Ulogic; + -- LRM93 7.2.3 + -- That is, if R is 0 or if L is a null array, the return value is L. + if Count = 0 or else Len = 0 then + return Left; + end if; + + case Op is + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Rol => + Dir_Left := True; + when Iir_Predefined_Array_Srl + | Iir_Predefined_Array_Sra + | Iir_Predefined_Array_Ror => + Dir_Left := False; + end case; + if Count < 0 then + Cnt := Uns32 (-Count); + Dir_Left := not Dir_Left; + else + Cnt := Uns32 (Count); + end if; + + case Op is + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Srl => + E := Zero; + when Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Sra => + if Dir_Left then + E := Read_U8 (Left.Mem + Size_Type (Len - 1)); + else + E := Read_U8 (Left.Mem); + end if; + when Iir_Predefined_Array_Rol + | Iir_Predefined_Array_Ror => + Cnt := Cnt mod Len; + if not Dir_Left then + Cnt := (Len - Cnt) mod Len; + end if; + end case; + + Res := Create_Memory (Left.Typ); + P := 0; + + case Op is + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Srl + | Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Sra => + if Dir_Left then + if Cnt < Len then + for I in Cnt .. Len - 1 loop + Write_U8 (Res.Mem + P, + Read_U8 (Left.Mem + Size_Type (I))); + P := P + 1; + end loop; + else + Cnt := Len; + end if; + for I in 0 .. Cnt - 1 loop + Write_U8 (Res.Mem + P, E); + P := P + 1; + end loop; + else + if Cnt > Len then + Cnt := Len; + end if; + for I in 0 .. Cnt - 1 loop + Write_U8 (Res.Mem + P, E); + P := P + 1; + end loop; + for I in Cnt .. Len - 1 loop + Write_U8 (Res.Mem + P, + Read_U8 (Left.Mem + Size_Type (I - Cnt))); + P := P + 1; + end loop; + end if; + when Iir_Predefined_Array_Rol + | Iir_Predefined_Array_Ror => + for I in 1 .. Len loop + Write_U8 (Res.Mem + P, + Read_U8 (Left.Mem + Size_Type (Cnt))); + P := P + 1; + Cnt := Cnt + 1; + if Cnt = Len then + Cnt := 0; + end if; + end loop; + end case; + return Res; + end Execute_Shift_Operator; procedure Check_Integer_Overflow (Val : in out Int64; Typ : Type_Acc; Loc : Syn_Src) is @@ -234,17 +489,6 @@ package body Synth.Vhdl_Eval is (Read_Discrete (Left) ** Natural (Read_Discrete (Right)), Res_Typ); - when Iir_Predefined_Physical_Minimum - | Iir_Predefined_Integer_Minimum => - return Create_Memory_Discrete - (Int64'Min (Read_Discrete (Left), Read_Discrete (Right)), - Res_Typ); - when Iir_Predefined_Physical_Maximum - | Iir_Predefined_Integer_Maximum => - return Create_Memory_Discrete - (Int64'Max (Read_Discrete (Left), Read_Discrete (Right)), - Res_Typ); - when Iir_Predefined_Integer_Less_Equal | Iir_Predefined_Physical_Less_Equal | Iir_Predefined_Enum_Less_Equal => @@ -267,12 +511,14 @@ package body Synth.Vhdl_Eval is (Read_Discrete (Left) > Read_Discrete (Right)); when Iir_Predefined_Integer_Equality | Iir_Predefined_Physical_Equality - | Iir_Predefined_Enum_Equality => + | Iir_Predefined_Enum_Equality + | Iir_Predefined_Bit_Match_Equality => return Create_Memory_Boolean (Read_Discrete (Left) = Read_Discrete (Right)); when Iir_Predefined_Integer_Inequality | Iir_Predefined_Physical_Inequality - | Iir_Predefined_Enum_Inequality => + | Iir_Predefined_Enum_Inequality + | Iir_Predefined_Bit_Match_Inequality => return Create_Memory_Boolean (Read_Discrete (Left) /= Read_Discrete (Right)); @@ -333,9 +579,9 @@ package body Synth.Vhdl_Eval is when Iir_Predefined_Array_Array_Concat => declare L_Len : constant Iir_Index32 := - Iir_Index32 (Get_Bound_Length (Left.Typ, 1)); + Iir_Index32 (Get_Bound_Length (Left.Typ)); R_Len : constant Iir_Index32 := - Iir_Index32 (Get_Bound_Length (Right.Typ, 1)); + Iir_Index32 (Get_Bound_Length (Right.Typ)); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); Bnd : Bound_Type; @@ -344,7 +590,7 @@ package body Synth.Vhdl_Eval is begin Check_Matching_Bounds (Le_Typ, Re_Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length - (Get_Uarray_First_Index (Res_Typ).Drange, L_Len + R_Len); + (Get_Uarray_Index (Res_Typ).Drange, L_Len + R_Len); Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd, Le_Typ); Res := Create_Memory (Res_St); @@ -359,7 +605,7 @@ package body Synth.Vhdl_Eval is when Iir_Predefined_Element_Array_Concat => declare Rlen : constant Iir_Index32 := - Get_Array_Flat_Length (Right.Typ); + Iir_Index32 (Get_Bound_Length (Right.Typ)); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); Bnd : Bound_Type; Res_St : Type_Acc; @@ -367,7 +613,7 @@ package body Synth.Vhdl_Eval is begin Check_Matching_Bounds (Left.Typ, Re_Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length - (Get_Uarray_First_Index (Res_Typ).Drange, 1 + Rlen); + (Get_Uarray_Index (Res_Typ).Drange, 1 + Rlen); Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd, Re_Typ); Res := Create_Memory (Res_St); @@ -378,7 +624,8 @@ package body Synth.Vhdl_Eval is end; when Iir_Predefined_Array_Element_Concat => declare - Llen : constant Iir_Index32 := Get_Array_Flat_Length (Left.Typ); + Llen : constant Iir_Index32 := + Iir_Index32 (Get_Bound_Length (Left.Typ)); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); Bnd : Bound_Type; Res_St : Type_Acc; @@ -386,7 +633,7 @@ package body Synth.Vhdl_Eval is begin Check_Matching_Bounds (Le_Typ, Right.Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length - (Get_Uarray_First_Index (Res_Typ).Drange, Llen + 1); + (Get_Uarray_Index (Res_Typ).Drange, Llen + 1); Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd, Le_Typ); Res := Create_Memory (Res_St); @@ -395,234 +642,646 @@ package body Synth.Vhdl_Eval is Right.Mem, Right.Typ.Sz); return Res; end; + when Iir_Predefined_Element_Element_Concat => + declare + El_Typ : constant Type_Acc := Left.Typ; + Bnd : Bound_Type; + Res_St : Type_Acc; + Res : Memtyp; + begin + Check_Matching_Bounds (Left.Typ, Right.Typ, Expr); + Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length + (Get_Uarray_Index (Res_Typ).Drange, 2); + Res_St := Create_Onedimensional_Array_Subtype + (Res_Typ, Bnd, El_Typ); + Res := Create_Memory (Res_St); + Copy_Memory (Res.Mem, Left.Mem, El_Typ.Sz); + Copy_Memory (Res.Mem + El_Typ.Sz, + Right.Mem, El_Typ.Sz); + return Res; + end; when Iir_Predefined_Array_Equality - | Iir_Predefined_Record_Equality => - return Create_Memory_U8 - (Boolean'Pos (Is_Equal (Left, Right)), Boolean_Type); + | Iir_Predefined_Record_Equality + | Iir_Predefined_Bit_Array_Match_Equality => + return Create_Memory_Boolean (Is_Equal (Left, Right)); when Iir_Predefined_Array_Inequality - | Iir_Predefined_Record_Inequality => - return Create_Memory_U8 - (Boolean'Pos (not Is_Equal (Left, Right)), Boolean_Type); + | Iir_Predefined_Record_Inequality + | Iir_Predefined_Bit_Array_Match_Inequality => + return Create_Memory_Boolean (not Is_Equal (Left, Right)); when Iir_Predefined_Access_Equality => - return Create_Memory_U8 - (Boolean'Pos (Read_Access (Left) = Read_Access (Right)), - Boolean_Type); + return Create_Memory_Boolean + (Read_Access (Left) = Read_Access (Right)); when Iir_Predefined_Access_Inequality => - return Create_Memory_U8 - (Boolean'Pos (Read_Access (Left) /= Read_Access (Right)), - Boolean_Type); + return Create_Memory_Boolean + (Read_Access (Left) /= Read_Access (Right)); + when Iir_Predefined_Array_Less => + return Create_Memory_Boolean + (Compare_Array (Left, Right) = Less); + when Iir_Predefined_Array_Less_Equal => + return Create_Memory_Boolean + (Compare_Array (Left, Right) <= Equal); + when Iir_Predefined_Array_Greater => + return Create_Memory_Boolean + (Compare_Array (Left, Right) = Greater); + when Iir_Predefined_Array_Greater_Equal => + return Create_Memory_Boolean + (Compare_Array (Left, Right) >= Equal); + + when Iir_Predefined_Array_Maximum => + -- IEEE 1076-2008 5.3.2.4 Predefined operations on array types + if Compare_Array (Left, Right) = Less then + return Right; + else + return Left; + end if; + when Iir_Predefined_Array_Minimum => + -- IEEE 1076-2008 5.3.2.4 Predefined operations on array types + if Compare_Array (Left, Right) = Less then + return Left; + else + return Right; + end if; + + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Srl + | Iir_Predefined_Array_Rol + | Iir_Predefined_Array_Ror => + return Execute_Shift_Operator + (Left, Read_Discrete (Right), 0, Def); + + when Iir_Predefined_TF_Array_And => + return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_And, Expr); + when Iir_Predefined_TF_Array_Or => + return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Or, Expr); when Iir_Predefined_TF_Array_Xor => return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Xor, Expr); + when Iir_Predefined_TF_Array_Nand => + return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Nand, Expr); + when Iir_Predefined_TF_Array_Nor => + return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Nor, Expr); + when Iir_Predefined_TF_Array_Xnor => + return Eval_TF_Vector_Dyadic (Left, Right, Tf_2d_Xnor, Expr); + + when Iir_Predefined_TF_Element_Array_Or => + return Eval_TF_Array_Element (Left, Right, Tf_2d_Or); + when Iir_Predefined_TF_Array_Element_Or => + return Eval_TF_Array_Element (Right, Left, Tf_2d_Or); + + when Iir_Predefined_TF_Element_Array_Nor => + return Eval_TF_Array_Element (Left, Right, Tf_2d_Nor); + when Iir_Predefined_TF_Array_Element_Nor => + return Eval_TF_Array_Element (Right, Left, Tf_2d_Nor); when Iir_Predefined_TF_Element_Array_And => return Eval_TF_Array_Element (Left, Right, Tf_2d_And); when Iir_Predefined_TF_Array_Element_And => return Eval_TF_Array_Element (Right, Left, Tf_2d_And); + when Iir_Predefined_TF_Element_Array_Nand => + return Eval_TF_Array_Element (Left, Right, Tf_2d_Nand); + when Iir_Predefined_TF_Array_Element_Nand => + return Eval_TF_Array_Element (Right, Left, Tf_2d_Nand); + + when Iir_Predefined_TF_Element_Array_Xor => + return Eval_TF_Array_Element (Left, Right, Tf_2d_Xor); + when Iir_Predefined_TF_Array_Element_Xor => + return Eval_TF_Array_Element (Right, Left, Tf_2d_Xor); + + when Iir_Predefined_TF_Element_Array_Xnor => + return Eval_TF_Array_Element (Left, Right, Tf_2d_Xnor); + when Iir_Predefined_TF_Array_Element_Xnor => + return Eval_TF_Array_Element (Right, Left, Tf_2d_Xnor); + when Iir_Predefined_Ieee_1164_Vector_And | Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Sgn => return Eval_Vector_Dyadic (Left, Right, And_Table, Expr); + when Iir_Predefined_Ieee_1164_Vector_Nand + | Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Sgn => + return Eval_Vector_Dyadic (Left, Right, Nand_Table, Expr); + when Iir_Predefined_Ieee_1164_Vector_Or | Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Sgn => return Eval_Vector_Dyadic (Left, Right, Or_Table, Expr); + when Iir_Predefined_Ieee_1164_Vector_Nor + | Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Sgn => + return Eval_Vector_Dyadic (Left, Right, Nor_Table, Expr); + when Iir_Predefined_Ieee_1164_Vector_Xor | Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Sgn => return Eval_Vector_Dyadic (Left, Right, Xor_Table, Expr); - when Iir_Predefined_Ieee_1164_Scalar_Or => - return Create_Memory_U8 - (Std_Ulogic'Pos (Or_Table (Get_Static_Ulogic (Left), - Get_Static_Ulogic (Right))), - Res_Typ); + when Iir_Predefined_Ieee_1164_Vector_Xnor + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Sgn => + return Eval_Vector_Dyadic (Left, Right, Xnor_Table, Expr); when Iir_Predefined_Ieee_1164_Scalar_And => - return Create_Memory_U8 - (Std_Ulogic'Pos (And_Table (Get_Static_Ulogic (Left), - Get_Static_Ulogic (Right))), - Res_Typ); - + return Eval_Logic_Scalar (Left, Right, And_Table); + when Iir_Predefined_Ieee_1164_Scalar_Or => + return Eval_Logic_Scalar (Left, Right, Or_Table); when Iir_Predefined_Ieee_1164_Scalar_Xor => - return Create_Memory_U8 - (Std_Ulogic'Pos (Xor_Table (Get_Static_Ulogic (Left), - Get_Static_Ulogic (Right))), - Res_Typ); + return Eval_Logic_Scalar (Left, Right, Xor_Table); + when Iir_Predefined_Ieee_1164_Scalar_Nand => + return Eval_Logic_Scalar (Left, Right, Nand_Table); + when Iir_Predefined_Ieee_1164_Scalar_Nor => + return Eval_Logic_Scalar (Left, Right, Nor_Table); + when Iir_Predefined_Ieee_1164_Scalar_Xnor => + return Eval_Logic_Scalar (Left, Right, Xnor_Table); + + when Iir_Predefined_Std_Ulogic_Match_Equality => + return Eval_Logic_Scalar (Left, Right, Match_Eq_Table); + when Iir_Predefined_Std_Ulogic_Match_Inequality => + return Eval_Logic_Scalar (Left, Right, Match_Eq_Table, True); + when Iir_Predefined_Std_Ulogic_Match_Greater => + return Eval_Logic_Scalar (Left, Right, Match_Gt_Table); + when Iir_Predefined_Std_Ulogic_Match_Greater_Equal => + return Eval_Logic_Scalar (Left, Right, Match_Ge_Table); + when Iir_Predefined_Std_Ulogic_Match_Less_Equal => + return Eval_Logic_Scalar (Left, Right, Match_Le_Table); + when Iir_Predefined_Std_Ulogic_Match_Less => + return Eval_Logic_Scalar (Left, Right, Match_Lt_Table); + + when Iir_Predefined_Std_Ulogic_Array_Match_Equality => + return Eval_Vector_Match (Left, Right, False, Expr); + when Iir_Predefined_Std_Ulogic_Array_Match_Inequality => + return Eval_Vector_Match (Left, Right, True, Expr); + + when Iir_Predefined_Ieee_1164_And_Suv_Log + | Iir_Predefined_Ieee_Numeric_Std_And_Uns_Log + | Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Log => + return Eval_Logic_Vector_Scalar (Left, Right, And_Table); + when Iir_Predefined_Ieee_1164_Or_Suv_Log + | Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Log + | Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Log => + return Eval_Logic_Vector_Scalar (Left, Right, Or_Table); + when Iir_Predefined_Ieee_1164_Xor_Suv_Log + | Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Log + | Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Log => + return Eval_Logic_Vector_Scalar (Left, Right, Xor_Table); + when Iir_Predefined_Ieee_1164_Nand_Suv_Log + | Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Log + | Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Log => + return Eval_Logic_Vector_Scalar (Left, Right, Nand_Table); + when Iir_Predefined_Ieee_1164_Nor_Suv_Log + | Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Log + | Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Log => + return Eval_Logic_Vector_Scalar (Left, Right, Nor_Table); + when Iir_Predefined_Ieee_1164_Xnor_Suv_Log + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Log + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Log => + return Eval_Logic_Vector_Scalar (Left, Right, Xnor_Table); + + when Iir_Predefined_Ieee_1164_And_Log_Suv + | Iir_Predefined_Ieee_Numeric_Std_And_Log_Uns + | Iir_Predefined_Ieee_Numeric_Std_And_Log_Sgn => + return Eval_Logic_Vector_Scalar (Right, Left, And_Table); + when Iir_Predefined_Ieee_1164_Or_Log_Suv + | Iir_Predefined_Ieee_Numeric_Std_Or_Log_Uns + | Iir_Predefined_Ieee_Numeric_Std_Or_Log_Sgn => + return Eval_Logic_Vector_Scalar (Right, Left, Or_Table); + when Iir_Predefined_Ieee_1164_Xor_Log_Suv + | Iir_Predefined_Ieee_Numeric_Std_Xor_Log_Uns + | Iir_Predefined_Ieee_Numeric_Std_Xor_Log_Sgn => + return Eval_Logic_Vector_Scalar (Right, Left, Xor_Table); + when Iir_Predefined_Ieee_1164_Nand_Log_Suv + | Iir_Predefined_Ieee_Numeric_Std_Nand_Log_Uns + | Iir_Predefined_Ieee_Numeric_Std_Nand_Log_Sgn => + return Eval_Logic_Vector_Scalar (Right, Left, Nand_Table); + when Iir_Predefined_Ieee_1164_Nor_Log_Suv + | Iir_Predefined_Ieee_Numeric_Std_Nor_Log_Uns + | Iir_Predefined_Ieee_Numeric_Std_Nor_Log_Sgn => + return Eval_Logic_Vector_Scalar (Right, Left, Nor_Table); + when Iir_Predefined_Ieee_1164_Xnor_Log_Suv + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Log_Uns + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Log_Sgn => + return Eval_Logic_Vector_Scalar (Right, Left, Xnor_Table); + + when Iir_Predefined_Ieee_1164_Vector_Sll + | Iir_Predefined_Ieee_Numeric_Std_Sla_Uns_Int => + return Execute_Shift_Operator + (Left, Read_Discrete (Right), Std_Ulogic'Pos('0'), + Iir_Predefined_Array_Sll); + when Iir_Predefined_Ieee_1164_Vector_Srl + | Iir_Predefined_Ieee_Numeric_Std_Sra_Uns_Int => + return Execute_Shift_Operator + (Left, Read_Discrete (Right), Std_Ulogic'Pos('0'), + Iir_Predefined_Array_Srl); + when Iir_Predefined_Ieee_Numeric_Std_Sra_Sgn_Int => + declare + Cnt : constant Int64 := Read_Discrete (Right); + begin + if Cnt >= 0 then + return Execute_Shift_Operator + (Left, Cnt, Std_Ulogic'Pos('0'), Iir_Predefined_Array_Sra); + else + return Execute_Shift_Operator + (Left, -Cnt, Std_Ulogic'Pos('0'), + Iir_Predefined_Array_Sll); + end if; + end; + when Iir_Predefined_Ieee_Numeric_Std_Sla_Sgn_Int => + declare + Cnt : Int64; + Op : Iir_Predefined_Shift_Functions; + begin + Cnt := Read_Discrete (Right); + if Cnt >= 0 then + Op := Iir_Predefined_Array_Sll; + else + Cnt := -Cnt; + Op :=Iir_Predefined_Array_Sra; + end if; + return Execute_Shift_Operator + (Left, Cnt, Std_Ulogic'Pos('0'), Op); + end; + + when Iir_Predefined_Ieee_1164_Vector_Rol + | Iir_Predefined_Ieee_Numeric_Std_Rol_Uns_Int + | Iir_Predefined_Ieee_Numeric_Std_Rol_Sgn_Int => + return Execute_Shift_Operator + (Left, Read_Discrete (Right), Std_Ulogic'Pos('0'), + Iir_Predefined_Array_Rol); + when Iir_Predefined_Ieee_1164_Vector_Ror + | Iir_Predefined_Ieee_Numeric_Std_Ror_Uns_Int + | Iir_Predefined_Ieee_Numeric_Std_Ror_Sgn_Int => + return Execute_Shift_Operator + (Left, Read_Discrete (Right), Std_Ulogic'Pos('0'), + Iir_Predefined_Array_Ror); when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Uns => declare Res : Boolean; begin - Res := Compare_Uns_Uns (Left, Right, Greater, Expr) = Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Uns (Left, Right, Greater, +Expr) = Equal; + return Create_Memory_Boolean (Res); end; - when Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Sgn => + when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat => declare Res : Boolean; begin - Res := Compare_Sgn_Sgn (Left, Right, Greater, Expr) = Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Nat (Left, Right, Greater, +Expr) = Equal; + return Create_Memory_Boolean (Res); end; - when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat => + when Iir_Predefined_Ieee_Numeric_Std_Eq_Nat_Uns => + declare + Res : Boolean; + begin + Res := Compare_Uns_Nat (Right, Left, Greater, +Expr) = Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Sgn => declare Res : Boolean; begin - Res := Compare_Uns_Nat (Left, Right, Greater, Expr) = Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Sgn_Sgn (Left, Right, Greater, +Expr) = Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Int => declare Res : Boolean; begin - Res := Compare_Sgn_Int (Left, Right, Greater, Expr) = Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Sgn_Int (Left, Right, Greater, +Expr) = Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Eq_Int_Sgn => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Right, Left, Greater, +Expr) = Equal; + return Create_Memory_Boolean (Res); + end; + + when Iir_Predefined_Ieee_Numeric_Std_Ne_Uns_Uns => + declare + Res : Boolean; + begin + Res := Compare_Uns_Uns (Left, Right, Greater, +Expr) /= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ne_Uns_Nat => + declare + Res : Boolean; + begin + Res := Compare_Uns_Nat (Left, Right, Greater, +Expr) /= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ne_Nat_Uns => + declare + Res : Boolean; + begin + Res := Compare_Uns_Nat (Right, Left, Greater, +Expr) /= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ne_Sgn_Sgn => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Sgn (Left, Right, Greater, +Expr) /= Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Gt_Uns_Uns => declare Res : Boolean; begin - Res := Compare_Uns_Uns (Left, Right, Less, Expr) = Greater; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Uns (Left, Right, Less, +Expr) = Greater; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Gt_Sgn_Sgn => declare Res : Boolean; begin - Res := Compare_Sgn_Sgn (Left, Right, Less, Expr) = Greater; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Sgn_Sgn (Left, Right, Less, +Expr) = Greater; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Gt_Nat_Uns => declare Res : Boolean; begin - Res := Compare_Nat_Uns (Left, Right, Less, Expr) = Greater; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Nat_Uns (Left, Right, Less, +Expr) = Greater; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Gt_Uns_Nat => declare Res : Boolean; begin - Res := Compare_Uns_Nat (Left, Right, Less, Expr) = Greater; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Nat (Left, Right, Less, +Expr) = Greater; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Gt_Sgn_Int => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Left, Right, Less, +Expr) = Greater; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Gt_Int_Sgn => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Right, Left, Greater, +Expr) < Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Ge_Uns_Uns => declare Res : Boolean; begin - Res := Compare_Uns_Uns (Left, Right, Greater, Expr) >= Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Uns (Left, Right, Less, +Expr) >= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ge_Nat_Uns => + declare + Res : Boolean; + begin + Res := Compare_Nat_Uns (Left, Right, Less, +Expr) >= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ge_Uns_Nat => + declare + Res : Boolean; + begin + Res := Compare_Uns_Nat (Left, Right, Less, +Expr) >= Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Ge_Sgn_Sgn => declare Res : Boolean; begin - Res := Compare_Sgn_Sgn (Left, Right, Less, Expr) >= Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Sgn_Sgn (Left, Right, Less, +Expr) >= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ge_Sgn_Int => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Left, Right, Less, +Expr) >= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Ge_Int_Sgn => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Right, Left, Greater, +Expr) <= Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Le_Uns_Uns => declare Res : Boolean; begin - Res := Compare_Uns_Uns (Left, Right, Greater, Expr) <= Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Uns (Left, Right, Greater, +Expr) <= Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Le_Uns_Nat => declare Res : Boolean; begin - Res := Compare_Uns_Nat (Left, Right, Greater, Expr) <= Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Nat (Left, Right, Greater, +Expr) <= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Le_Nat_Uns => + declare + Res : Boolean; + begin + Res := Compare_Nat_Uns (Left, Right, Greater, +Expr) <= Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Le_Sgn_Sgn => declare Res : Boolean; begin - Res := Compare_Sgn_Sgn (Left, Right, Less, Expr) <= Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Sgn_Sgn (Left, Right, Greater, +Expr) <= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Le_Int_Sgn => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Right, Left, Less, +Expr) >= Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Le_Sgn_Int => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Left, Right, Greater, +Expr) <= Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Lt_Uns_Uns => declare Res : Boolean; begin - Res := Compare_Uns_Uns (Left, Right, Greater, Expr) < Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Uns (Left, Right, Greater, +Expr) < Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Lt_Uns_Nat => declare Res : Boolean; begin - Res := Compare_Uns_Nat (Left, Right, Greater, Expr) < Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Uns_Nat (Left, Right, Greater, +Expr) < Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Lt_Nat_Uns => declare Res : Boolean; begin - Res := Compare_Nat_Uns (Left, Right, Greater, Expr) < Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Nat_Uns (Left, Right, Greater, +Expr) < Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Lt_Sgn_Sgn => declare Res : Boolean; begin - Res := Compare_Sgn_Sgn (Left, Right, Less, Expr) < Equal; - return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + Res := Compare_Sgn_Sgn (Left, Right, Greater, +Expr) < Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Lt_Int_Sgn => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Right, Left, Less, +Expr) > Equal; + return Create_Memory_Boolean (Res); + end; + when Iir_Predefined_Ieee_Numeric_Std_Lt_Sgn_Int => + declare + Res : Boolean; + begin + Res := Compare_Sgn_Int (Left, Right, Greater, +Expr) < Equal; + return Create_Memory_Boolean (Res); end; when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Log - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Log - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Slv - | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Uns_Uns_Slv => - return Add_Uns_Uns (Left, Right, Expr); + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Slv + | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Uns_Uns_Slv + | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Uns_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Slv => + return Add_Uns_Uns (Left, Right, +Expr); - when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Int => - return Add_Sgn_Int (Left, Read_Discrete (Right), Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Log + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Log => + return Add_Uns_Uns (Left, Log_To_Vec (Right, Left), +Expr); - when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Int => - return Add_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), Expr); - when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Sgn => - return Add_Sgn_Sgn (Left, Right, Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Log_Uns + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Log_Slv => + return Add_Uns_Uns (Log_To_Vec (Left, Right), Right, +Expr); - when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Uns => - return Sub_Uns_Uns (Left, Right, Expr); - when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat => - return Sub_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Int + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Nat => + return Add_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Nat_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Nat_Slv + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Int_Slv => + return Add_Uns_Nat (Right, To_Uns64 (Read_Discrete (Left)), +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Sgn + | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Sgn_Sgn_Sgn => + return Add_Sgn_Sgn (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Int => + return Add_Sgn_Int (Left, Read_Discrete (Right), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Int_Sgn => + return Add_Sgn_Int (Right, Read_Discrete (Left), +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Log => + return Add_Sgn_Sgn (Left, Log_To_Vec (Right, Left), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Add_Log_Sgn => + return Add_Sgn_Sgn (Log_To_Vec (Left, Right), Right, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Slv + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Slv_Slv => + return Sub_Uns_Uns (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Nat + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Slv_Int => + return Sub_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Sub_Nat_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Nat_Slv + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Int_Slv => + return Sub_Nat_Uns (To_Uns64 (Read_Discrete (Left)), Right, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Log + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Slv_Log => + return Sub_Uns_Uns (Left, Log_To_Vec (Right, Left), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Sub_Log_Uns + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Log_Slv => + return Sub_Uns_Uns (Log_To_Vec (Left, Right), Right, +Expr); - when Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Int => - return Sub_Sgn_Int (Left, Read_Discrete (Right), Expr); when Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Sgn => - return Sub_Sgn_Sgn (Left, Right, Expr); + return Sub_Sgn_Sgn (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Int => + return Sub_Sgn_Int (Left, Read_Discrete (Right), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Sub_Int_Sgn => + return Sub_Int_Sgn (Read_Discrete (Left), Right, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Log => + return Sub_Sgn_Sgn (Left, Log_To_Vec (Right, Left), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Sub_Log_Sgn => + return Sub_Sgn_Sgn (Log_To_Vec (Left, Right), Right, +Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Uns_Uns => - return Mul_Uns_Uns (Left, Right, Expr); + return Mul_Uns_Uns (Left, Right, +Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Nat_Uns => - return Mul_Nat_Uns (To_Uns64 (Read_Discrete (Left)), Right, Expr); + return Mul_Nat_Uns (To_Uns64 (Read_Discrete (Left)), Right, +Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Uns_Nat => - return Mul_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), Expr); + return Mul_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), +Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Sgn => - return Mul_Sgn_Sgn (Left, Right, Expr); + return Mul_Sgn_Sgn (Left, Right, +Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Int => - return Mul_Sgn_Int (Left, Read_Discrete (Right), Expr); + return Mul_Sgn_Int (Left, Read_Discrete (Right), +Expr); when Iir_Predefined_Ieee_Numeric_Std_Mul_Int_Sgn => - return Mul_Int_Sgn (Read_Discrete (Left), Right, Expr); + return Mul_Int_Sgn (Read_Discrete (Left), Right, +Expr); when Iir_Predefined_Ieee_Numeric_Std_Div_Uns_Uns => - return Div_Uns_Uns (Left, Right, Expr); + return Div_Uns_Uns (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Div_Uns_Nat => + return Div_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Div_Nat_Uns => + return Div_Nat_Uns (To_Uns64 (Read_Discrete (Left)), Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Div_Sgn_Sgn => - return Div_Sgn_Sgn (Left, Right, Expr); + return Div_Sgn_Sgn (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Div_Int_Sgn => + return Div_Int_Sgn (Read_Discrete (Left), Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Div_Sgn_Int => + return Div_Sgn_Int (Left, Read_Discrete (Right), +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Rem_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Mod_Uns_Uns => + return Rem_Uns_Uns (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Rem_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Mod_Uns_Nat => + return Rem_Uns_Nat (Left, To_Uns64 (Read_Discrete (Right)), +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Rem_Nat_Uns + | Iir_Predefined_Ieee_Numeric_Std_Mod_Nat_Uns => + return Rem_Nat_Uns (To_Uns64 (Read_Discrete (Left)), Right, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Rem_Sgn_Sgn => + return Rem_Sgn_Sgn (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Rem_Int_Sgn => + return Rem_Int_Sgn (Read_Discrete (Left), Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Rem_Sgn_Int => + return Rem_Sgn_Int (Left, Read_Discrete (Right), +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Mod_Sgn_Sgn => + return Mod_Sgn_Sgn (Left, Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Mod_Int_Sgn => + return Mod_Int_Sgn (Read_Discrete (Left), Right, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Mod_Sgn_Int => + return Mod_Sgn_Int (Left, Read_Discrete (Right), +Expr); when Iir_Predefined_Ieee_Numeric_Std_Srl_Uns_Int | Iir_Predefined_Ieee_Numeric_Std_Srl_Sgn_Int => @@ -649,7 +1308,59 @@ package body Synth.Vhdl_Eval is end if; end; - when Iir_Predefined_Ieee_Math_Real_Pow => + when Iir_Predefined_Ieee_Numeric_Std_Match_Eq_Uns_Uns => + declare + Res : Std_Ulogic; + begin + Res := Match_Eq_Vec_Vec (Left, Right, False, +Expr); + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Res_Typ); + end; + when Iir_Predefined_Ieee_Numeric_Std_Match_Ne_Uns_Uns => + declare + Res : Std_Ulogic; + begin + Res := Match_Eq_Vec_Vec (Left, Right, False, +Expr); + Res := Not_Table (Res); + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Res_Typ); + end; + + when Iir_Predefined_Ieee_Numeric_Std_Match_Lt_Uns_Uns => + return Match_Cmp_Vec_Vec (Left, Right, Map_Lt, False, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Match_Lt_Sgn_Sgn => + return Match_Cmp_Vec_Vec (Left, Right, Map_Lt, True, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Match_Le_Uns_Uns => + return Match_Cmp_Vec_Vec (Left, Right, Map_Le, False, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Match_Le_Sgn_Sgn => + return Match_Cmp_Vec_Vec (Left, Right, Map_Le, True, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Match_Gt_Uns_Uns => + return Match_Cmp_Vec_Vec (Left, Right, Map_Gt, False, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Match_Gt_Sgn_Sgn => + return Match_Cmp_Vec_Vec (Left, Right, Map_Gt, True, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Match_Ge_Uns_Uns => + return Match_Cmp_Vec_Vec (Left, Right, Map_Ge, False, +Expr); + when Iir_Predefined_Ieee_Numeric_Std_Match_Ge_Sgn_Sgn => + return Match_Cmp_Vec_Vec (Left, Right, Map_Ge, True, +Expr); + + when Iir_Predefined_Ieee_Numeric_Std_Match_Eq_Sgn_Sgn => + declare + Res : Std_Ulogic; + begin + Res := Match_Eq_Vec_Vec (Left, Right, True, +Expr); + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Res_Typ); + end; + when Iir_Predefined_Ieee_Numeric_Std_Match_Ne_Sgn_Sgn => + declare + Res : Std_Ulogic; + begin + Res := Match_Eq_Vec_Vec (Left, Right, True, +Expr); + Res := Not_Table (Res); + return Create_Memory_U8 (Std_Ulogic'Pos (Res), Res_Typ); + end; + + when Iir_Predefined_Ieee_Math_Real_Pow_Real_Real => declare function Pow (L, R : Fp64) return Fp64; pragma Import (C, Pow); @@ -658,9 +1369,18 @@ package body Synth.Vhdl_Eval is (Pow (Read_Fp64 (Left), Read_Fp64 (Right)), Res_Typ); end; + when Iir_Predefined_Ieee_Math_Real_Mod => + declare + function Fmod (L, R : Fp64) return Fp64; + pragma Import (C, Fmod); + begin + return Create_Memory_Fp64 + (Fmod (Read_Fp64 (Left), Read_Fp64 (Right)), Res_Typ); + end; + when others => Error_Msg_Synth - (+Expr, "synth_static_dyadic_predefined: unhandled " + (+Expr, "eval_static_dyadic_predefined: unhandled " & Iir_Predefined_Functions'Image (Def)); return Null_Memtyp; end case; @@ -682,10 +1402,12 @@ package body Synth.Vhdl_Eval is return Res; end Eval_Vector_Monadic; - function Eval_Vector_Reduce - (Init : Std_Ulogic; Vec : Memtyp; Op : Table_2d) return Memtyp + function Eval_Vector_Reduce (Init : Std_Ulogic; + Vec : Memtyp; + Op : Table_2d; + Neg : Boolean) return Memtyp is - El_Typ : constant Type_Acc := Vec.Typ.Vec_El; + El_Typ : constant Type_Acc := Vec.Typ.Arr_El; Res : Std_Ulogic; begin Res := Init; @@ -697,9 +1419,160 @@ package body Synth.Vhdl_Eval is end; end loop; + if Neg then + Res := Not_Table (Res); + end if; + return Create_Memory_U8 (Std_Ulogic'Pos (Res), El_Typ); end Eval_Vector_Reduce; + function Eval_TF_Vector_Monadic (Vec : Memtyp) return Memtyp + is + Len : constant Iir_Index32 := Vec_Length (Vec.Typ); + Res : Memtyp; + begin + Res := Create_Memory (Create_Res_Bound (Vec.Typ)); + for I in 1 .. Uns32 (Len) loop + declare + V : constant Boolean := + Boolean'Val (Read_U8 (Vec.Mem + Size_Type (I - 1))); + begin + Write_U8 (Res.Mem + Size_Type (I - 1), Boolean'Pos (not V)); + end; + end loop; + return Res; + end Eval_TF_Vector_Monadic; + + function Eval_TF_Vector_Reduce (Init : Boolean; + Neg : Boolean; + Vec : Memtyp; + Op : Tf_Table_2d) return Memtyp + is + El_Typ : constant Type_Acc := Vec.Typ.Arr_El; + Res : Boolean; + begin + Res := Init; + for I in 1 .. Size_Type (Vec.Typ.Abound.Len) loop + declare + V : constant Boolean := Boolean'Val (Read_U8 (Vec.Mem + (I - 1))); + begin + Res := Op (Res, V); + end; + end loop; + + return Create_Memory_U8 (Boolean'Pos (Res xor Neg), El_Typ); + end Eval_TF_Vector_Reduce; + + function Eval_Vector_Maximum (Vec : Memtyp) return Memtyp + is + Etyp : constant Type_Acc := Vec.Typ.Arr_El; + Len : constant Uns32 := Vec.Typ.Abound.Len; + begin + case Etyp.Kind is + when Type_Logic + | Type_Bit + | Type_Discrete => + declare + Res : Int64; + V : Int64; + begin + case Etyp.Drange.Dir is + when Dir_To => + Res := Etyp.Drange.Left; + when Dir_Downto => + Res := Etyp.Drange.Right; + end case; + + for I in 1 .. Len loop + V := Read_Discrete + (Vec.Mem + Size_Type (I - 1) * Etyp.Sz, Etyp); + if V > Res then + Res := V; + end if; + end loop; + return Create_Memory_Discrete (Res, Etyp); + end; + when Type_Float => + declare + Res : Fp64; + V : Fp64; + begin + case Etyp.Frange.Dir is + when Dir_To => + Res := Etyp.Frange.Left; + when Dir_Downto => + Res := Etyp.Frange.Right; + end case; + + for I in 1 .. Len loop + V := Read_Fp64 + (Vec.Mem + Size_Type (I - 1) * Etyp.Sz); + if V > Res then + Res := V; + end if; + end loop; + return Create_Memory_Fp64 (Res, Etyp); + end; + when others => + raise Internal_Error; + end case; + end Eval_Vector_Maximum; + + function Eval_Vector_Minimum (Vec : Memtyp) return Memtyp + is + Etyp : constant Type_Acc := Vec.Typ.Arr_El; + Len : constant Uns32 := Vec.Typ.Abound.Len; + begin + case Etyp.Kind is + when Type_Logic + | Type_Bit + | Type_Discrete => + declare + Res : Int64; + V : Int64; + begin + case Etyp.Drange.Dir is + when Dir_To => + Res := Etyp.Drange.Right; + when Dir_Downto => + Res := Etyp.Drange.Left; + end case; + + for I in 1 .. Len loop + V := Read_Discrete + (Vec.Mem + Size_Type (I - 1) * Etyp.Sz, Etyp); + if V < Res then + Res := V; + end if; + end loop; + return Create_Memory_Discrete (Res, Etyp); + end; + when Type_Float => + declare + Res : Fp64; + V : Fp64; + begin + case Etyp.Frange.Dir is + when Dir_To => + Res := Etyp.Frange.Right; + when Dir_Downto => + Res := Etyp.Frange.Left; + end case; + + for I in 1 .. Len loop + V := Read_Fp64 + (Vec.Mem + Size_Type (I - 1) * Etyp.Sz); + if V < Res then + Res := V; + end if; + end loop; + return Create_Memory_Fp64 (Res, Etyp); + end; + when others => + raise Internal_Error; + end case; + end Eval_Vector_Minimum; + function Eval_Static_Monadic_Predefined (Imp : Node; Operand : Memtyp; Expr : Node) return Memtyp @@ -712,6 +1585,9 @@ package body Synth.Vhdl_Eval is | Iir_Predefined_Bit_Not => return Create_Memory_U8 (1 - Read_U8 (Operand), Operand.Typ); + when Iir_Predefined_Bit_Condition => + return Create_Memory_U8 (Read_U8 (Operand), Operand.Typ); + when Iir_Predefined_Integer_Negation | Iir_Predefined_Physical_Negation => return Create_Memory_Discrete @@ -719,7 +1595,7 @@ package body Synth.Vhdl_Eval is when Iir_Predefined_Integer_Absolute | Iir_Predefined_Physical_Absolute => return Create_Memory_Discrete - (abs Read_Discrete(Operand), Operand.Typ); + (abs Read_Discrete (Operand), Operand.Typ); when Iir_Predefined_Integer_Identity | Iir_Predefined_Physical_Identity => return Operand; @@ -731,6 +1607,27 @@ package body Synth.Vhdl_Eval is when Iir_Predefined_Floating_Absolute => return Create_Memory_Fp64 (abs Read_Fp64 (Operand), Operand.Typ); + when Iir_Predefined_Vector_Maximum => + return Eval_Vector_Maximum (Operand); + when Iir_Predefined_Vector_Minimum => + return Eval_Vector_Minimum (Operand); + + when Iir_Predefined_TF_Array_Not => + return Eval_TF_Vector_Monadic (Operand); + + when Iir_Predefined_TF_Reduction_Or => + return Eval_TF_Vector_Reduce (False, False, Operand, Tf_2d_Or); + when Iir_Predefined_TF_Reduction_And => + return Eval_TF_Vector_Reduce (True, False, Operand, Tf_2d_And); + when Iir_Predefined_TF_Reduction_Xor => + return Eval_TF_Vector_Reduce (False, False, Operand, Tf_2d_Xor); + when Iir_Predefined_TF_Reduction_Nor => + return Eval_TF_Vector_Reduce (False, True, Operand, Tf_2d_Or); + when Iir_Predefined_TF_Reduction_Nand => + return Eval_TF_Vector_Reduce (True, True, Operand, Tf_2d_And); + when Iir_Predefined_TF_Reduction_Xnor => + return Eval_TF_Vector_Reduce (False, True, Operand, Tf_2d_Xor); + when Iir_Predefined_Ieee_1164_Condition_Operator => -- Constant std_logic: need to convert. declare @@ -743,9 +1640,9 @@ package body Synth.Vhdl_Eval is end; when Iir_Predefined_Ieee_Numeric_Std_Neg_Sgn => - return Neg_Vec (Operand, Expr); + return Neg_Vec (Operand, +Expr); when Iir_Predefined_Ieee_Numeric_Std_Abs_Sgn => - return Abs_Vec (Operand, Expr); + return Abs_Vec (Operand, +Expr); when Iir_Predefined_Ieee_1164_Vector_Not | Iir_Predefined_Ieee_Numeric_Std_Not_Uns @@ -757,25 +1654,43 @@ package body Synth.Vhdl_Eval is (Std_Ulogic'Pos (Not_Table (Read_Std_Logic (Operand.Mem, 0))), Operand.Typ); - when Iir_Predefined_Ieee_Numeric_Std_And_Uns => - return Eval_Vector_Reduce ('1', Operand, And_Table); + when Iir_Predefined_Ieee_1164_And_Suv + | Iir_Predefined_Ieee_Numeric_Std_And_Uns + | Iir_Predefined_Ieee_Numeric_Std_And_Sgn => + return Eval_Vector_Reduce ('1', Operand, And_Table, False); + when Iir_Predefined_Ieee_1164_Nand_Suv + | Iir_Predefined_Ieee_Numeric_Std_Nand_Uns + | Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn => + return Eval_Vector_Reduce ('1', Operand, And_Table, True); when Iir_Predefined_Ieee_1164_Or_Suv - | Iir_Predefined_Ieee_Numeric_Std_Or_Uns => - return Eval_Vector_Reduce ('0', Operand, Or_Table); - when Iir_Predefined_Ieee_1164_Xor_Suv => - return Eval_Vector_Reduce ('0', Operand, Xor_Table); + | Iir_Predefined_Ieee_Numeric_Std_Or_Uns + | Iir_Predefined_Ieee_Numeric_Std_Or_Sgn => + return Eval_Vector_Reduce ('0', Operand, Or_Table, False); + when Iir_Predefined_Ieee_1164_Nor_Suv + | Iir_Predefined_Ieee_Numeric_Std_Nor_Uns + | Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn => + return Eval_Vector_Reduce ('0', Operand, Or_Table, True); + + when Iir_Predefined_Ieee_1164_Xor_Suv + | Iir_Predefined_Ieee_Numeric_Std_Xor_Uns + | Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn => + return Eval_Vector_Reduce ('0', Operand, Xor_Table, False); + when Iir_Predefined_Ieee_1164_Xnor_Suv + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns + | Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn => + return Eval_Vector_Reduce ('0', Operand, Xor_Table, True); when others => Error_Msg_Synth - (+Expr, "synth_static_monadic_predefined: unhandled " + (+Expr, "eval_static_monadic_predefined: unhandled " & Iir_Predefined_Functions'Image (Def)); raise Internal_Error; end case; end Eval_Static_Monadic_Predefined; - function Eval_To_Vector (Arg : Uns64; Sz : Int64; Res_Type : Type_Acc) - return Memtyp + function Eval_To_Log_Vector (Arg : Uns64; Sz : Int64; Res_Type : Type_Acc) + return Memtyp is Len : constant Iir_Index32 := Iir_Index32 (Sz); El_Type : constant Type_Acc := Get_Array_Element (Res_Type); @@ -791,7 +1706,25 @@ package body Synth.Vhdl_Eval is Std_Ulogic'Val (Std_Logic_0_Pos + B)); end loop; return Res; - end Eval_To_Vector; + end Eval_To_Log_Vector; + + function Eval_To_Bit_Vector (Arg : Uns64; Sz : Int64; Res_Type : Type_Acc) + return Memtyp + is + Len : constant Size_Type := Size_Type (Sz); + El_Type : constant Type_Acc := Get_Array_Element (Res_Type); + Res : Memtyp; + Bnd : Type_Acc; + B : Uns64; + begin + Bnd := Create_Vec_Type_By_Length (Width (Sz), El_Type); + Res := Create_Memory (Bnd); + for I in 1 .. Len loop + B := Shift_Right_Arithmetic (Arg, Natural (I - 1)) and 1; + Write_U8 (Res.Mem + (Len - I), Ghdl_U8 (B)); + end loop; + return Res; + end Eval_To_Bit_Vector; function Eval_Unsigned_To_Integer (Arg : Memtyp; Loc : Node) return Int64 is @@ -853,6 +1786,193 @@ package body Synth.Vhdl_Eval is return To_Int64 (Res); end Eval_Signed_To_Integer; + function Eval_Array_Char_To_String (Param : Memtyp; + Res_Typ : Type_Acc; + Imp : Node) return Memtyp + is + use Vhdl.Utils; + use Name_Table; + Len : constant Uns32 := Param.Typ.Abound.Len; + Elt : constant Type_Acc := Param.Typ.Arr_El; + Etype : constant Node := Get_Base_Type + (Get_Element_Subtype + (Get_Type (Get_Interface_Declaration_Chain (Imp)))); + pragma Assert (Get_Kind (Etype) = Iir_Kind_Enumeration_Type_Definition); + Enums : constant Iir_Flist := Get_Enumeration_Literal_List (Etype); + Lit : Node; + Lit_Id : Name_Id; + Bnd : Bound_Type; + Res_St : Type_Acc; + Res : Memtyp; + V : Int64; + begin + Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length + (Res_Typ.Uarr_Idx.Drange, Iir_Index32 (Len)); + Res_St := Create_Onedimensional_Array_Subtype + (Res_Typ, Bnd, Res_Typ.Uarr_El); + Res := Create_Memory (Res_St); + for I in 1 .. Len loop + V := Read_Discrete (Param.Mem + Size_Type (I - 1) * Elt.Sz, Elt); + Lit := Get_Nth_Element (Enums, Natural (V)); + Lit_Id := Get_Identifier (Lit); + pragma Assert (Is_Character (Lit_Id)); + Write_U8 (Res.Mem + Size_Type (I - 1), + Character'Pos (Get_Character (Lit_Id))); + end loop; + return Res; + end Eval_Array_Char_To_String; + + function String_To_Memtyp (Str : String; Styp : Type_Acc) return Memtyp + is + Len : constant Natural := Str'Length; + Bnd : Bound_Type; + Typ : Type_Acc; + Res : Memtyp; + begin + Bnd := (Dir => Dir_To, Left => 1, Right => Int32 (Len), + Len => Uns32 (Len)); + Typ := Create_Array_Type (Bnd, True, Styp.Uarr_El); + + Res := Create_Memory (Typ); + for I in Str'Range loop + Write_U8 (Res.Mem + Size_Type (I - Str'First), + Character'Pos (Str (I))); + end loop; + return Res; + end String_To_Memtyp; + + function Eval_Enum_To_String (Param : Memtyp; + Res_Typ : Type_Acc; + Imp : Node) return Memtyp + is + use Vhdl.Utils; + use Name_Table; + Etype : constant Node := Get_Base_Type + (Get_Type (Get_Interface_Declaration_Chain (Imp))); + pragma Assert (Get_Kind (Etype) = Iir_Kind_Enumeration_Type_Definition); + Enums : constant Iir_Flist := Get_Enumeration_Literal_List (Etype); + Lit : Node; + Lit_Id : Name_Id; + V : Int64; + C : String (1 .. 1); + begin + V := Read_Discrete (Param.Mem, Param.Typ); + Lit := Get_Nth_Element (Enums, Natural (V)); + Lit_Id := Get_Identifier (Lit); + if Is_Character (Lit_Id) then + C (1) := Get_Character (Lit_Id); + return String_To_Memtyp (C, Res_Typ); + else + return String_To_Memtyp (Image (Lit_Id), Res_Typ); + end if; + end Eval_Enum_To_String; + + Hex_Chars : constant array (Natural range 0 .. 15) of Character := + "0123456789ABCDEF"; + + function Eval_Bit_Vector_To_String (Val : Memtyp; + Res_Typ : Type_Acc; + Log_Base : Natural) return Memtyp + is + Base : constant Natural := 2 ** Log_Base; + Blen : constant Natural := Natural (Val.Typ.Abound.Len); + Str : String (1 .. (Blen + Log_Base - 1) / Log_Base); + Pos : Natural; + V : Natural; + N : Natural; + begin + V := 0; + N := 1; + Pos := Str'Last; + for I in 1 .. Blen loop + V := V + Natural (Read_U8 (Val.Mem + Size_Type (Blen - I))) * N; + N := N * 2; + if N = Base or else I = Blen then + Str (Pos) := Hex_Chars (V); + Pos := Pos - 1; + N := 1; + V := 0; + end if; + end loop; + return String_To_Memtyp (Str, Res_Typ); + end Eval_Bit_Vector_To_String; + + function Eval_Logic_Vector_To_String (Val : Memtyp; + Res_Typ : Type_Acc; + Is_Signed : Boolean; + Log_Base : Natural) return Memtyp + is + Base : constant Natural := 2 ** Log_Base; + Blen : constant Uns32 := Val.Typ.Abound.Len; + Str : String (1 .. (Natural (Blen) + Log_Base - 1) / Log_Base); + Pos : Natural; + D : Std_Ulogic; + V : Natural; + N : Natural; + Has_X, Has_Z, Has_D : Boolean; + begin + V := 0; + N := 1; + Has_X := False; + Has_Z := False; + Has_D := False; + Pos := Str'Last; + for I in 1 .. Blen loop + D := Read_Std_Logic (Val.Mem, Blen - I); + case D is + when '0' | 'L' => + Has_D := True; + when '1' | 'H' => + Has_D := True; + V := V + N; + when 'Z' | 'W' => + Has_Z := True; + when 'X' | 'U' | '-' => + Has_X := True; + end case; + N := N * 2; + if N = Base or else I = Blen then + if Has_X or (Has_Z and Has_D) then + Str (Pos) := 'X'; + elsif Has_Z then + Str (Pos) := 'Z'; + else + if Is_Signed and N < Base and (D = '1' or D = 'H') then + -- Sign extend. + loop + V := V + N; + N := N * 2; + exit when N = Base; + end loop; + end if; + Str (Pos) := Hex_Chars (V); + end if; + Pos := Pos - 1; + N := 1; + V := 0; + Has_X := False; + Has_Z := False; + Has_D := False; + end if; + end loop; + return String_To_Memtyp (Str, Res_Typ); + end Eval_Logic_Vector_To_String; + + function Eval_To_X01 (Val : Memtyp; Map : Table_1d) return Memtyp + is + Len : constant Uns32 := Val.Typ.Abound.Len; + Res : Memtyp; + B : Std_Ulogic; + begin + Res := Create_Memory (Create_Res_Bound (Val.Typ)); + for I in 1 .. Len loop + B := Read_Std_Logic (Val.Mem, I - 1); + B := Map (B); + Write_Std_Logic (Res.Mem, I - 1, B); + end loop; + return Res; + end Eval_To_X01; + function Eval_Static_Predefined_Function_Call (Param1 : Valtyp; Param2 : Valtyp; Res_Typ : Type_Acc; @@ -863,6 +1983,29 @@ package body Synth.Vhdl_Eval is Get_Implicit_Definition (Imp); begin case Def is + when Iir_Predefined_Physical_Minimum + | Iir_Predefined_Integer_Minimum + | Iir_Predefined_Enum_Minimum => + return Create_Memory_Discrete + (Int64'Min (Read_Discrete (Param1), Read_Discrete (Param2)), + Res_Typ); + when Iir_Predefined_Floating_Maximum => + return Create_Memory_Fp64 + (Fp64'Max (Read_Fp64 (Param1), Read_Fp64 (Param2)), Res_Typ); + when Iir_Predefined_Physical_Maximum + | Iir_Predefined_Integer_Maximum + | Iir_Predefined_Enum_Maximum => + return Create_Memory_Discrete + (Int64'Max (Read_Discrete (Param1), Read_Discrete (Param2)), + Res_Typ); + when Iir_Predefined_Floating_Minimum => + return Create_Memory_Fp64 + (Fp64'Min (Read_Fp64 (Param1), Read_Fp64 (Param2)), Res_Typ); + + when Iir_Predefined_Now_Function => + return Create_Memory_Discrete + (Int64 (Grt.Vhdl_Types.Current_Time), Res_Typ); + when Iir_Predefined_Endfile => declare Res : Boolean; @@ -871,20 +2014,143 @@ package body Synth.Vhdl_Eval is return Create_Memory_U8 (Boolean'Pos (Res), Boolean_Type); end; + when Iir_Predefined_Integer_To_String => + declare + Str : String (1 .. 21); + First : Natural; + begin + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Param1))); + return String_To_Memtyp (Str (First .. Str'Last), Res_Typ); + end; + when Iir_Predefined_Enum_To_String => + return Eval_Enum_To_String (Get_Memtyp (Param1), Res_Typ, Imp); + when Iir_Predefined_Floating_To_String => + declare + Str : String (1 .. 24); + Last : Natural; + begin + Grt.To_Strings.To_String + (Str, Last, Ghdl_F64 (Read_Fp64 (Param1))); + return String_To_Memtyp (Str (Str'First .. Last), Res_Typ); + end; + when Iir_Predefined_Real_To_String_Digits => + declare + Str : Grt.To_Strings.String_Real_Format; + Last : Natural; + Val : Ghdl_F64; + Dig : Ghdl_I32; + begin + Val := Ghdl_F64 (Read_Fp64 (Param1)); + Dig := Ghdl_I32 (Read_Discrete (Param2)); + Grt.To_Strings.To_String (Str, Last, Val, Dig); + return String_To_Memtyp (Str (Str'First .. Last), Res_Typ); + end; + when Iir_Predefined_Real_To_String_Format => + declare + Format : String (1 .. Natural (Param2.Typ.Abound.Len) + 1); + Str : Grt.To_Strings.String_Real_Format; + Last : Natural; + begin + -- Copy format + for I in 1 .. Param2.Typ.Abound.Len loop + Format (Positive (I)) := Character'Val + (Read_U8 (Param2.Val.Mem + Size_Type (I - 1))); + end loop; + Format (Format'Last) := ASCII.NUL; + Grt.To_Strings.To_String + (Str, Last, Ghdl_F64 (Read_Fp64 (Param1)), + To_Ghdl_C_String (Format'Address)); + return String_To_Memtyp (Str (Str'First .. Last), Res_Typ); + end; + + when Iir_Predefined_Physical_To_String => + declare + Phys_Type : constant Node := + Get_Type (Get_Interface_Declaration_Chain (Imp)); + Id : constant Name_Id := + Get_Identifier (Get_Primary_Unit (Phys_Type)); + Str : String (1 .. 21); + First : Natural; + begin + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Param1))); + return String_To_Memtyp + (Str (First .. Str'Last) & ' ' & Name_Table.Image (Id), + Res_Typ); + end; + when Iir_Predefined_Time_To_String_Unit => + declare + Time_Type : constant Node := + Get_Type (Get_Interface_Declaration_Chain (Imp)); + Str : Grt.To_Strings.String_Time_Unit; + First : Natural; + Unit : Iir; + Uval : Int64; + begin + Uval := Read_Discrete (Param2); + Unit := Get_Unit_Chain (Time_Type); + while Unit /= Null_Iir loop + exit when Vhdl.Evaluation.Get_Physical_Value (Unit) = Uval; + Unit := Get_Chain (Unit); + end loop; + if Unit = Null_Iir then + Error_Msg_Synth + (+Expr, "to_string for time called with wrong unit"); + end if; + Grt.To_Strings.To_String (Str, First, + Ghdl_I64 (Read_Discrete (Param1)), + Ghdl_I64 (Uval)); + return String_To_Memtyp + (Str (First .. Str'Last) & ' ' + & Name_Table.Image (Get_Identifier (Unit)), + Res_Typ); + end; + + when Iir_Predefined_Array_Char_To_String => + return Eval_Array_Char_To_String + (Get_Memtyp (Param1), Res_Typ, Imp); + + when Iir_Predefined_Bit_Vector_To_Hstring => + return Eval_Bit_Vector_To_String (Get_Memtyp (Param1), Res_Typ, 4); + when Iir_Predefined_Bit_Vector_To_Ostring => + return Eval_Bit_Vector_To_String (Get_Memtyp (Param1), Res_Typ, 3); + + when Iir_Predefined_Std_Env_Resolution_Limit => + return Create_Memory_Discrete (1, Res_Typ); + + when Iir_Predefined_Ieee_Numeric_Bit_Touns_Nat_Nat_Uns => + return Eval_To_Bit_Vector + (Uns64 (Read_Discrete (Param1)), Read_Discrete (Param2), + Res_Typ); + when Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Int - | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Nat_Slv => - return Eval_To_Vector + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Suv_Nat_Nat => + return Eval_To_Log_Vector (Uns64 (Read_Discrete (Param1)), Read_Discrete (Param2), Res_Typ); + when Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Slv + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Suv_Nat_Suv => + return Eval_To_Log_Vector + (Uns64 (Read_Discrete (Param1)), Int64 (Param2.Typ.Abound.Len), + Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Tosgn_Int_Nat_Sgn | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int => - return Eval_To_Vector + return Eval_To_Log_Vector (To_Uns64 (Read_Discrete (Param1)), Read_Discrete (Param2), Res_Typ); + when Iir_Predefined_Ieee_Numeric_Std_Tosgn_Int_Sgn_Sgn => + return Eval_To_Log_Vector + (To_Uns64 (Read_Discrete (Param1)), + Int64 (Param2.Typ.Abound.Len), + Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Uns - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Conv_Integer => + | Iir_Predefined_Ieee_Std_Logic_Unsigned_Conv_Integer + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Integer_Slv_Nat => -- UNSIGNED to Natural. return Create_Memory_Discrete (Eval_Unsigned_To_Integer (Get_Memtyp (Param1), Expr), Res_Typ); @@ -896,11 +2162,13 @@ package body Synth.Vhdl_Eval is return Get_Memtyp (Param1); when Iir_Predefined_Ieee_Numeric_Std_Shf_Left_Uns_Nat - | Iir_Predefined_Ieee_Numeric_Std_Shf_Left_Sgn_Nat => + | Iir_Predefined_Ieee_Numeric_Std_Shf_Left_Sgn_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Shift_Left => return Shift_Vec (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), False, False); - when Iir_Predefined_Ieee_Numeric_Std_Shf_Right_Uns_Nat => + when Iir_Predefined_Ieee_Numeric_Std_Shf_Right_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Shift_Right => return Shift_Vec (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), True, False); @@ -908,12 +2176,31 @@ package body Synth.Vhdl_Eval is return Shift_Vec (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), True, True); + when Iir_Predefined_Ieee_Numeric_Std_Rot_Left_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Rot_Left_Sgn_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Rotate_Left => + return Rotate_Vec + (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), False); + when Iir_Predefined_Ieee_Numeric_Std_Rot_Right_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Rot_Right_Sgn_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Rotate_Right => + return Rotate_Vec + (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), True); + + when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Resize_Slv_Nat => + return Resize_Vec + (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), False); + when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Resize_Slv_Slv => + return Resize_Vec + (Get_Memtyp (Param1), Param2.Typ.Abound.Len, False); when Iir_Predefined_Ieee_Numeric_Std_Resize_Sgn_Nat => return Resize_Vec (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), True); - when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat => + when Iir_Predefined_Ieee_Numeric_Std_Resize_Sgn_Sgn => return Resize_Vec - (Get_Memtyp (Param1), Uns32 (Read_Discrete (Param2)), False); + (Get_Memtyp (Param1), Param2.Typ.Abound.Len, True); when Iir_Predefined_Ieee_1164_To_Stdulogic => declare @@ -931,23 +2218,26 @@ package body Synth.Vhdl_Eval is B := To_X01 (B); return Create_Memory_U8 (Std_Ulogic'Pos (B), Res_Typ); end; - when Iir_Predefined_Ieee_1164_To_X01_Slv => + when Iir_Predefined_Ieee_1164_To_X01Z_Log => declare - El_Type : constant Type_Acc := Get_Array_Element (Res_Typ); - Res : Memtyp; - Bnd : Type_Acc; B : Std_Ulogic; begin - Bnd := Create_Vec_Type_By_Length - (Uns32 (Vec_Length (Param1.Typ)), El_Type); - Res := Create_Memory (Bnd); - for I in 1 .. Uns32 (Vec_Length (Param1.Typ)) loop - B := Read_Std_Logic (Param1.Val.Mem, I - 1); - B := To_X01 (B); - Write_Std_Logic (Res.Mem, I - 1, B); - end loop; - return Res; + B := Read_Std_Logic (Param1.Val.Mem, 0); + B := Map_X01Z (B); + return Create_Memory_U8 (Std_Ulogic'Pos (B), Res_Typ); end; + when Iir_Predefined_Ieee_1164_To_X01_Slv + | Iir_Predefined_Ieee_Numeric_Std_To_X01_Uns + | Iir_Predefined_Ieee_Numeric_Std_To_X01_Sgn => + return Eval_To_X01 (Get_Memtyp (Param1), Map_X01); + when Iir_Predefined_Ieee_Numeric_Std_To_X01Z_Uns + | Iir_Predefined_Ieee_Numeric_Std_To_X01Z_Sgn + | Iir_Predefined_Ieee_1164_To_X01Z_Slv => + return Eval_To_X01 (Get_Memtyp (Param1), Map_X01Z); + when Iir_Predefined_Ieee_Numeric_Std_To_UX01_Uns + | Iir_Predefined_Ieee_Numeric_Std_To_UX01_Sgn + | Iir_Predefined_Ieee_1164_To_UX01_Slv => + return Eval_To_X01 (Get_Memtyp (Param1), Map_UX01); when Iir_Predefined_Ieee_1164_To_Stdlogicvector_Bv | Iir_Predefined_Ieee_1164_To_Stdulogicvector_Bv => @@ -967,6 +2257,17 @@ package body Synth.Vhdl_Eval is return Res; end; + when Iir_Predefined_Ieee_Numeric_Std_Match_Log => + return Create_Memory_Boolean + (Match_Eq_Table (Read_Std_Logic (Param1.Val.Mem, 0), + Read_Std_Logic (Param2.Val.Mem, 0)) = '1'); + + when Iir_Predefined_Ieee_Numeric_Std_Match_Suv + | Iir_Predefined_Ieee_Numeric_Std_Match_Uns + | Iir_Predefined_Ieee_Numeric_Std_Match_Sgn => + return Create_Memory_Boolean + (Match_Vec (Get_Memtyp (Param1), Get_Memtyp (Param2), +Expr)); + when Iir_Predefined_Ieee_1164_To_Bit => declare V : Std_Ulogic; @@ -999,6 +2300,124 @@ package body Synth.Vhdl_Eval is return Res; end; + when Iir_Predefined_Ieee_1164_To_01_Slv_Log + | Iir_Predefined_Ieee_Numeric_Std_To_01_Uns => + declare + Len : constant Uns32 := Param1.Typ.Abound.Len; + S : Std_Ulogic; + Xmap : Std_Ulogic; + Res : Memtyp; + begin + Xmap := Read_Std_Logic (Param2.Val.Mem, 0); + Res := Create_Memory (Create_Res_Bound (Param1.Typ)); + for I in 1 .. Len loop + S := Read_Std_Logic (Param1.Val.Mem, I - 1); + S := To_X01 (S); + if S = 'X' then + S := Xmap; + end if; + Write_Std_Logic (Res.Mem, I - 1, S); + end loop; + return Res; + end; + + when Iir_Predefined_Ieee_1164_Is_X_Log => + declare + B : Std_Ulogic; + begin + B := Read_Std_Logic (Param1.Val.Mem, 0); + B := To_X01 (B); + return Create_Memory_Boolean (B = 'X'); + end; + + when Iir_Predefined_Ieee_Numeric_Std_Is_X_Uns + | Iir_Predefined_Ieee_Numeric_Std_Is_X_Sgn + | Iir_Predefined_Ieee_1164_Is_X_Slv => + declare + Len : constant Uns32 := Param1.Typ.Abound.Len; + Res : Boolean; + B : Std_Ulogic; + begin + Res := False; + for I in 1 .. Len loop + B := Read_Std_Logic (Param1.Val.Mem, I - 1); + if To_X01 (B) = 'X' then + Res := True; + exit; + end if; + end loop; + return Create_Memory_Boolean (Res); + end; + + when Iir_Predefined_Ieee_1164_To_Stdlogicvector_Suv + | Iir_Predefined_Ieee_1164_To_Stdulogicvector_Slv => + -- TODO + return (Param1.Typ, Param1.Val.Mem); + + when Iir_Predefined_Ieee_1164_To_Hstring + | Iir_Predefined_Ieee_Numeric_Std_To_Hstring_Uns => + return Eval_Logic_Vector_To_String + (Get_Memtyp (Param1), Res_Typ, False, 4); + when Iir_Predefined_Ieee_Numeric_Std_To_Hstring_Sgn => + return Eval_Logic_Vector_To_String + (Get_Memtyp (Param1), Res_Typ, True, 4); + when Iir_Predefined_Ieee_1164_To_Ostring + | Iir_Predefined_Ieee_Numeric_Std_To_Ostring_Uns => + return Eval_Logic_Vector_To_String + (Get_Memtyp (Param1), Res_Typ, False, 3); + when Iir_Predefined_Ieee_Numeric_Std_To_Ostring_Sgn => + return Eval_Logic_Vector_To_String + (Get_Memtyp (Param1), Res_Typ, True, 3); + + when Iir_Predefined_Ieee_Numeric_Std_Max_Uns_Uns => + return Minmax (Get_Memtyp (Param1), Get_Memtyp (Param2), + False, True); + when Iir_Predefined_Ieee_Numeric_Std_Min_Uns_Uns => + return Minmax (Get_Memtyp (Param1), Get_Memtyp (Param2), + False, False); + when Iir_Predefined_Ieee_Numeric_Std_Max_Sgn_Sgn => + return Minmax (Get_Memtyp (Param1), Get_Memtyp (Param2), + True, True); + when Iir_Predefined_Ieee_Numeric_Std_Min_Sgn_Sgn => + return Minmax (Get_Memtyp (Param1), Get_Memtyp (Param2), + True, False); + + when Iir_Predefined_Ieee_Numeric_Std_Find_Rightmost_Uns + | Iir_Predefined_Ieee_Numeric_Std_Find_Rightmost_Sgn + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Find_Rightmost => + return Create_Memory_Discrete + (Int64 (Find_Rightmost (Get_Memtyp (Param1), + Get_Memtyp (Param2))), + Res_Typ); + when Iir_Predefined_Ieee_Numeric_Std_Find_Leftmost_Uns + | Iir_Predefined_Ieee_Numeric_Std_Find_Leftmost_Sgn + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Find_Leftmost => + return Create_Memory_Discrete + (Int64 (Find_Leftmost (Get_Memtyp (Param1), + Get_Memtyp (Param2))), + Res_Typ); + + when Iir_Predefined_Ieee_Numeric_Std_Unsigned_Maximum_Slv_Slv => + return Minmax (Get_Memtyp (Param1), Get_Memtyp (Param2), + False, True); + when Iir_Predefined_Ieee_Numeric_Std_Unsigned_Minimum_Slv_Slv => + return Minmax (Get_Memtyp (Param1), Get_Memtyp (Param2), + False, False); + + when Iir_Predefined_Ieee_Math_Real_Sign => + declare + Val : constant Fp64 := Read_Fp64 (Param1); + Res : Fp64; + begin + if Val > 0.0 then + Res := 1.0; + elsif Val < 0.0 then + Res := -1.0; + else + Res := 0.0; + end if; + return Create_Memory_Fp64 (Res, Res_Typ); + end; when Iir_Predefined_Ieee_Math_Real_Log2 => declare function Log2 (Arg : Fp64) return Fp64; @@ -1049,10 +2468,10 @@ package body Synth.Vhdl_Eval is return Create_Memory_Fp64 (Atan (Read_Fp64 (Param1)), Res_Typ); end; when others => - Error_Msg_Synth - (+Expr, "unhandled (static) function: " - & Iir_Predefined_Functions'Image (Def)); - return Null_Memtyp; + null; end case; + Error_Msg_Synth (+Expr, "unhandled (static) function: " + & Iir_Predefined_Functions'Image (Def)); + return Null_Memtyp; end Eval_Static_Predefined_Function_Call; end Synth.Vhdl_Eval; diff --git a/src/synth/synth-vhdl_eval.ads b/src/synth/synth-vhdl_eval.ads index 3d6bc3b9f..2b689d89a 100644 --- a/src/synth/synth-vhdl_eval.ads +++ b/src/synth/synth-vhdl_eval.ads @@ -35,4 +35,7 @@ package Synth.Vhdl_Eval is Param2 : Valtyp; Res_Typ : Type_Acc; Expr : Node) return Memtyp; + + -- STYP is the string type. + function String_To_Memtyp (Str : String; Styp : Type_Acc) return Memtyp; end Synth.Vhdl_Eval; diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index 1f28e3fb2..26555ff4d 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -17,9 +17,7 @@ -- along with this program. If not, see <gnu.org/licenses>. with Types_Utils; use Types_Utils; -with Name_Table; with Std_Names; -with Str_Table; with Mutils; use Mutils; with Errorout; use Errorout; @@ -42,6 +40,7 @@ with Netlists.Locations; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Expr; with Elab.Debugger; with Synth.Errors; use Synth.Errors; @@ -51,9 +50,6 @@ with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; with Synth.Vhdl_Aggr; with Synth.Vhdl_Context; use Synth.Vhdl_Context; -with Grt.Types; -with Grt.To_Strings; - package body Synth.Vhdl_Expr is function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Valtyp; @@ -319,7 +315,7 @@ package body Synth.Vhdl_Expr is -- In memory MEM, bits are stored from left to right, so in -- big endian (MSB is written at offset 0, LSB at -- offset VLEN - 1). Need to reverse: LSB is read first. - case Typ.Vec_El.Kind is + case Typ.Arr_El.Kind is when Type_Bit => -- TODO: optimize off mod 32 = 0. for I in Off .. Len - 1 loop @@ -343,7 +339,7 @@ package body Synth.Vhdl_Expr is end; when Type_Array => declare - Alen : constant Iir_Index32 := Get_Array_Flat_Length (Typ); + Alen : constant Uns32 := Get_Bound_Length (Typ); El_Typ : constant Type_Acc := Typ.Arr_El; begin for I in reverse 1 .. Alen loop @@ -354,8 +350,8 @@ package body Synth.Vhdl_Expr is end; when Type_Record => for I in Typ.Rec.E'Range loop - Value2logvec (Mem + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ, - Off, W, Vec, Vec_Off, Has_Zx); + Value2logvec (Mem + Typ.Rec.E (I).Offs.Mem_Off, + Typ.Rec.E (I).Typ, Off, W, Vec, Vec_Off, Has_Zx); exit when W = 0; end loop; when Type_Access => @@ -494,80 +490,12 @@ package body Synth.Vhdl_Expr is declare Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); begin - case Bnds.Kind is - when Type_Vector => - pragma Assert (Dim = 1); - return Bnds.Vbound; - when Type_Array => - return Bnds.Abounds.D (Dim); - when others => - raise Internal_Error; - end case; + pragma Assert (Dim = 1); + return Get_Array_Bound (Bnds); end; end if; end Synth_Array_Bounds; - function Synth_Bounds_From_Length (Atype : Node; Len : Int32) - return Bound_Type - is - Rng : constant Node := Get_Range_Constraint (Atype); - Limit : Int32; - begin - Limit := Int32 (Eval_Pos (Get_Left_Limit (Rng))); - case Get_Direction (Rng) is - when Dir_To => - return (Dir => Dir_To, - Left => Limit, - Right => Limit + Len - 1, - Len => Uns32 (Len)); - when Dir_Downto => - return (Dir => Dir_Downto, - Left => Limit, - Right => Limit - Len + 1, - Len => Uns32 (Len)); - end case; - end Synth_Bounds_From_Length; - - function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node) return Valtyp - is - Aggr_Type : constant Node := Get_Type (Aggr); - pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1); - El_Type : constant Node := Get_Element_Subtype (Aggr_Type); - El_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, El_Type); - Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); - Last : constant Natural := Flist_Last (Els); - Bnd : Bound_Type; - Bnds : Bound_Array_Acc; - Res_Type : Type_Acc; - Val : Valtyp; - Res : Valtyp; - begin - -- Allocate the result. - Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1); - pragma Assert (Bnd.Len = Uns32 (Last + 1)); - - if El_Typ.Kind in Type_Nets then - Res_Type := Create_Vector_Type (Bnd, El_Typ); - else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res_Type := Create_Array_Type (Bnds, El_Typ); - end if; - - Res := Create_Value_Memory (Res_Type); - - for I in Flist_First .. Last loop - -- Elements are supposed to be static, so no need for enable. - Val := Synth_Expression_With_Type - (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); - pragma Assert (Is_Static (Val.Val)); - Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val); - end loop; - - return Res; - end Synth_Simple_Aggregate; - -- Change the bounds of VAL. function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is begin @@ -683,18 +611,28 @@ package body Synth.Vhdl_Expr is when Type_Array => pragma Assert (Vtype.Kind = Type_Array); -- Check bounds. - for I in Vtype.Abounds.D'Range loop - if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then - Error_Msg_Synth (+Loc, "mismatching array bounds"); - return No_Valtyp; + declare + Src_Typ, Dst_Typ : Type_Acc; + begin + Src_Typ := Vtype; + Dst_Typ := Dtype; + loop + pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); + if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then + Error_Msg_Synth (+Loc, "mismatching array bounds"); + return No_Valtyp; + end if; + exit when Src_Typ.Alast; + Src_Typ := Src_Typ.Arr_El; + Dst_Typ := Dst_Typ.Arr_El; + end loop; + -- TODO: check element. + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; end if; - end loop; - -- TODO: check element. - if Bounds then - return Reshape_Value (Vt, Dtype); - else - return Vt; - end if; + end; when Type_Unbounded_Array => pragma Assert (Vtype.Kind = Type_Array); return Vt; @@ -732,156 +670,6 @@ package body Synth.Vhdl_Expr is return Synth_Subtype_Conversion (Ctxt, Vt, Dtype, Bounds, Loc); end Synth_Subtype_Conversion; - function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp - is - Param : constant Node := Get_Parameter (Attr); - Etype : constant Node := Get_Type (Attr); - Btype : constant Node := Get_Base_Type (Etype); - V : Valtyp; - Dtype : Type_Acc; - begin - -- The value is supposed to be static. - V := Synth_Expression (Syn_Inst, Param); - if V = No_Valtyp then - return No_Valtyp; - end if; - - Dtype := Get_Subtype_Object (Syn_Inst, Etype); - if not Is_Static (V.Val) then - Error_Msg_Synth (+Attr, "parameter of 'value must be static"); - return No_Valtyp; - end if; - - declare - Str : constant String := Value_To_String (V); - Res_N : Node; - Val : Int64; - begin - case Get_Kind (Btype) is - when Iir_Kind_Enumeration_Type_Definition => - Res_N := Eval_Value_Attribute (Str, Etype, Attr); - Val := Int64 (Get_Enum_Pos (Res_N)); - Free_Iir (Res_N); - when Iir_Kind_Integer_Type_Definition => - Val := Int64'Value (Str); - when others => - Error_Msg_Synth (+Attr, "unhandled type for 'value"); - return No_Valtyp; - end case; - return Create_Value_Discrete (Val, Dtype); - end; - end Synth_Value_Attribute; - - function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) - return String - is - use Grt.Types; - begin - case Get_Kind (Expr_Type) is - when Iir_Kind_Floating_Type_Definition - | Iir_Kind_Floating_Subtype_Definition => - declare - Str : String (1 .. 24); - Last : Natural; - begin - Grt.To_Strings.To_String - (Str, Last, Ghdl_F64 (Read_Fp64 (Val))); - return Str (Str'First .. Last); - end; - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition => - declare - Str : String (1 .. 21); - First : Natural; - begin - Grt.To_Strings.To_String - (Str, First, Ghdl_I64 (Read_Discrete (Val))); - return Str (First .. Str'Last); - end; - when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - declare - Lits : constant Iir_Flist := - Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type)); - begin - return Name_Table.Image - (Get_Identifier - (Get_Nth_Element (Lits, Natural (Read_Discrete (Val))))); - end; - when Iir_Kind_Physical_Type_Definition - | Iir_Kind_Physical_Subtype_Definition => - declare - Str : String (1 .. 21); - First : Natural; - Id : constant Name_Id := - Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); - begin - Grt.To_Strings.To_String - (Str, First, Ghdl_I64 (Read_Discrete (Val))); - return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); - end; - when others => - Error_Kind ("execute_image_attribute", Expr_Type); - end case; - end Synth_Image_Attribute_Str; - - function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp - is - Len : constant Natural := Str'Length; - Bnd : Bound_Array_Acc; - Typ : Type_Acc; - Res : Valtyp; - begin - Bnd := Create_Bound_Array (1); - Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len), - Len => Width (Len)); - Typ := Create_Array_Type (Bnd, Styp.Uarr_El); - - Res := Create_Value_Memory (Typ); - for I in Str'Range loop - Write_U8 (Res.Val.Mem + Size_Type (I - Str'First), - Character'Pos (Str (I))); - end loop; - return Res; - end String_To_Valtyp; - - function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp - is - Param : constant Node := Get_Parameter (Attr); - Etype : constant Node := Get_Type (Attr); - V : Valtyp; - Dtype : Type_Acc; - begin - -- The parameter is expected to be static. - V := Synth_Expression (Syn_Inst, Param); - if V = No_Valtyp then - return No_Valtyp; - end if; - Dtype := Get_Subtype_Object (Syn_Inst, Etype); - if not Is_Static (V.Val) then - Error_Msg_Synth (+Attr, "parameter of 'image must be static"); - return No_Valtyp; - end if; - - Strip_Const (V); - return String_To_Valtyp - (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); - end Synth_Image_Attribute; - - function Synth_Instance_Name_Attribute - (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp - is - Atype : constant Node := Get_Type (Attr); - Atyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); - Name : constant Path_Instance_Name_Type := - Get_Path_Instance_Name_Suffix (Attr); - begin - -- Return a truncated name, as the prefix is not completly known. - return String_To_Valtyp (Name.Suffix, Atyp); - end Synth_Instance_Name_Attribute; - function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Valtyp is begin @@ -996,74 +784,95 @@ package body Synth.Vhdl_Expr is return Off; end Dyn_Index_To_Offset; - procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; - Name : Node; - Pfx_Type : Type_Acc; - Voff : out Net; - Off : out Value_Offsets; - Error : out Boolean) + procedure Synth_Indexes (Syn_Inst : Synth_Instance_Acc; + Indexes : Iir_Flist; + Dim : Natural; + Arr_Typ : Type_Acc; + El_Typ : out Type_Acc; + Voff : out Net; + Off : out Value_Offsets; + Stride : out Uns32; + Error : out Boolean) is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Indexes : constant Iir_Flist := Get_Index_List (Name); - El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type); Idx_Expr : Node; Idx_Val : Valtyp; Idx : Int64; Bnd : Bound_Type; - Stride : Uns32; Ivoff : Net; Idx_Off : Value_Offsets; begin - Voff := No_Net; - Off := (0, 0); - Error := False; + if Dim > Flist_Last (Indexes) then + Voff := No_Net; + Off := (0, 0); + Error := False; + Stride := 1; + El_Typ := Arr_Typ; + return; + else + Synth_Indexes + (Syn_Inst, Indexes, Dim + 1, Get_Array_Element (Arr_Typ), + El_Typ, Voff, Off, Stride, Error); + end if; - Stride := 1; - for I in reverse Flist_First .. Flist_Last (Indexes) loop - Idx_Expr := Get_Nth_Element (Indexes, I); + Idx_Expr := Get_Nth_Element (Indexes, Dim); - -- Use the base type as the subtype of the index is not synth-ed. - Idx_Val := Synth_Expression_With_Basetype (Syn_Inst, Idx_Expr); - if Idx_Val = No_Valtyp then - -- Propagate error. - Error := True; - return; - end if; + -- Use the base type as the subtype of the index is not synth-ed. + Idx_Val := Synth_Expression_With_Basetype (Syn_Inst, Idx_Expr); + if Idx_Val = No_Valtyp then + -- Propagate error. + Error := True; + return; + end if; - Strip_Const (Idx_Val); + Strip_Const (Idx_Val); - Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); + Bnd := Get_Array_Bound (Arr_Typ); - if Is_Static_Val (Idx_Val.Val) then - Idx := Get_Static_Discrete (Idx_Val); - if not In_Bounds (Bnd, Int32 (Idx)) then - Bound_Error (Syn_Inst, Name); - Error := True; - else - Idx_Off := Index_To_Offset (Syn_Inst, Bnd, Idx, Name); - Off.Net_Off := Off.Net_Off - + Idx_Off.Net_Off * Stride * El_Typ.W; - Off.Mem_Off := Off.Mem_Off - + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; - end if; + if Is_Static_Val (Idx_Val.Val) then + Idx := Get_Static_Discrete (Idx_Val); + if not In_Bounds (Bnd, Int32 (Idx)) then + Bound_Error (Syn_Inst, Idx_Expr); + Error := True; else - Ivoff := Dyn_Index_To_Offset (Ctxt, Bnd, Idx_Val, Name); - Ivoff := Build_Memidx - (Get_Build (Syn_Inst), Ivoff, El_Typ.W * Stride, - Bnd.Len - 1, - Width (Clog2 (Uns64 (El_Typ.W * Stride * Bnd.Len)))); - Set_Location (Ivoff, Idx_Expr); - - if Voff = No_Net then - Voff := Ivoff; - else - Voff := Build_Addidx (Get_Build (Syn_Inst), Ivoff, Voff); - Set_Location (Voff, Idx_Expr); - end if; + Idx_Off := Index_To_Offset (Syn_Inst, Bnd, Idx, Idx_Expr); + Off.Net_Off := Off.Net_Off + + Idx_Off.Net_Off * Stride * El_Typ.W; + Off.Mem_Off := Off.Mem_Off + + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; end if; + else + Ivoff := Dyn_Index_To_Offset (Ctxt, Bnd, Idx_Val, Idx_Expr); + Ivoff := Build_Memidx + (Get_Build (Syn_Inst), Ivoff, El_Typ.W * Stride, + Bnd.Len - 1, + Width (Clog2 (Uns64 (El_Typ.W * Stride * Bnd.Len)))); + Set_Location (Ivoff, Idx_Expr); + + if Voff = No_Net then + Voff := Ivoff; + else + Voff := Build_Addidx (Get_Build (Syn_Inst), Ivoff, Voff); + Set_Location (Voff, Idx_Expr); + end if; + end if; - Stride := Stride * Bnd.Len; - end loop; + Stride := Stride * Bnd.Len; + end Synth_Indexes; + + procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Type : Type_Acc; + El_Typ : out Type_Acc; + Voff : out Net; + Off : out Value_Offsets; + Error : out Boolean) + is + Indexes : constant Iir_Flist := Get_Index_List (Name); + Stride : Uns32; + begin + Synth_Indexes (Syn_Inst, Indexes, Flist_First, Pfx_Type, + El_Typ, Voff, Off, Stride, Error); end Synth_Indexed_Name; function Is_Static (N : Net) return Boolean is @@ -1449,7 +1258,7 @@ package body Synth.Vhdl_Expr is -- max so that max*step+wd <= len - off -- max <= (len - off - wd) / step Max := (Pfx_Bnd.Len - Off.Net_Off - Res_Bnd.Len) / Step; - if Clog2 (Uns64 (Max)) > Natural (Inp_W) then + if Max > 2**Natural (Inp_W) - 1 then -- The width of Inp limits the max. Max := 2**Natural (Inp_W) - 1; end if; @@ -1623,6 +1432,9 @@ package body Synth.Vhdl_Expr is when Type_Vector | Type_Unbounded_Vector => return Val; + when Type_Array + | Type_Unbounded_Array => + return Val; when others => Error_Msg_Synth (+Conv, "unhandled type conversion (to array)"); @@ -1672,58 +1484,6 @@ package body Synth.Vhdl_Expr is return False; end Error_Ieee_Operator; - function Synth_String_Literal - (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) - return Valtyp - is - pragma Unreferenced (Syn_Inst); - pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); - Id : constant String8_Id := Get_String8_Id (Str); - - Str_Type : constant Node := Get_Type (Str); - El_Type : Type_Acc; - Bounds : Bound_Type; - Bnds : Bound_Array_Acc; - Res_Type : Type_Acc; - Res : Valtyp; - Pos : Nat8; - begin - case Str_Typ.Kind is - when Type_Vector => - Bounds := Str_Typ.Vbound; - when Type_Array => - Bounds := Str_Typ.Abounds.D (1); - when Type_Unbounded_Vector - | Type_Unbounded_Array => - Bounds := Synth_Bounds_From_Length - (Get_Index_Type (Str_Type, 0), Get_String_Length (Str)); - when others => - raise Internal_Error; - end case; - - El_Type := Get_Array_Element (Str_Typ); - if El_Type.Kind in Type_Nets then - Res_Type := Create_Vector_Type (Bounds, El_Type); - else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bounds; - Res_Type := Create_Array_Type (Bnds, El_Type); - end if; - Res := Create_Value_Memory (Res_Type); - - -- Only U8 are handled. - pragma Assert (El_Type.Sz = 1); - - -- From left to right. - for I in 1 .. Bounds.Len loop - -- FIXME: use literal from type ?? - Pos := Str_Table.Element_String8 (Id, Pos32 (I)); - Write_U8 (Res.Val.Mem + Size_Type (I - 1), Nat8'Pos (Pos)); - end loop; - - return Res; - end Synth_String_Literal; - -- Return the left bound if the direction of the range is LEFT_DIR. function Synth_Low_High_Type_Attribute (Syn_Inst : Synth_Instance_Acc; Expr : Node; Left_Dir : Direction_Type) @@ -2110,8 +1870,10 @@ package body Synth.Vhdl_Expr is Get_Implicit_Definition (Imp); Edge : Net; begin - -- Match clock-edge - if Def = Iir_Predefined_Boolean_And then + -- Match clock-edge (only for synthesis) + if Def = Iir_Predefined_Boolean_And + and then Hook_Signal_Expr = null + then Edge := Synth_Clock_Edge (Syn_Inst, Get_Left (Expr), Get_Right (Expr)); if Edge /= No_Net then @@ -2181,7 +1943,10 @@ package body Synth.Vhdl_Expr is begin Res := Synth_Name (Syn_Inst, Expr); if Res.Val /= null - and then Res.Val.Kind = Value_Signal + and then + (Res.Val.Kind = Value_Signal + or else (Res.Val.Kind = Value_Alias + and then Res.Val.A_Obj.Kind = Value_Signal)) then if Hook_Signal_Expr /= null then return Hook_Signal_Expr (Res); @@ -2218,10 +1983,14 @@ package body Synth.Vhdl_Expr is -- Propagate error. return No_Valtyp; end if; + if Base.Val.Kind = Value_Signal + and then Hook_Signal_Expr /= null + then + Base := Hook_Signal_Expr (Base); + end if; if Dyn.Voff = No_Net and then Is_Static (Base.Val) then - Res := Create_Value_Memory (Typ); - Copy_Memory - (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz); + Res := Create_Value_Memtyp + ((Typ, Base.Val.Mem + Off.Mem_Off)); return Res; end if; return Synth_Read_Memory @@ -2248,13 +2017,14 @@ package body Synth.Vhdl_Expr is elsif Is_Static (Val.Val) then Res := Create_Value_Memory (Res_Typ); Copy_Memory - (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Moff, + (Res.Val.Mem, + Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Offs.Mem_Off, Res_Typ.Sz); return Res; else - N := Build_Extract - (Ctxt, Get_Net (Ctxt, Val), - Val.Typ.Rec.E (Idx + 1).Boff, Get_Type_Width (Res_Typ)); + N := Build_Extract (Ctxt, Get_Net (Ctxt, Val), + Val.Typ.Rec.E (Idx + 1).Offs.Net_Off, + Get_Type_Width (Res_Typ)); Set_Location (N, Expr); return Create_Value_Net (N, Res_Typ); end if; @@ -2277,7 +2047,8 @@ package body Synth.Vhdl_Expr is return Create_Value_Discrete (Get_Physical_Value (Expr), Expr_Type); when Iir_Kind_String_Literal8 => - return Synth_String_Literal (Syn_Inst, Expr, Expr_Type); + return Elab.Vhdl_Expr.Exec_String_Literal + (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Enumeration_Literal => return Synth_Name (Syn_Inst, Expr); when Iir_Kind_Type_Conversion => @@ -2291,8 +2062,9 @@ package body Synth.Vhdl_Expr is Imp : constant Node := Get_Implementation (Expr); begin case Get_Implicit_Definition (Imp) is - when Iir_Predefined_Pure_Functions - | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators => + when Iir_Predefined_Operators + | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Operators => return Synth_Operator_Function_Call (Syn_Inst, Expr); when Iir_Predefined_None => return Synth_User_Function_Call (Syn_Inst, Expr); @@ -2303,7 +2075,7 @@ package body Synth.Vhdl_Expr is when Iir_Kind_Aggregate => return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Simple_Aggregate => - return Synth_Simple_Aggregate (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Simple_Aggregate (Syn_Inst, Expr); when Iir_Kind_Parenthesis_Expression => return Synth_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type); @@ -2390,11 +2162,12 @@ package body Synth.Vhdl_Expr is when Iir_Kind_High_Type_Attribute => return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); when Iir_Kind_Value_Attribute => - return Synth_Value_Attribute (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Value_Attribute (Syn_Inst, Expr); when Iir_Kind_Image_Attribute => - return Synth_Image_Attribute (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Image_Attribute (Syn_Inst, Expr); when Iir_Kind_Instance_Name_Attribute => - return Synth_Instance_Name_Attribute (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Instance_Name_Attribute + (Syn_Inst, Expr); when Iir_Kind_Null_Literal => return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => @@ -2435,6 +2208,12 @@ package body Synth.Vhdl_Expr is when Iir_Kind_Overflow_Literal => Error_Msg_Synth (+Expr, "out of bound expression"); return No_Valtyp; + when Iir_Kind_Event_Attribute => + if Hook_Signal_Attribute /= null then + return Hook_Signal_Attribute (Syn_Inst, Expr); + end if; + Error_Msg_Synth (+Expr, "signal attributes not allowed"); + return No_Valtyp; when others => Error_Kind ("synth_expression_with_type", Expr); end case; @@ -2450,9 +2229,13 @@ package body Synth.Vhdl_Expr is case Get_Kind (Expr) is when Iir_Kind_High_Array_Attribute | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Indexed_Name | Iir_Kind_Integer_Literal => - -- The type of this attribute is the type of the index, which is - -- not synthesized as atype (only as an index). + -- For array attributes: the type is the type of the index, which + -- is not synthesized as a type (only as an index). + -- + -- Likewise for indexed names. + -- -- For integer_literal, the type is not really needed, and it -- may be created by static evaluation of an array attribute. Etype := Get_Base_Type (Etype); diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads index 0aacd8cbf..5eadb879f 100644 --- a/src/synth/synth-vhdl_expr.ads +++ b/src/synth/synth-vhdl_expr.ads @@ -90,11 +90,19 @@ package Synth.Vhdl_Expr is Expr : Node; Expr_Type : Type_Acc) return Valtyp; + -- For value signal attribute (like 'Event). + type Hook_Signal_Attribute_Acc is access + function (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; + Hook_Signal_Attribute : Hook_Signal_Attribute_Acc; + -- Use base type of EXPR to synthesize EXPR. Useful when the type of -- EXPR is defined by itself or a range. function Synth_Expression_With_Basetype (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; + function Synth_Type_Conversion + (Syn_Inst : Synth_Instance_Acc; Conv : Node) return Valtyp; + function Synth_PSL_Expression (Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net; @@ -115,6 +123,7 @@ package Synth.Vhdl_Expr is procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node; Pfx_Type : Type_Acc; + El_Typ : out Type_Acc; Voff : out Net; Off : out Value_Offsets; Error : out Boolean); diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb index 458981f37..2d3f3360f 100644 --- a/src/synth/synth-vhdl_insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -186,11 +186,25 @@ package body Synth.Vhdl_Insts is begin case Typ.Kind is when Type_Vector => - Hash_Bound (C, Typ.Vbound); + Hash_Bound (C, Typ.Abound); when Type_Array => - for I in Typ.Abounds.D'Range loop - Hash_Bound (C, Typ.Abounds.D (I)); + declare + T : Type_Acc; + begin + T := Typ; + loop + Hash_Bound (C, T.Abound); + exit when T.Alast; + T := T.Arr_El; + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + Hash_Bounds (C, Typ.Rec.E (I).Typ); end loop; + when Type_Bit + | Type_Logic => + null; when others => raise Internal_Error; end case; @@ -213,7 +227,8 @@ package body Synth.Vhdl_Insts is when Value_Net | Value_Wire | Value_Signal - | Value_File => + | Value_File + | Value_Dyn_Alias => raise Internal_Error; end case; end Hash_Const; @@ -623,6 +638,40 @@ package body Synth.Vhdl_Insts is end if; end Interning_Get; + function Synth_Single_Input_Assoc (Syn_Inst : Synth_Instance_Acc; + Inter_Typ : Type_Acc; + Act_Inst : Synth_Instance_Acc; + Actual : Node; + Assoc : Node) return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Conv : Node; + Act : Valtyp; + begin + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Name then + Conv := Get_Actual_Conversion (Assoc); + else + Conv := Null_Node; + end if; + if Conv /= Null_Node then + case Get_Kind (Conv) is + when Iir_Kind_Function_Call => + pragma Assert (Act_Inst = Syn_Inst); + -- This is an abuse, but it works like a user operator. + Act := Synth_User_Operator (Syn_Inst, Actual, Null_Node, Conv); + when Iir_Kind_Type_Conversion => + Act := Synth_Type_Conversion (Syn_Inst, Conv); + when others => + Vhdl.Errors.Error_Kind ("synth_single_input_assoc", Conv); + end case; + else + Act := Synth_Expression_With_Type (Act_Inst, Actual, Inter_Typ); + end if; + + Act := Synth_Subtype_Conversion (Ctxt, Act, Inter_Typ, False, Assoc); + return Act; + end Synth_Single_Input_Assoc; + procedure Synth_Individual_Prefix (Syn_Inst : Synth_Instance_Acc; Inter_Inst : Synth_Instance_Acc; Formal : Node; @@ -643,23 +692,25 @@ package body Synth.Vhdl_Insts is begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); - Off := Off + Typ.Rec.E (Idx + 1).Boff; + Off := Off + Typ.Rec.E (Idx + 1).Offs.Net_Off; Typ := Typ.Rec.E (Idx + 1).Typ; end; when Iir_Kind_Indexed_Name => declare + El_Typ : Type_Acc; Voff : Net; Arr_Off : Value_Offsets; Err : Boolean; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); - Synth_Indexed_Name (Syn_Inst, Formal, Typ, Voff, Arr_Off, Err); + Synth_Indexed_Name (Syn_Inst, Formal, Typ, + El_Typ, Voff, Arr_Off, Err); if Voff /= No_Net or Err then raise Internal_Error; end if; Off := Off + Arr_Off.Net_Off; - Typ := Get_Array_Element (Typ); + Typ := El_Typ; end; when Iir_Kind_Slice_Name => declare @@ -745,7 +796,8 @@ package body Synth.Vhdl_Insts is (Syn_Inst, Inter_Inst, Get_Formal (Iassoc), Off, Typ); -- 2. synth expression - V := Synth_Expression_With_Type (Syn_Inst, Get_Actual (Iassoc), Typ); + V := Synth_Single_Input_Assoc + (Syn_Inst, Typ, Syn_Inst, Get_Actual (Iassoc), Iassoc); -- 3. save in a table Value_Offset_Tables.Append (Els, (Off, V)); @@ -781,28 +833,25 @@ package body Synth.Vhdl_Insts is return Net is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Actual : Node; - Act_Inst : Synth_Instance_Acc; - Act : Valtyp; + Res : Valtyp; begin case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is when Iir_Kind_Association_Element_Open => - Actual := Get_Default_Value (Inter); - Act_Inst := Inter_Inst; + Res := Synth_Single_Input_Assoc + (Syn_Inst, Inter_Typ, Inter_Inst, + Get_Default_Value (Inter), Assoc); when Iir_Kind_Association_Element_By_Expression | Iir_Kind_Association_Element_By_Name => - Actual := Get_Actual (Assoc); - Act_Inst := Syn_Inst; + Res := Synth_Single_Input_Assoc + (Syn_Inst, Inter_Typ, Syn_Inst, Get_Actual (Assoc), Assoc); when Iir_Kind_Association_Element_By_Individual => return Synth_Individual_Input_Assoc (Syn_Inst, Assoc, Inter_Inst); end case; - Act := Synth_Expression_With_Type (Act_Inst, Actual, Inter_Typ); - Act := Synth_Subtype_Conversion (Ctxt, Act, Inter_Typ, False, Assoc); - if Act = No_Valtyp then + if Res = No_Valtyp then return No_Net; end if; - return Get_Net (Ctxt, Act); + return Get_Net (Ctxt, Res); end Synth_Input_Assoc; procedure Synth_Individual_Output_Assoc (Outp : Net; @@ -898,7 +947,7 @@ package body Synth.Vhdl_Insts is if N /= No_Net then Connect (Get_Input (Inst, Port), Build_Extract (Get_Build (Syn_Inst), N, - Inter_Typ.Rec.E (I).Boff, + Inter_Typ.Rec.E (I).Offs.Net_Off, Inter_Typ.Rec.E (I).Typ.W)); end if; Port := Port + 1; diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index 640a65b77..919d1f64e 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -143,13 +143,13 @@ package body Synth.Vhdl_Oper is case Res.Kind is when Type_Vector => - if Res.Vbound.Dir = Dir_Downto - and then Res.Vbound.Right = 0 + if Res.Abound.Dir = Dir_Downto + and then Res.Abound.Right = 0 then -- Normalized range return Res; end if; - return Create_Vec_Type_By_Length (Res.W, Res.Vec_El); + return Create_Vec_Type_By_Length (Res.W, Res.Arr_El); when Type_Slice => return Create_Vec_Type_By_Length (Res.W, Res.Slice_El); @@ -263,9 +263,9 @@ package body Synth.Vhdl_Oper is begin -- Note: LEFT or RIGHT can be a single bit. if Left.Typ.Kind = Type_Vector then - El_Typ := Left.Typ.Vec_El; + El_Typ := Left.Typ.Arr_El; elsif Right.Typ.Kind = Type_Vector then - El_Typ := Right.Typ.Vec_El; + El_Typ := Right.Typ.Arr_El; else raise Internal_Error; end if; @@ -461,20 +461,6 @@ package body Synth.Vhdl_Oper is return Create_Value_Net (N, Res_Type); end Synth_Compare; - function Synth_Minmax (Id : Compare_Module_Id) return Valtyp - is - L : constant Net := Get_Net (Ctxt, Left); - R : constant Net := Get_Net (Ctxt, Right); - Sel, N : Net; - begin - pragma Assert (Left_Type = Right_Type); - Sel := Build2_Compare (Ctxt, Id, L, R); - Set_Location (Sel, Expr); - N := Build_Mux2 (Ctxt, Sel, R, L); - Set_Location (N, Expr); - return Create_Value_Net (N, Expr_Typ); - end Synth_Minmax; - function Synth_Compare_Array (Id : Compare_Module_Id; Res_Type : Type_Acc) return Valtyp is @@ -635,7 +621,7 @@ package body Synth.Vhdl_Oper is when Oper_Right => Res_Typ := Right.Typ; end case; - Res_Typ := Create_Vec_Type_By_Length (Res_Typ.W, Res_Typ.Vec_El); + Res_Typ := Create_Vec_Type_By_Length (Res_Typ.W, Res_Typ.Arr_El); N := Build_Dyadic (Ctxt, Id, L1, R1); Set_Location (N, Expr); N := Build2_Uresize (Ctxt, N, Res_Typ.W, Get_Location (Expr)); @@ -658,7 +644,7 @@ package body Synth.Vhdl_Oper is when Oper_Right => Res_Typ := Right.Typ; end case; - Res_Typ := Create_Vec_Type_By_Length (Res_Typ.W, Res_Typ.Vec_El); + Res_Typ := Create_Vec_Type_By_Length (Res_Typ.W, Res_Typ.Arr_El); N := Build_Dyadic (Ctxt, Id, L1, R1); Set_Location (N, Expr); N := Build2_Sresize (Ctxt, N, Res_Typ.W, Get_Location (Expr)); @@ -788,28 +774,33 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_1164_Scalar_Xnor => return Synth_Bit_Dyadic (Id_Xnor); - when Iir_Predefined_Ieee_1164_Vector_And + when Iir_Predefined_TF_Array_And + | Iir_Predefined_Ieee_1164_Vector_And | Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Sgn => return Synth_Vec_Dyadic (Id_And); - when Iir_Predefined_Ieee_1164_Vector_Or + when Iir_Predefined_TF_Array_Or + | Iir_Predefined_Ieee_1164_Vector_Or | Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Sgn => return Synth_Vec_Dyadic (Id_Or); - when Iir_Predefined_Ieee_1164_Vector_Nand + when Iir_Predefined_TF_Array_Nand + | Iir_Predefined_Ieee_1164_Vector_Nand | Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Sgn => return Synth_Vec_Dyadic (Id_Nand); - when Iir_Predefined_Ieee_1164_Vector_Nor + when Iir_Predefined_TF_Array_Nor + | Iir_Predefined_Ieee_1164_Vector_Nor | Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Sgn => return Synth_Vec_Dyadic (Id_Nor); when Iir_Predefined_TF_Array_Xor - | Iir_Predefined_Ieee_1164_Vector_Xor - | Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Sgn => + | Iir_Predefined_Ieee_1164_Vector_Xor + | Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Uns + | Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Sgn => return Synth_Vec_Dyadic (Id_Xor); - when Iir_Predefined_Ieee_1164_Vector_Xnor + when Iir_Predefined_TF_Array_Xnor + | Iir_Predefined_Ieee_1164_Vector_Xnor | Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Uns | Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Sgn => return Synth_Vec_Dyadic (Id_Xnor); @@ -974,7 +965,7 @@ package body Synth.Vhdl_Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Bound_Length (Left.Typ, 1) + 1)); + Iir_Index32 (Get_Bound_Length (Left.Typ) + 1)); Res_Typ := Create_Onedimensional_Array_Subtype (Left_Typ, Bnd, Le_Typ); @@ -994,7 +985,7 @@ package body Synth.Vhdl_Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Bound_Length (Right.Typ, 1) + 1)); + Iir_Index32 (Get_Bound_Length (Right.Typ) + 1)); Res_Typ := Create_Onedimensional_Array_Subtype (Right_Typ, Bnd, Re_Typ); @@ -1032,8 +1023,8 @@ package body Synth.Vhdl_Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Bound_Length (Left.Typ, 1) - + Get_Bound_Length (Right.Typ, 1))); + Iir_Index32 (Get_Bound_Length (Left.Typ) + + Get_Bound_Length (Right.Typ))); Res_Typ := Create_Onedimensional_Array_Subtype (Expr_Typ, Bnd, Le_Typ); @@ -1088,10 +1079,6 @@ package body Synth.Vhdl_Oper is return Synth_Compare (Id_Eq, Boolean_Type); when Iir_Predefined_Integer_Inequality => return Synth_Compare (Id_Ne, Boolean_Type); - when Iir_Predefined_Integer_Minimum => - return Synth_Minmax (Id_Slt); - when Iir_Predefined_Integer_Maximum => - return Synth_Minmax (Id_Sgt); when Iir_Predefined_Physical_Physical_Div => Error_Msg_Synth (+Expr, "non-constant division not supported"); return No_Valtyp; @@ -1670,7 +1657,7 @@ package body Synth.Vhdl_Oper is N := Build_Monadic (Ctxt, Id_Not, N); Set_Location (N, Loc); end if; - return Create_Value_Net (N, Operand.Typ.Vec_El); + return Create_Value_Net (N, Operand.Typ.Arr_El); end Synth_Vec_Reduce_Monadic; begin Operand := Synth_Expression_With_Type (Syn_Inst, Operand_Expr, Oper_Typ); @@ -1788,7 +1775,7 @@ package body Synth.Vhdl_Oper is Expr : Node) return Valtyp is pragma Assert (Left.Typ.Kind = Type_Vector); - Len : constant Uns32 := Left.Typ.Vbound.Len; + Len : constant Uns32 := Left.Typ.Abound.Len; Max : Int32; Rng : Discrete_Range_Type; W : Uns32; @@ -1804,7 +1791,7 @@ package body Synth.Vhdl_Oper is -- The intermediate result is computed using the least number of bits, -- which must represent all positive values in the bounds using a -- signed word (so that -1 is also represented). - Max := Int32'Max (Left.Typ.Vbound.Left, Left.Typ.Vbound.Right); + Max := Int32'Max (Left.Typ.Abound.Left, Left.Typ.Abound.Right); W := Netlists.Utils.Clog2 (Uns32 (Max)) + 1; Rng := (Dir => Dir_To, Is_Signed => True, @@ -1824,17 +1811,17 @@ package body Synth.Vhdl_Oper is if Leftmost then -- Iterate from the right to the left. Pos := I; - if Left.Typ.Vbound.Dir = Dir_To then - V := Int64 (Left.Typ.Vbound.Right) - Int64 (I); + if Left.Typ.Abound.Dir = Dir_To then + V := Int64 (Left.Typ.Abound.Right) - Int64 (I); else - V := Int64 (Left.Typ.Vbound.Right) + Int64 (I); + V := Int64 (Left.Typ.Abound.Right) + Int64 (I); end if; else Pos := Len - I - 1; - if Left.Typ.Vbound.Dir = Dir_To then - V := Int64 (Left.Typ.Vbound.Left) + Int64 (I); + if Left.Typ.Abound.Dir = Dir_To then + V := Int64 (Left.Typ.Abound.Left) + Int64 (I); else - V := Int64 (Left.Typ.Vbound.Left) - Int64 (I); + V := Int64 (Left.Typ.Abound.Left) - Int64 (I); end if; end if; Sel := Build2_Compare (Ctxt, Id_Eq, @@ -1865,6 +1852,23 @@ package body Synth.Vhdl_Oper is (N, Create_Vec_Type_By_Length (Size, Logic_Type)); end Synth_Resize; + function Synth_Minmax (Ctxt : Context_Acc; + Left, Right : Valtyp; + Res_Typ : Type_Acc; + Id : Compare_Module_Id; + Expr : Node) return Valtyp + is + L : constant Net := Get_Net (Ctxt, Left); + R : constant Net := Get_Net (Ctxt, Right); + Sel, N : Net; + begin + Sel := Build2_Compare (Ctxt, Id, L, R); + Set_Location (Sel, Expr); + N := Build_Mux2 (Ctxt, Sel, R, L); + Set_Location (N, Expr); + return Create_Value_Net (N, Res_Typ); + end Synth_Minmax; + function Synth_Dynamic_Predefined_Function_Call (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is @@ -1914,7 +1918,27 @@ package body Synth.Vhdl_Oper is end if; case Def is + when Iir_Predefined_Integer_Minimum => + return Synth_Minmax (Ctxt, L, R, Res_Typ, Id_Slt, Expr); + when Iir_Predefined_Integer_Maximum => + return Synth_Minmax (Ctxt, L, R, Res_Typ, Id_Sgt, Expr); + when Iir_Predefined_Bit_Rising_Edge => + if Hook_Bit_Rising_Edge /= null then + return Create_Value_Memtyp + (Hook_Bit_Rising_Edge.all (L, Res_Typ)); + end if; + raise Internal_Error; + when Iir_Predefined_Bit_Falling_Edge => + if Hook_Bit_Falling_Edge /= null then + return Create_Value_Memtyp + (Hook_Bit_Falling_Edge.all (L, Res_Typ)); + end if; + raise Internal_Error; when Iir_Predefined_Ieee_1164_Rising_Edge => + if Hook_Std_Rising_Edge /= null then + return Create_Value_Memtyp + (Hook_Std_Rising_Edge.all (L, Res_Typ)); + end if; declare Edge : Net; begin @@ -1923,6 +1947,10 @@ package body Synth.Vhdl_Oper is return Create_Value_Net (Edge, Res_Typ); end; when Iir_Predefined_Ieee_1164_Falling_Edge => + if Hook_Std_Falling_Edge /= null then + return Create_Value_Memtyp + (Hook_Std_Falling_Edge.all (L, Res_Typ)); + end if; declare Edge : Net; begin @@ -1930,13 +1958,14 @@ package body Synth.Vhdl_Oper is Set_Location (Edge, Expr); return Create_Value_Net (Edge, Res_Typ); end; - when Iir_Predefined_Ieee_1164_Scalar_Is_X - | Iir_Predefined_Ieee_1164_Vector_Is_X => + when Iir_Predefined_Ieee_1164_Is_X_Log + | Iir_Predefined_Ieee_1164_Is_X_Slv => -- Always false. return Create_Value_Discrete (0, Boolean_Type); when Iir_Predefined_Ieee_1164_To_Bitvector | Iir_Predefined_Ieee_1164_To_Stdlogicvector_Suv | Iir_Predefined_Ieee_1164_To_Stdlogicvector_Bv + | Iir_Predefined_Ieee_1164_To_Stdulogicvector_Slv | Iir_Predefined_Ieee_1164_To_Stdulogicvector_Bv | Iir_Predefined_Ieee_Numeric_Std_To_01_Uns | Iir_Predefined_Ieee_Numeric_Std_To_01_Sgn @@ -1957,7 +1986,7 @@ package body Synth.Vhdl_Oper is return Synth_Conv_Vector (False); when Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Uns_Uns => declare - B : constant Bound_Type := Get_Array_Bound (R.Typ, 1); + B : constant Bound_Type := Get_Array_Bound (R.Typ); begin return Synth_Resize (Ctxt, L, B.Len, False, Expr); end; @@ -2001,7 +2030,7 @@ package body Synth.Vhdl_Oper is B : Bound_Type; W : Width; begin - B := Get_Array_Bound (R.Typ, 1); + B := Get_Array_Bound (R.Typ); W := B.Len; return Create_Value_Net (Build2_Uresize (Ctxt, Get_Net (Ctxt, L), @@ -2020,7 +2049,7 @@ package body Synth.Vhdl_Oper is (Ctxt, L, Uns32 (Read_Discrete (R)), True, Expr); when Iir_Predefined_Ieee_Numeric_Std_Resize_Sgn_Sgn => declare - B : constant Bound_Type := Get_Array_Bound (R.Typ, 1); + B : constant Bound_Type := Get_Array_Bound (R.Typ); begin return Synth_Resize (Ctxt, L, B.Len, True, Expr); end; diff --git a/src/synth/synth-vhdl_oper.ads b/src/synth/synth-vhdl_oper.ads index 3ae73df3d..f02d4d55c 100644 --- a/src/synth/synth-vhdl_oper.ads +++ b/src/synth/synth-vhdl_oper.ads @@ -43,4 +43,13 @@ package Synth.Vhdl_Oper is (Syn_Inst : Synth_Instance_Acc; Atype : Iir; Len : Iir_Index32) return Bound_Type; + + type Eval_Predefined_Acc is access + function (Param : Valtyp; Res_Typ : Type_Acc) return Memtyp; + + Hook_Bit_Rising_Edge : Eval_Predefined_Acc; + Hook_Bit_Falling_Edge : Eval_Predefined_Acc; + + Hook_Std_Rising_Edge : Eval_Predefined_Acc; + Hook_Std_Falling_Edge : Eval_Predefined_Acc; end Synth.Vhdl_Oper; diff --git a/src/synth/synth-vhdl_static_proc.adb b/src/synth/synth-vhdl_static_proc.adb index 0764d35c1..9144d5061 100644 --- a/src/synth/synth-vhdl_static_proc.adb +++ b/src/synth/synth-vhdl_static_proc.adb @@ -16,14 +16,21 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Interfaces; + +with Types; use Types; + with Vhdl.Errors; use Vhdl.Errors; +with Elab.Memtype; with Elab.Vhdl_Values; use Elab.Vhdl_Values; with Elab.Vhdl_Heap; with Elab.Vhdl_Files; use Elab.Vhdl_Files; with Synth.Errors; use Synth.Errors; +with Grt.Fcvt; + package body Synth.Vhdl_Static_Proc is procedure Synth_Deallocate (Syn_Inst : Synth_Instance_Acc; Imp : Node) @@ -43,6 +50,31 @@ package body Synth.Vhdl_Static_Proc is end if; end Synth_Deallocate; + procedure Synth_Textio_Write_Real (Syn_Inst : Synth_Instance_Acc; + Imp : Node) + is + use Elab.Memtype; + Param1 : constant Node := Get_Interface_Declaration_Chain (Imp); + Str : constant Valtyp := Get_Value (Syn_Inst, Param1); + Param2 : constant Node := Get_Chain (Param1); + Len : constant Valtyp := Get_Value (Syn_Inst, Param2); + Param3 : constant Node := Get_Chain (Param2); + Val : constant Valtyp := Get_Value (Syn_Inst, Param3); + Param4 : constant Node := Get_Chain (Param3); + Ndigits : constant Valtyp := Get_Value (Syn_Inst, Param4); + + S : String (1 .. Natural (Str.Typ.Abound.Len)); + Last : Natural; + begin + Grt.Fcvt.Format_Digits (S, Last, + Interfaces.IEEE_Float_64 (Read_Fp64 (Val)), + Natural (Read_Discrete (Ndigits))); + Write_Discrete (Len, Int64 (Last)); + for I in 1 .. Last loop + Write_U8 (Str.Val.Mem + Size_Type (I - 1), Character'Pos (S (I))); + end loop; + end Synth_Textio_Write_Real; + procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) is @@ -62,6 +94,16 @@ package body Synth.Vhdl_Static_Proc is Synth_File_Read (Syn_Inst, Imp, Loc); when Iir_Predefined_Write => Synth_File_Write (Syn_Inst, Imp, Loc); + when Iir_Predefined_Flush => + Synth_File_Flush (Syn_Inst, Imp, Loc); + when Iir_Predefined_Std_Env_Finish_Status => + if Hook_Finish /= null then + Hook_Finish.all (Syn_Inst, Imp); + else + raise Internal_Error; + end if; + when Iir_Predefined_Foreign_Textio_Write_Real => + Synth_Textio_Write_Real (Syn_Inst, Imp); when others => Error_Msg_Synth (+Loc, "call to implicit %n is not supported", +Imp); diff --git a/src/synth/synth-vhdl_static_proc.ads b/src/synth/synth-vhdl_static_proc.ads index c7bedbcce..153f8b3cf 100644 --- a/src/synth/synth-vhdl_static_proc.ads +++ b/src/synth/synth-vhdl_static_proc.ads @@ -24,4 +24,8 @@ package Synth.Vhdl_Static_Proc is procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); + + type Hook_Simulation_Acc is access + procedure (Inst : Synth_Instance_Acc; Imp : Node); + Hook_Finish : Hook_Simulation_Acc; end Synth.Vhdl_Static_Proc; diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 6fa2e9227..f351c34f3 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -142,6 +142,7 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Indexed_Name => declare + El_Typ : Type_Acc; Voff : Net; Off : Value_Offsets; Err : Boolean; @@ -150,7 +151,8 @@ package body Synth.Vhdl_Stmts is (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); Strip_Const (Dest_Base); - Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off, Err); + Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, + El_Typ, Voff, Off, Err); if Err then Dest_Base := No_Valtyp; @@ -179,7 +181,7 @@ package body Synth.Vhdl_Stmts is end if; end if; - Dest_Typ := Get_Array_Element (Dest_Typ); + Dest_Typ := El_Typ; end; when Iir_Kind_Selected_Element => @@ -190,10 +192,7 @@ package body Synth.Vhdl_Stmts is Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); - Dest_Off.Net_Off := - Dest_Off.Net_Off + Dest_Typ.Rec.E (Idx + 1).Boff; - Dest_Off.Mem_Off := - Dest_Off.Mem_Off + Dest_Typ.Rec.E (Idx + 1).Moff; + Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs; Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; end; @@ -261,8 +260,6 @@ package body Synth.Vhdl_Stmts is end case; end Synth_Assignment_Prefix; - type Target_Info_Array is array (Natural range <>) of Target_Info; - function Synth_Aggregate_Target_Type (Syn_Inst : Synth_Instance_Acc; Target : Node) return Type_Acc is @@ -295,7 +292,7 @@ package body Synth.Vhdl_Stmts is pragma Assert (Get_Kind (Choice) = Iir_Kind_Choice_By_None); El := Get_Associated_Expr (Choice); El_Typ := Elab.Vhdl_Expr.Exec_Type_Of_Object (Syn_Inst, El); - Bnd := Get_Array_Bound (El_Typ, 1); + Bnd := Get_Array_Bound (El_Typ); Len := Len + Bnd.Len; Choice := Get_Chain (Choice); end loop; @@ -323,7 +320,7 @@ package body Synth.Vhdl_Stmts is -- Compute the type. case Base_Typ.Kind is when Type_Unbounded_Vector => - Res := Create_Vector_Type (Bnd, Base_Typ.Uvec_El); + Res := Create_Vector_Type (Bnd, Base_Typ.Uarr_El); when others => raise Internal_Error; end case; @@ -344,6 +341,7 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration + | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Dereference => @@ -417,14 +415,14 @@ package body Synth.Vhdl_Stmts is end case; end Aggregate_Extract; - procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; - Target : Node; - Target_Typ : Type_Acc; - Val : Valtyp; - Loc : Node) + procedure Assign_Aggregate (Inst : Synth_Instance_Acc; + Target : Node; + Target_Typ : Type_Acc; + Val : Valtyp; + Loc : Node) is - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Targ_Bnd : constant Bound_Type := Get_Array_Bound (Target_Typ, 1); + Ctxt : constant Context_Acc := Get_Build (Inst); + Targ_Bnd : constant Bound_Type := Get_Array_Bound (Target_Typ); Choice : Node; Assoc : Node; Pos : Uns32; @@ -436,23 +434,96 @@ package body Synth.Vhdl_Stmts is Assoc := Get_Associated_Expr (Choice); case Get_Kind (Choice) is when Iir_Kind_Choice_By_None => - Targ_Info := Synth_Target (Syn_Inst, Assoc); + Targ_Info := Synth_Target (Inst, Assoc); if Get_Element_Type_Flag (Choice) then Pos := Pos - 1; else - Pos := Pos - Get_Array_Bound (Targ_Info.Targ_Type, 1).Len; + Pos := Pos - Get_Array_Bound (Targ_Info.Targ_Type).Len; end if; - Synth_Assignment - (Syn_Inst, Targ_Info, - Aggregate_Extract (Ctxt, Val, Pos, - Targ_Info.Targ_Type, Assoc), - Loc); + Assign (Inst, Targ_Info, + Aggregate_Extract (Ctxt, Val, Pos, + Targ_Info.Targ_Type, Assoc), + Loc); when others => - Error_Kind ("synth_assignment_aggregate", Choice); + Error_Kind ("assign_aggregate", Choice); end case; Choice := Get_Chain (Choice); end loop; - end Synth_Assignment_Aggregate; + end Assign_Aggregate; + + procedure Synth_Assignment_Aggregate is + new Assign_Aggregate (Assign => Synth_Assignment); + + procedure Synth_Assignment_Simple (Syn_Inst : Synth_Instance_Acc; + Targ : Valtyp; + Off : Value_Offsets; + Val : Valtyp; + Loc : Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + W : Wire_Id; + V : Valtyp; + begin + if Targ = No_Valtyp then + -- There was an error. + return; + end if; + + if Targ.Val.Kind = Value_Alias then + Synth_Assignment_Simple (Syn_Inst, (Targ.Val.A_Typ, Targ.Val.A_Obj), + Off + Targ.Val.A_Off, Val, Loc); + return; + end if; + + V := Val; + + if Targ.Val.Kind = Value_Wire then + W := Get_Value_Wire (Targ.Val); + if Is_Static (V.Val) + and then V.Typ.Sz = Targ.Typ.Sz + then + pragma Assert (Off = No_Value_Offsets); + Phi_Assign_Static (W, Unshare (Get_Memtyp (V))); + else + if V.Typ.W = 0 then + -- Forget about null wires. + return; + end if; + Phi_Assign_Net (Ctxt, W, Get_Net (Ctxt, V), Off.Net_Off); + end if; + else + if not Is_Static (V.Val) then + -- Maybe the error message is too cryptic ? + Error_Msg_Synth + (+Loc, "cannot assign a net to a static value"); + else + Copy_Memory (Targ.Val.Mem + Off.Mem_Off, Get_Memory (V), V.Typ.Sz); + end if; + end if; + end Synth_Assignment_Simple; + + procedure Synth_Assignment_Memory (Syn_Inst : Synth_Instance_Acc; + Targ_Base : Value_Acc; + Targ_Poff : Uns32; + Targ_Ptyp : Type_Acc; + Targ_Voff : Net; + Targ_Eoff : Uns32; + Val : Valtyp; + Loc : Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + W : constant Wire_Id := Get_Value_Wire (Targ_Base); + N : Net; + begin + -- Get the whole memory. + N := Get_Current_Assign_Value (Ctxt, W, Targ_Poff, Targ_Ptyp.W); + -- Insert the new value. + N := Build_Dyn_Insert + (Ctxt, N, Get_Net (Ctxt, Val), Targ_Voff, Targ_Eoff); + Set_Location (N, Loc); + -- Write. + Phi_Assign_Net (Ctxt, W, N, Targ_Poff); + end Synth_Assignment_Memory; procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Target_Info; @@ -461,7 +532,6 @@ package body Synth.Vhdl_Stmts is is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); V : Valtyp; - W : Wire_Id; begin V := Synth_Subtype_Conversion (Ctxt, Val, Target.Targ_Type, False, Loc); pragma Unreferenced (Val); @@ -475,52 +545,13 @@ package body Synth.Vhdl_Stmts is Synth_Assignment_Aggregate (Syn_Inst, Target.Aggr, Target.Targ_Type, V, Loc); when Target_Simple => - if V.Typ.Sz = 0 then - -- If there is nothing to assign (like a null slice), - -- return now. - return; - end if; - - if Target.Obj.Val.Kind = Value_Wire then - W := Get_Value_Wire (Target.Obj.Val); - if Is_Static (V.Val) - and then V.Typ.Sz = Target.Obj.Typ.Sz - then - pragma Assert (Target.Off = (0, 0)); - Phi_Assign_Static (W, Unshare (Get_Memtyp (V))); - else - if V.Typ.W = 0 then - -- Forget about null wires. - return; - end if; - Phi_Assign_Net - (Ctxt, W, Get_Net (Ctxt, V), Target.Off.Net_Off); - end if; - else - if not Is_Static (V.Val) then - -- Maybe the error message is too cryptic ? - Error_Msg_Synth - (+Loc, "cannot assign a net to a static value"); - else - Strip_Const (V); - Copy_Memory (Target.Obj.Val.Mem + Target.Off.Mem_Off, - V.Val.Mem, V.Typ.Sz); - end if; - end if; + Synth_Assignment_Simple (Syn_Inst, Target.Obj, Target.Off, V, Loc); when Target_Memory => - declare - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - W : constant Wire_Id := Get_Value_Wire (Target.Mem_Obj.Val); - N : Net; - begin - N := Get_Current_Assign_Value - (Ctxt, W, - Target.Mem_Dyn.Pfx_Off.Net_Off, Target.Mem_Dyn.Pfx_Typ.W); - N := Build_Dyn_Insert (Ctxt, N, Get_Net (Ctxt, V), - Target.Mem_Dyn.Voff, Target.Mem_Doff); - Set_Location (N, Loc); - Phi_Assign_Net (Ctxt, W, N, Target.Mem_Dyn.Pfx_Off.Net_Off); - end; + Synth_Assignment_Memory + (Syn_Inst, Target.Mem_Obj.Val, + Target.Mem_Dyn.Pfx_Off.Net_Off, Target.Mem_Dyn.Pfx_Typ, + Target.Mem_Dyn.Voff, Target.Mem_Doff, + V, Loc); end case; end Synth_Assignment; @@ -851,8 +882,8 @@ package body Synth.Vhdl_Stmts is when Type_Discrete => return False; when Type_Vector => - if V.Typ.Vec_El = Logic_Type then - for I in 1 .. Size_Type (V.Typ.Vbound.Len) loop + if V.Typ.Arr_El = Logic_Type then + for I in 1 .. Size_Type (V.Typ.Abound.Len) loop if Ignore_Choice_Logic (Read_U8 (V.Val.Mem + (I - 1)), Loc) then return True; @@ -1578,16 +1609,6 @@ package body Synth.Vhdl_Stmts is end if; end Synth_Label; - function Is_Copyback_Interface (Inter : Node) return Boolean is - begin - case Iir_Parameter_Modes (Get_Mode (Inter)) is - when Iir_In_Mode => - return False; - when Iir_Out_Mode | Iir_Inout_Mode => - return Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration; - end case; - end Is_Copyback_Interface; - type Association_Iterator_Kind is (Association_Function, Association_Operator); @@ -1623,36 +1644,6 @@ package body Synth.Vhdl_Stmts is Right => Right); end Association_Iterator_Build; - function Count_Associations (Init : Association_Iterator_Init) - return Natural - is - Assoc : Node; - Assoc_Inter : Node; - Inter : Node; - Nbr_Inout : Natural; - begin - case Init.Kind is - when Association_Function => - Nbr_Inout := 0; - - Assoc := Init.Assoc_Chain; - Assoc_Inter := Init.Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); - - if Is_Copyback_Interface (Inter) then - Nbr_Inout := Nbr_Inout + 1; - end if; - - Next_Association_Interface (Assoc, Assoc_Inter); - end loop; - - return Nbr_Inout; - when Association_Operator => - return 0; - end case; - end Count_Associations; - type Association_Iterator (Kind : Association_Iterator_Kind := Association_Function) is record @@ -1729,7 +1720,9 @@ package body Synth.Vhdl_Stmts is Formal := Get_Formal (Assoc); pragma Assert (Formal /= Null_Node); Formal := Get_Interface_Of_Formal (Formal); - if Formal = Inter then + -- Compare by identifier, as INTER can be the generic + -- interface, while FORMAL is the instantiated one. + if Get_Identifier (Formal) = Get_Identifier (Inter) then -- Found. -- Optimize in case assocs are in order. if Assoc = Iterator.First_Named_Assoc then @@ -1750,26 +1743,42 @@ package body Synth.Vhdl_Stmts is end case; end Association_Iterate_Next; - procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; - Caller_Inst : Synth_Instance_Acc; - Init : Association_Iterator_Init; - Infos : out Target_Info_Array) + function Info_To_Valtyp (Info : Target_Info) return Valtyp is + begin + case Info.Kind is + when Target_Simple => + if Info.Off = No_Value_Offsets then + return Info.Obj; + else + return Create_Value_Alias (Info.Obj, Info.Off, Info.Targ_Type); + end if; + when Target_Aggregate => + raise Internal_Error; + when Target_Memory => + return Create_Value_Dyn_Alias (Info.Mem_Obj.Val, + Info.Mem_Dyn.Pfx_Off.Net_Off, + Info.Mem_Dyn.Pfx_Typ, + Info.Mem_Dyn.Voff, + Info.Mem_Doff, + Info.Targ_Type); + end case; + end Info_To_Valtyp; + + procedure Synth_Subprogram_Associations (Subprg_Inst : Synth_Instance_Acc; + Caller_Inst : Synth_Instance_Acc; + Init : Association_Iterator_Init) is - pragma Assert (Infos'First = 1); Ctxt : constant Context_Acc := Get_Build (Caller_Inst); Inter : Node; Inter_Type : Type_Acc; Assoc : Node; Actual : Node; Val : Valtyp; - Nbr_Inout : Natural; Iterator : Association_Iterator; Info : Target_Info; begin Set_Instance_Const (Subprg_Inst, True); - Nbr_Inout := 0; - -- Process in INTER order. Association_Iterate_Init (Iterator, Init); loop @@ -1778,8 +1787,9 @@ package body Synth.Vhdl_Stmts is Inter_Type := Get_Subtype_Object (Subprg_Inst, Get_Type (Inter)); - case Iir_Parameter_Modes (Get_Mode (Inter)) is - when Iir_In_Mode => + case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is + when Iir_Kind_Interface_Constant_Declaration => + pragma Assert (Get_Mode (Inter) = Iir_In_Mode); if Assoc = Null_Node or else Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then @@ -1797,40 +1807,38 @@ package body Synth.Vhdl_Stmts is Val := Synth_Expression_With_Type (Caller_Inst, Actual, Inter_Type); end if; - when Iir_Out_Mode | Iir_Inout_Mode => + when Iir_Kind_Interface_Variable_Declaration => + -- Always pass by value. Actual := Get_Actual (Assoc); Info := Synth_Target (Caller_Inst, Actual); - - case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) - is - when Iir_Kind_Interface_Constant_Declaration => - raise Internal_Error; - when Iir_Kind_Interface_Variable_Declaration => - -- Always pass by value. - Nbr_Inout := Nbr_Inout + 1; - Infos (Nbr_Inout) := Info; - if Info.Kind /= Target_Memory - and then Is_Static (Info.Obj.Val) - then - Val := Create_Value_Memory (Info.Targ_Type); - Copy_Memory (Val.Val.Mem, - Info.Obj.Val.Mem + Info.Off.Mem_Off, - Info.Targ_Type.Sz); - else - Val := Synth_Read (Caller_Inst, Info, Assoc); - end if; - when Iir_Kind_Interface_Signal_Declaration => - -- Always pass by reference (use an alias). - if Info.Kind = Target_Memory then - raise Internal_Error; - end if; - Val := Create_Value_Alias - (Info.Obj, Info.Off, Info.Targ_Type); - when Iir_Kind_Interface_File_Declaration => - Val := Info.Obj; - when Iir_Kind_Interface_Quantity_Declaration => - raise Internal_Error; - end case; + if Is_Copyback_Parameter (Inter) then + Create_Object (Caller_Inst, Assoc, Info_To_Valtyp (Info)); + end if; + if Info.Kind /= Target_Memory + and then Is_Static (Info.Obj.Val) + then + Val := Create_Value_Memory (Info.Targ_Type); + Copy_Memory (Val.Val.Mem, + Info.Obj.Val.Mem + Info.Off.Mem_Off, + Info.Targ_Type.Sz); + else + Val := Synth_Read (Caller_Inst, Info, Assoc); + end if; + when Iir_Kind_Interface_Signal_Declaration => + -- Always pass by reference (use an alias). + Actual := Get_Actual (Assoc); + Info := Synth_Target (Caller_Inst, Actual); + if Info.Kind = Target_Memory then + raise Internal_Error; + end if; + Val := Create_Value_Alias + (Info.Obj, Info.Off, Info.Targ_Type); + when Iir_Kind_Interface_File_Declaration => + Actual := Get_Actual (Assoc); + Info := Synth_Target (Caller_Inst, Actual); + Val := Info.Obj; + when Iir_Kind_Interface_Quantity_Declaration => + raise Internal_Error; end case; if Val = No_Valtyp then @@ -1842,9 +1850,14 @@ package body Synth.Vhdl_Stmts is case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration => - -- Always passed by value - Val := Synth_Subtype_Conversion - (Ctxt, Val, Inter_Type, True, Assoc); + if Get_Mode (Inter) /= Iir_Out_Mode then + -- Always passed by value + Val := Synth_Subtype_Conversion + (Ctxt, Val, Inter_Type, True, Assoc); + else + -- Use default value ? + null; + end if; when Iir_Kind_Interface_Signal_Declaration => -- LRM08 4.2.2.3 Signal parameters -- If an actual signal is associated with a signal parameter @@ -1905,7 +1918,7 @@ package body Synth.Vhdl_Stmts is case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration => - -- Pass by reference. + -- Pass by copy. Create_Object (Subprg_Inst, Inter, Val); when Iir_Kind_Interface_Variable_Declaration => -- Arguments are passed by copy. @@ -1925,19 +1938,17 @@ package body Synth.Vhdl_Stmts is raise Internal_Error; end case; end loop; - end Synth_Subprogram_Association; + end Synth_Subprogram_Associations; procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; Assoc_Chain : Node) is - Infos : Target_Info_Array (1 .. 0); Init : Association_Iterator_Init; begin Init := Association_Iterator_Build (Inter_Chain, Assoc_Chain); - Synth_Subprogram_Association (Subprg_Inst, Caller_Inst, Init, Infos); - pragma Unreferenced (Infos); + Synth_Subprogram_Associations (Subprg_Inst, Caller_Inst, Init); end Synth_Subprogram_Association; -- Create wires for out and inout interface variables. @@ -1975,31 +1986,39 @@ package body Synth.Vhdl_Stmts is procedure Synth_Subprogram_Back_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; - Init : Association_Iterator_Init; - Infos : Target_Info_Array) + Inter_Chain : Node; + Assoc_Chain : Node) is - pragma Assert (Infos'First = 1); Inter : Node; Assoc : Node; Assoc_Inter : Node; Val : Valtyp; - Nbr_Inout : Natural; + Targ : Valtyp; W : Wire_Id; + D : Destroy_Type; begin - Nbr_Inout := 0; - pragma Assert (Init.Kind = Association_Function); - Assoc := Init.Assoc_Chain; - Assoc_Inter := Init.Inter_Chain; + Destroy_Init (D, Caller_Inst); + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); - if Is_Copyback_Interface (Inter) then + if Is_Copyback_Parameter (Inter) then if not Get_Whole_Association_Flag (Assoc) then raise Internal_Error; end if; - Nbr_Inout := Nbr_Inout + 1; + Targ := Get_Value (Caller_Inst, Assoc); Val := Get_Value (Subprg_Inst, Inter); - Synth_Assignment (Caller_Inst, Infos (Nbr_Inout), Val, Assoc); + if Targ.Val.Kind = Value_Dyn_Alias then + Synth_Assignment_Memory + (Caller_Inst, Targ.Val.D_Obj, + Targ.Val.D_Poff, Targ.Val.D_Ptyp, + Get_Value_Dyn_Alias_Voff (Targ.Val), Targ.Val.D_Eoff, + Val, Assoc); + else + Synth_Assignment_Simple + (Caller_Inst, Targ, No_Value_Offsets, Val, Assoc); + end if; -- Free wire used for out/inout interface variables. if Val.Val.Kind = Value_Wire then @@ -2007,11 +2026,13 @@ package body Synth.Vhdl_Stmts is Phi_Discard_Wires (W, No_Wire_Id); Free_Wire (W); end if; + + Destroy_Object (D, Assoc); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; - pragma Assert (Nbr_Inout = Infos'Last); + Destroy_Finish (D); end Synth_Subprogram_Back_Association; function Build_Control_Signal (Syn_Inst : Synth_Instance_Acc; @@ -2029,8 +2050,7 @@ package body Synth.Vhdl_Stmts is function Synth_Dynamic_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Sub_Inst : Synth_Instance_Acc; Call : Node; - Init : Association_Iterator_Init; - Infos : Target_Info_Array) + Init : Association_Iterator_Init) return Valtyp is Imp : constant Node := Get_Implementation (Call); @@ -2106,7 +2126,8 @@ package body Synth.Vhdl_Stmts is end if; else Res := No_Valtyp; - Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Back_Association + (C.Inst, Syn_Inst, Init.Inter_Chain, Init.Assoc_Chain); end if; end if; @@ -2114,7 +2135,6 @@ package body Synth.Vhdl_Stmts is Vhdl_Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - pragma Unreferenced (Infos); -- Propagate assignments. -- Wires that have been created for this subprogram will be destroyed. @@ -2141,8 +2161,7 @@ package body Synth.Vhdl_Stmts is Sub_Inst : Synth_Instance_Acc; Call : Node; Bod : Node; - Init : Association_Iterator_Init; - Infos : Target_Info_Array) + Init : Association_Iterator_Init) return Valtyp is Imp : constant Node := Get_Implementation (Call); @@ -2184,17 +2203,31 @@ package body Synth.Vhdl_Stmts is end if; else Res := No_Valtyp; - Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Back_Association + (C.Inst, Syn_Inst, Init.Inter_Chain, Init.Assoc_Chain); end if; end if; Vhdl_Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - pragma Unreferenced (Infos); return Res; end Synth_Static_Subprogram_Call; + function Synth_Subprogram_Call_Instance (Inst : Synth_Instance_Acc; + Imp : Node; + Bod : Node) + return Synth_Instance_Acc + is + Res : Synth_Instance_Acc; + Up_Inst : Synth_Instance_Acc; + begin + Up_Inst := Get_Instance_By_Scope (Inst, Get_Parent_Scope (Imp)); + Res := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node); + Set_Caller_Instance (Res, Inst); + return Res; + end Synth_Subprogram_Call_Instance; + function Synth_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Call : Node; Init : Association_Iterator_Init) @@ -2204,23 +2237,18 @@ package body Synth.Vhdl_Stmts is Imp : constant Node := Get_Implementation (Call); Is_Func : constant Boolean := Is_Function_Declaration (Imp); Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp); - Nbr_Inout : constant Natural := Count_Associations (Init); - Infos : Target_Info_Array (1 .. Nbr_Inout); Area_Mark : Areapools.Mark_Type; Res : Valtyp; Sub_Inst : Synth_Instance_Acc; - Up_Inst : Synth_Instance_Acc; begin Areapools.Mark (Area_Mark, Instance_Pool.all); - Up_Inst := Get_Instance_By_Scope (Syn_Inst, Get_Parent_Scope (Imp)); - Sub_Inst := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node); - Set_Caller_Instance (Sub_Inst, Syn_Inst); + Sub_Inst := Synth_Subprogram_Call_Instance (Syn_Inst, Imp, Bod); if Ctxt /= null then Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); end if; - Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init); if Is_Error (Sub_Inst) then Res := No_Valtyp; @@ -2233,10 +2261,10 @@ package body Synth.Vhdl_Stmts is if Get_Instance_Const (Sub_Inst) then Res := Synth_Static_Subprogram_Call - (Syn_Inst, Sub_Inst, Call, Bod, Init, Infos); + (Syn_Inst, Sub_Inst, Call, Bod, Init); else Res := Synth_Dynamic_Subprogram_Call - (Syn_Inst, Sub_Inst, Call, Init, Infos); + (Syn_Inst, Sub_Inst, Call, Init); end if; end if; @@ -2300,8 +2328,6 @@ package body Synth.Vhdl_Stmts is Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Init : constant Association_Iterator_Init := Association_Iterator_Build (Inter_Chain, Assoc_Chain); - Nbr_Inout : constant Natural := Count_Associations (Init); - Infos : Target_Info_Array (1 .. Nbr_Inout); Area_Mark : Areapools.Mark_Type; Sub_Inst : Synth_Instance_Acc; begin @@ -2312,11 +2338,12 @@ package body Synth.Vhdl_Stmts is Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); end if; - Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init); Synth.Vhdl_Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call); - Synth_Subprogram_Back_Association (Sub_Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Back_Association + (Sub_Inst, Syn_Inst, Init.Inter_Chain, Init.Assoc_Chain); Free_Instance (Sub_Inst); Areapools.Release (Area_Mark, Instance_Pool.all); @@ -2678,11 +2705,14 @@ package body Synth.Vhdl_Stmts is is Iterator : constant Node := Get_Parameter_Specification (Stmt); It_Type : constant Node := Get_Declaration_Type (Iterator); + D : Destroy_Type; begin - Destroy_Object (Inst, Iterator); + Destroy_Init (D, Inst); + Destroy_Object (D, Iterator); if It_Type /= Null_Node then - Destroy_Object (Inst, It_Type); + Destroy_Object (D, It_Type); end if; + Destroy_Finish (D); end Finish_For_Loop_Statement; procedure Synth_Dynamic_For_Loop_Statement @@ -2950,7 +2980,7 @@ package body Synth.Vhdl_Stmts is Put_Err ("): "); if Rep = No_Valtyp then - Put_Line_Err ("assertion failure"); + Put_Line_Err ("Assertion violation"); else Put_Line_Err (Value_To_String (Rep)); end if; @@ -2961,10 +2991,53 @@ package body Synth.Vhdl_Stmts is end if; end Synth_Static_Report; - procedure Synth_Static_Report_Statement (C : Seq_Context; Stmt : Node) is + procedure Execute_Report_Statement (Inst : Synth_Instance_Acc; + Stmt : Node) is begin - Synth_Static_Report (C.Inst, Stmt); - end Synth_Static_Report_Statement; + Synth_Static_Report (Inst, Stmt); + end Execute_Report_Statement; + + -- Return True if EXPR can be evaluated with static values. + -- Does not need to be fully accurate, used for report/assert messages. + function Is_Static_Expr (Inst : Synth_Instance_Acc; + Expr : Node) return Boolean is + begin + case Get_Kind (Expr) is + when Iir_Kinds_Dyadic_Operator => + return Is_Static_Expr (Inst, Get_Left (Expr)) + and then Is_Static_Expr (Inst, Get_Right (Expr)); + when Iir_Kind_Image_Attribute => + return Is_Static_Expr (Inst, Get_Parameter (Expr)); + when Iir_Kind_Instance_Name_Attribute + | Iir_Kinds_Literal + | Iir_Kind_Enumeration_Literal => + return True; + when Iir_Kind_Length_Array_Attribute => + -- Attributes on types can be evaluated. + return True; + when Iir_Kind_Simple_Name => + return Is_Static_Expr (Inst, Get_Named_Entity (Expr)); + when others => + Error_Kind ("is_static_expr", Expr); + return False; + end case; + end Is_Static_Expr; + + procedure Synth_Dynamic_Report_Statement (Inst : Synth_Instance_Acc; + Stmt : Node; + Is_Cond : Boolean) + is + Rep_Expr : constant Node := Get_Report_Expression (Stmt); + Sev_Expr : constant Node := Get_Severity_Expression (Stmt); + begin + if not Is_Cond + and then Is_Static_Expr (Inst, Rep_Expr) + and then (Sev_Expr = Null_Node + or else Is_Static_Expr (Inst, Sev_Expr)) + then + Synth_Static_Report (Inst, Stmt); + end if; + end Synth_Dynamic_Report_Statement; procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc; Stmt : Node) @@ -3083,7 +3156,12 @@ package body Synth.Vhdl_Stmts is Synth_Procedure_Call (C.Inst, Stmt); when Iir_Kind_Report_Statement => if not Is_Dyn then - Synth_Static_Report_Statement (C, Stmt); + Execute_Report_Statement (C.Inst, Stmt); + else + -- Not executed. + -- Depends on the execution path: the report statement may + -- be conditionally executed. + Synth_Dynamic_Report_Statement (C.Inst, Stmt, True); end if; when Iir_Kind_Assertion_Statement => if not Is_Dyn then diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index 96c7d8c6c..44ffe890b 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -28,6 +28,12 @@ with Netlists; use Netlists; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; package Synth.Vhdl_Stmts is + -- Create a new Synth_Instance for calling subprogram IMP/BOD. + function Synth_Subprogram_Call_Instance (Inst : Synth_Instance_Acc; + Imp : Node; + Bod : Node) + return Synth_Instance_Acc; + procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; @@ -97,6 +103,8 @@ package Synth.Vhdl_Stmts is procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc; Stmt : Node); + procedure Execute_Report_Statement (Inst : Synth_Instance_Acc; + Stmt : Node); procedure Init_For_Loop_Statement (Inst : Synth_Instance_Acc; Stmt : Node; Val : out Valtyp); @@ -104,8 +112,15 @@ package Synth.Vhdl_Stmts is Stmt : Node); procedure Synth_Variable_Assignment (Inst : Synth_Instance_Acc; Stmt : Node); + procedure Synth_Conditional_Variable_Assignment + (Inst : Synth_Instance_Acc; Stmt : Node); procedure Synth_Procedure_Call (Syn_Inst : Synth_Instance_Acc; Stmt : Node); + procedure Synth_Subprogram_Back_Association + (Subprg_Inst : Synth_Instance_Acc; + Caller_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node); -- Return the statements chain to be executed. function Execute_Static_Case_Statement @@ -149,6 +164,19 @@ package Synth.Vhdl_Stmts is function Synth_Target (Syn_Inst : Synth_Instance_Acc; Target : Node) return Target_Info; + -- Split aggregate assignment into smaller parts. + generic + with procedure Assign (Inst : Synth_Instance_Acc; + Targ_Info : Target_Info; + Val : Valtyp; + Loc : Node); + procedure Assign_Aggregate (Inst : Synth_Instance_Acc; + Target : Node; + Target_Typ : Type_Acc; + Val : Valtyp; + Loc : Node); + + private -- There are 2 execution mode: -- * static: it is like simulation, all the inputs are known, neither diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index 310a30a59..911b2d5f6 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -79,6 +79,10 @@ package body Synthesis is procedure Instance_Passes (Ctxt : Context_Acc; M : Module) is begin + if not Synth.Flags.Flag_Debug_Nonull then + Netlists.Cleanup.Replace_Null_Inputs (Ctxt, M); + end if; + -- Remove unused gates. This is not only an optimization but also -- a correctness point: there might be some unsynthesizable gates, like -- the one created for 'rising_egde (clk) and not rst'. diff --git a/src/utils_io.adb b/src/utils_io.adb index d883ccddf..78b9a9d7b 100644 --- a/src/utils_io.adb +++ b/src/utils_io.adb @@ -14,6 +14,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Ada.Unchecked_Conversion; + with Simple_IO; use Simple_IO; package body Utils_IO is @@ -46,4 +48,22 @@ package body Utils_IO is begin Put_Trim (Int64'Image (V)); end Put_Int64; + + Hex_Map : constant array (0 .. 15) of Character := "0123456789ABCDEF"; + + procedure Put_Addr (V : System.Address) + is + type Integer_Address is mod System.Memory_Size; + function To_Integer is new Ada.Unchecked_Conversion + (Source => System.Address, Target => Integer_Address); + Res : String (1 .. System.Word_Size / 4); + Val : Integer_Address := To_Integer (V); + begin + for I in reverse Res'Range loop + Res (I) := Hex_Map (Natural (Val and 15)); + Val := Val / 16; + end loop; + Put (Res); + end Put_Addr; + end Utils_IO; diff --git a/src/utils_io.ads b/src/utils_io.ads index ef0c5f1ee..a99d52c3c 100644 --- a/src/utils_io.ads +++ b/src/utils_io.ads @@ -14,6 +14,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with System; + with Types; use Types; package Utils_IO is @@ -27,4 +29,6 @@ package Utils_IO is procedure Put_Uns32 (V : Uns32); procedure Put_Int32 (V : Int32); procedure Put_Int64 (V : Int64); + + procedure Put_Addr (V : System.Address); end Utils_IO; diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb index 31c000bd3..c66961954 100644 --- a/src/vhdl/translate/trans-chap14.adb +++ b/src/vhdl/translate/trans-chap14.adb @@ -31,22 +31,57 @@ with Trans.Foreach_Non_Composite; package body Trans.Chap14 is use Trans.Helpers; + function Translate_Name_Bounds (Name : Iir) return Mnode + is + Res : Mnode; + begin + case Get_Kind (Name) is + when Iir_Kinds_Denoting_Name => + return Translate_Name_Bounds (Get_Named_Entity (Name)); + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration => + Res := T2M (Get_Type (Name), Mode_Value); + Res := Chap3.Get_Composite_Bounds (Res); + return Res; + when Iir_Kinds_Object_Declaration + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Slice_Name + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Function_Call => + -- Prefix is an object. + Res := Chap6.Translate_Name (Name, Mode_Value); + Res := Chap3.Get_Composite_Bounds (Res); + return Res; + when Iir_Kind_Element_Attribute => + declare + Pfx : constant Iir := Get_Prefix (Name); + Pfx_Type : constant Iir := Get_Type (Pfx); + begin + Res := Translate_Name_Bounds (Pfx); + Res := Chap3.Array_Bounds_To_Element_Bounds (Res, Pfx_Type); + return Res; + end; + when others => + Error_Kind ("translate_name_bounds", Name); + end case; + end Translate_Name_Bounds; + function Translate_Array_Attribute_To_Range (Expr : Iir) return Mnode is - Prefix : constant Iir := Get_Prefix (Expr); - Type_Name : constant Iir := Is_Type_Name (Prefix); - Arr : Mnode; - Dim : Natural; + Prefix : constant Iir := Get_Prefix (Expr); + Bnd : Mnode; + Dim : Natural; begin - if Type_Name /= Null_Iir then - -- Prefix denotes a type name - Arr := T2M (Type_Name, Mode_Value); - else - -- Prefix is an object. - Arr := Chap6.Translate_Name (Prefix, Mode_Value); - end if; + Bnd := Translate_Name_Bounds (Prefix); Dim := Eval_Attribute_Parameter_Or_1 (Expr); - return Chap3.Get_Array_Range (Arr, Get_Type (Prefix), Dim); + return Chap3.Bounds_To_Range (Bnd, Get_Type (Prefix), Dim); end Translate_Array_Attribute_To_Range; function Translate_Range_Array_Attribute (Expr : Iir) diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index d9feeb16d..f1db4d40b 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -3123,6 +3123,7 @@ package body Trans.Chap4 is Entity : Iir) is pragma Unreferenced (Num); + use Trans.Chap5; Formal : constant Iir := Get_Association_Formal (Assoc, Inter); Actual : constant Iir := Get_Actual (Assoc); Block_Info : constant Block_Info_Acc := Get_Info (Base_Block); @@ -3131,6 +3132,7 @@ package body Trans.Chap4 is Entity_Info : Ortho_Info_Acc; Targ : Mnode; Val : Mnode; + Act_Env : Map_Env; begin -- Declare the subprogram. Assoc_Info := Add_Info (Assoc, Kind_Inertial_Assoc); @@ -3153,6 +3155,7 @@ package body Trans.Chap4 is Open_Temp; -- Access for formals. + Act_Env.Scope_Ptr := null; if Entity /= Null_Iir then Entity_Info := Get_Info (Entity); declare @@ -3177,9 +3180,13 @@ package body Trans.Chap4 is Inst_Info.Block_Link_Field), Rtis.Ghdl_Component_Link_Instance)), Entity_Info.Block_Decls_Ptr_Type)); + -- Save previous scope for recursive instantiation. + Save_Map_Env (Act_Env, Entity_Info.Block_Scope'Access); + if not Is_Null (Entity_Info.Block_Scope) then + Clear_Scope (Entity_Info.Block_Scope); + end if; Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, V); end if; - end; end if; @@ -3187,6 +3194,11 @@ package body Trans.Chap4 is -- 1. Translate target (translate_name) Targ := Chap6.Translate_Name (Formal, Mode_Signal); + if Act_Env.Scope_Ptr /= null then + -- Switch to the actual environment (if any). + Set_Map_Env (Act_Env); + end if; + -- 2. Translate expression Val := Chap7.Translate_Expression (Actual, Get_Type (Formal)); @@ -3201,9 +3213,10 @@ package body Trans.Chap4 is if Entity /= Null_Iir then if Entity_Info.Kind = Kind_Component then + pragma Assert (Act_Env.Scope_Ptr = null); Clear_Scope (Entity_Info.Comp_Scope); else - Clear_Scope (Entity_Info.Block_Scope); + Restore_Map_Env (Act_Env); end if; end if; diff --git a/src/vhdl/translate/trans-chap5.ads b/src/vhdl/translate/trans-chap5.ads index ab54e67da..88627da56 100644 --- a/src/vhdl/translate/trans-chap5.ads +++ b/src/vhdl/translate/trans-chap5.ads @@ -42,6 +42,7 @@ package Trans.Chap5 is -- Save and restore the map environment defined by ENV. procedure Save_Map_Env (Env : out Map_Env; Scope_Ptr : Var_Scope_Acc); procedure Set_Map_Env (Env : Map_Env); + procedure Restore_Map_Env (Env : Map_Env); procedure Elab_Generic_Map_Aspect (Header : Iir; Map : Iir; Formal_Env : Map_Env); diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index bd80b1050..17eb783ea 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -4408,15 +4408,19 @@ package body Trans.Chap7 is function Translate_Overflow_Literal (Expr : Iir) return O_Enode is Expr_Type : constant Iir := Get_Type (Expr); - Tinfo : constant Type_Info_Acc := Get_Info (Expr_Type); - Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value); + Tinfo : Type_Info_Acc; + Otype : O_Tnode; L : O_Dnode; begin + Chap3.Translate_Anonymous_Subtype_Definition (Expr_Type, False); + -- Generate the error message Chap6.Gen_Bound_Error (Expr); -- Create a dummy value, for type checking. But never -- executed. + Tinfo := Get_Info (Expr_Type); + Otype := Tinfo.Ortho_Type (Mode_Value); L := Create_Temp (Otype); if Tinfo.Type_Mode in Type_Mode_Fat then -- For fat pointers or arrays. diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 2b24e3737..05cac2c56 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -3307,7 +3307,9 @@ package body Trans.Chap8 is -- Set the PARAMS field. Assign_Params_Field (M2E (Mval), Mode_Value); end if; - elsif Formal_Info.Interface_Field (Mode_Value) /= O_Fnode_Null then + elsif Formal_Info.Interface_Decl (Mode_Value) = O_Dnode_Null + and then Formal_Info.Interface_Field (Mode_Value) /= O_Fnode_Null + then Assign_Params_Field (Val, Mode_Value); if Sig /= O_Enode_Null then @@ -3531,8 +3533,13 @@ package body Trans.Chap8 is Get_Association_Interface (El, Inter); Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal); begin - if Formal_Info.Interface_Field (Mode_Value) = O_Fnode_Null then + if Formal_Info.Interface_Decl (Mode_Value) /= O_Dnode_Null then -- Not a PARAMS field. + -- Note: an interface can be both a PARAMS field and an ortho + -- interface. This is the case for functions with nested + -- subprograms. At the start of those functions, the interface + -- is copied. But for a call, the actual must be passed as + -- a value of the interface. if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then -- Pass the whole data for an individual association. diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb index d2a38d4b7..68594479c 100644 --- a/src/vhdl/translate/trans_analyzes.adb +++ b/src/vhdl/translate/trans_analyzes.adb @@ -164,7 +164,7 @@ package body Trans_Analyzes is -- (It is cleared for any statement, just to factorize code). Has_After := False; - case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is + case Iir_Kinds_Sequential_Statement_Ext (Get_Kind (Stmt)) is when Iir_Kind_Simple_Signal_Assignment_Statement => Extract_Driver_Simple_Signal_Assignment (Stmt); when Iir_Kind_Signal_Force_Assignment_Statement @@ -191,6 +191,8 @@ package body Trans_Analyzes is | Iir_Kind_If_Statement | Iir_Kind_Break_Statement => null; + when Iir_Kind_Suspend_State_Statement => + null; end case; return Walk_Continue; end Extract_Driver_Stmt; diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb index e4f27f32c..8429d2dab 100644 --- a/src/vhdl/vhdl-annotations.adb +++ b/src/vhdl/vhdl-annotations.adb @@ -328,8 +328,13 @@ package body Vhdl.Annotations is -- Create an annotation for the element type, as it can be -- referenced by the implicit concat function definition for -- concatenation with element. - El := Get_Element_Subtype (Def); - Annotate_Anonymous_Type_Definition (Block_Info, El); + El := Get_Element_Subtype_Indication (Def); + if Get_Kind (El) in Iir_Kinds_Subtype_Definition then + -- But only if it is a proper new subtype definition + -- (ie not a denoting name, or attributes like 'subtype). + El := Get_Element_Subtype (Def); + Annotate_Anonymous_Type_Definition (Block_Info, El); + end if; -- Then for the array. Create_Object_Info (Block_Info, Def, Kind_Type); @@ -779,7 +784,7 @@ package body Vhdl.Annotations is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => if (Get_Implicit_Definition (Decl) - not in Iir_Predefined_Pure_Functions) + not in Iir_Predefined_Operators) and then not Is_Second_Subprogram_Specification (Decl) then Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); @@ -846,6 +851,9 @@ package body Vhdl.Annotations is when Iir_Kind_Psl_Default_Clock => null; + when Iir_Kind_Suspend_State_Declaration => + Create_Object_Info (Block_Info, Decl); + when others => Error_Kind ("annotate_declaration", Decl); end case; @@ -863,10 +871,32 @@ package body Vhdl.Annotations is end loop; end Annotate_Declaration_List; + procedure Annotate_Procedure_Call_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) + is + Call : constant Iir := Get_Procedure_Call (Stmt); + Imp : constant Iir := Get_Implementation (Call); + Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Call); + Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); + Assoc : Iir; + Assoc_Inter : Iir; + Inter : Iir; + begin + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; + while Assoc /= Null_Iir loop + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + if Is_Copyback_Parameter (Inter) then + Create_Object_Info (Block_Info, Assoc, Kind_Object); + end if; + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Annotate_Procedure_Call_Statement; + procedure Annotate_Sequential_Statement_Chain (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir) is - El: Iir; + Stmt : Iir; Max_Nbr_Objects : Object_Slot_Type; Current_Nbr_Objects : Object_Slot_Type; @@ -884,9 +914,9 @@ package body Vhdl.Annotations is Current_Nbr_Objects := Block_Info.Nbr_Objects; Max_Nbr_Objects := Current_Nbr_Objects; - El := Stmt_Chain; - while El /= Null_Iir loop - case Get_Kind (El) is + Stmt := Stmt_Chain; + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is when Iir_Kind_Null_Statement => null; when Iir_Kind_Assertion_Statement @@ -901,7 +931,8 @@ package body Vhdl.Annotations is | Iir_Kind_Conditional_Variable_Assignment_Statement => null; when Iir_Kind_Procedure_Call_Statement => - null; + Annotate_Procedure_Call_Statement (Block_Info, Stmt); + Save_Nbr_Objects; when Iir_Kind_Exit_Statement | Iir_Kind_Next_Statement => null; @@ -910,7 +941,7 @@ package body Vhdl.Annotations is when Iir_Kind_If_Statement => declare - Clause: Iir := El; + Clause: Iir := Stmt; begin loop Annotate_Sequential_Statement_Chain @@ -925,7 +956,7 @@ package body Vhdl.Annotations is declare Assoc: Iir; begin - Assoc := Get_Case_Statement_Alternative_Chain (El); + Assoc := Get_Case_Statement_Alternative_Chain (Stmt); loop Annotate_Sequential_Statement_Chain (Block_Info, Get_Associated_Chain (Assoc)); @@ -937,21 +968,24 @@ package body Vhdl.Annotations is when Iir_Kind_For_Loop_Statement => Annotate_Declaration - (Block_Info, Get_Parameter_Specification (El)); + (Block_Info, Get_Parameter_Specification (Stmt)); Annotate_Sequential_Statement_Chain - (Block_Info, Get_Sequential_Statement_Chain (El)); + (Block_Info, Get_Sequential_Statement_Chain (Stmt)); when Iir_Kind_While_Loop_Statement => Annotate_Sequential_Statement_Chain - (Block_Info, Get_Sequential_Statement_Chain (El)); + (Block_Info, Get_Sequential_Statement_Chain (Stmt)); + + when Iir_Kind_Suspend_State_Statement => + null; when others => - Error_Kind ("annotate_sequential_statement_chain", El); + Error_Kind ("annotate_sequential_statement_chain", Stmt); end case; Save_Nbr_Objects; - El := Get_Chain (El); + Stmt := Get_Chain (Stmt); end loop; Block_Info.Nbr_Objects := Max_Nbr_Objects; end Annotate_Sequential_Statement_Chain; @@ -1114,12 +1148,22 @@ package body Vhdl.Annotations is when Iir_Kind_Concurrent_Simple_Signal_Assignment | Iir_Kind_Concurrent_Selected_Signal_Assignment | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement => + | Iir_Kind_Concurrent_Assertion_Statement => -- In case concurrent signal assignemnts were not -- canonicalized (for synthesis). null; + when Iir_Kind_Concurrent_Procedure_Call_Statement => + declare + Info : Sim_Info_Acc; + begin + Info := new Sim_Info_Type'(Kind => Kind_Process, + Ref => Stmt, + Nbr_Objects => 0); + Set_Info (Stmt, Info); + Annotate_Procedure_Call_Statement (Info, Stmt); + end; + when others => Error_Kind ("annotate_concurrent_statement", Stmt); end case; diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index d37f26493..2a8ef8aa0 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -334,7 +334,7 @@ package body Vhdl.Canon is end Canon_Extract_Sensitivity_If_Not_Null; procedure Canon_Extract_Sensitivity_Procedure_Call - (Sensitivity_List : Iir_List; Call : Iir) + (Call : Iir; Sensitivity_List : Iir_List) is Assoc : Iir; Inter : Iir; @@ -365,22 +365,76 @@ package body Vhdl.Canon is end loop; end Canon_Extract_Sensitivity_Waveform; + procedure Canon_Extract_Sensitivity_Signal_Assignment_Common + (Stmt : Iir; List : Iir_List) is + begin + Canon_Extract_Sensitivity_Expression (Get_Target (Stmt), List, True); + Canon_Extract_Sensitivity_If_Not_Null + (Get_Reject_Time_Expression (Stmt), List); + end Canon_Extract_Sensitivity_Signal_Assignment_Common; + + procedure Canon_Extract_Sensitivity_Conditional_Signal_Assignment + (Stmt : Iir; List : Iir_List) + is + Cwe : Iir; + begin + Canon_Extract_Sensitivity_Signal_Assignment_Common (Stmt, List); + Cwe := Get_Conditional_Waveform_Chain (Stmt); + while Cwe /= Null_Iir loop + Canon_Extract_Sensitivity_If_Not_Null (Get_Condition (Cwe), List); + Canon_Extract_Sensitivity_Waveform (Get_Waveform_Chain (Cwe), List); + Cwe := Get_Chain (Cwe); + end loop; + end Canon_Extract_Sensitivity_Conditional_Signal_Assignment; + + procedure Canon_Extract_Sensitivity_Simple_Signal_Assignment + (Stmt : Iir; List : Iir_List) is + begin + Canon_Extract_Sensitivity_Signal_Assignment_Common (Stmt, List); + Canon_Extract_Sensitivity_Waveform (Get_Waveform_Chain (Stmt), List); + end Canon_Extract_Sensitivity_Simple_Signal_Assignment; + + procedure Canon_Extract_Sensitivity_Selected_Signal_Assignment + (Stmt : Iir; List : Iir_List) + is + Swf : Node; + Wf : Node; + begin + Canon_Extract_Sensitivity_Signal_Assignment_Common (Stmt, List); + Canon_Extract_Sensitivity_Expression (Get_Expression (Stmt), List); + + Swf := Get_Selected_Waveform_Chain (Stmt); + while Swf /= Null_Node loop + Wf := Get_Associated_Chain (Swf); + if Wf /= Null_Iir then + Canon_Extract_Sensitivity_Waveform (Wf, List); + end if; + Swf := Get_Chain (Swf); + end loop; + end Canon_Extract_Sensitivity_Selected_Signal_Assignment; + + procedure Canon_Extract_Sensitivity_Assertion_Statement + (Stmt : Iir; List : Iir_List) is + begin + Canon_Extract_Sensitivity_Expression + (Get_Assertion_Condition (Stmt), List); + Canon_Extract_Sensitivity_If_Not_Null + (Get_Severity_Expression (Stmt), List); + Canon_Extract_Sensitivity_If_Not_Null + (Get_Report_Expression (Stmt), List); + end Canon_Extract_Sensitivity_Assertion_Statement; + procedure Canon_Extract_Sensitivity_Statement (Stmt : Iir; List : Iir_List) is begin - case Get_Kind (Stmt) is + case Iir_Kinds_Sequential_Statement_Ext (Get_Kind (Stmt)) is when Iir_Kind_Assertion_Statement => -- LRM08 11.3 -- * For each assertion, report, next, exit or return -- statement, apply the rule of 10.2 to each expression -- in the statement, and construct the union of the -- resulting sets. - Canon_Extract_Sensitivity_Expression - (Get_Assertion_Condition (Stmt), List); - Canon_Extract_Sensitivity_If_Not_Null - (Get_Severity_Expression (Stmt), List); - Canon_Extract_Sensitivity_If_Not_Null - (Get_Report_Expression (Stmt), List); + Canon_Extract_Sensitivity_Assertion_Statement (Stmt, List); when Iir_Kind_Report_Statement => -- LRM08 11.3 -- See assertion_statement case. @@ -412,29 +466,10 @@ package body Vhdl.Canon is when Iir_Kind_Simple_Signal_Assignment_Statement => -- LRM08 11.3 -- See variable assignment statement case. - Canon_Extract_Sensitivity_Expression - (Get_Target (Stmt), List, True); - Canon_Extract_Sensitivity_If_Not_Null - (Get_Reject_Time_Expression (Stmt), List); - Canon_Extract_Sensitivity_Waveform - (Get_Waveform_Chain (Stmt), List); + Canon_Extract_Sensitivity_Simple_Signal_Assignment (Stmt, List); when Iir_Kind_Conditional_Signal_Assignment_Statement => - Canon_Extract_Sensitivity_Expression - (Get_Target (Stmt), List, True); - Canon_Extract_Sensitivity_If_Not_Null - (Get_Reject_Time_Expression (Stmt), List); - declare - Cwe : Iir; - begin - Cwe := Get_Conditional_Waveform_Chain (Stmt); - while Cwe /= Null_Iir loop - Canon_Extract_Sensitivity_If_Not_Null - (Get_Condition (Cwe), List); - Canon_Extract_Sensitivity_Waveform - (Get_Waveform_Chain (Cwe), List); - Cwe := Get_Chain (Cwe); - end loop; - end; + Canon_Extract_Sensitivity_Conditional_Signal_Assignment + (Stmt, List); when Iir_Kind_If_Statement => -- LRM08 11.3 -- * For each if statement, apply the rule of 10.2 to the @@ -509,8 +544,14 @@ package body Vhdl.Canon is -- with each formal parameter of mode IN or INOUT, and -- construct the union of the resulting sets. Canon_Extract_Sensitivity_Procedure_Call - (List, Get_Procedure_Call (Stmt)); - when others => + (Get_Procedure_Call (Stmt), List); + when Iir_Kind_Selected_Waveform_Assignment_Statement + | Iir_Kind_Conditional_Variable_Assignment_Statement + | Iir_Kind_Signal_Force_Assignment_Statement + | Iir_Kind_Signal_Release_Assignment_Statement + | Iir_Kind_Break_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Suspend_State_Statement => Error_Kind ("canon_extract_sensitivity_statement", Stmt); end case; end Canon_Extract_Sensitivity_Statement; @@ -1129,7 +1170,7 @@ package body Vhdl.Canon is -- Keep the same statement by default. N_Stmt := Stmt; - case Get_Kind (Stmt) is + case Iir_Kinds_Sequential_Statement_Ext (Get_Kind (Stmt)) is when Iir_Kind_If_Statement => declare Cond: Iir; @@ -1255,7 +1296,11 @@ package body Vhdl.Canon is when Iir_Kind_Return_Statement => Canon_Expression (Get_Expression (Stmt)); - when others => + when Iir_Kind_Selected_Waveform_Assignment_Statement + | Iir_Kind_Signal_Force_Assignment_Statement + | Iir_Kind_Signal_Release_Assignment_Statement + | Iir_Kind_Break_Statement + | Iir_Kind_Suspend_State_Statement => Error_Kind ("canon_sequential_stmts", Stmt); end case; @@ -1267,6 +1312,162 @@ package body Vhdl.Canon is return Res; end Canon_Sequential_Stmts; + function Canon_Insert_Suspend_State_Statement (Stmt : Iir; Var : Iir) + return Iir + is + Last : Iir; + Num : Int32; + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Suspend_State_Statement); + Location_Copy (Res, Stmt); + Set_Parent (Res, Get_Parent (Stmt)); + Set_Chain (Res, Stmt); + + Last := Get_Suspend_State_Chain (Var); + if Last = Null_Iir then + Num := 0; + else + Num := Get_Suspend_State_Index (Last); + end if; + + Set_Suspend_State_Index (Res, Num + 1); + Set_Suspend_State_Chain (Res, Last); + Set_Suspend_State_Chain (Var, Res); + return Res; + end Canon_Insert_Suspend_State_Statement; + + function Canon_Add_Suspend_State_Statement (First : Iir; Var : Iir) + return Iir + is + Stmt: Iir; + S_Stmt : Iir; + Res, Last : Iir; + begin + Chain_Init (Res, Last); + + Stmt := First; + while Stmt /= Null_Iir loop + + S_Stmt := Null_Iir; + + case Get_Kind (Stmt) is + when Iir_Kind_Simple_Signal_Assignment_Statement + | Iir_Kind_Conditional_Signal_Assignment_Statement => + null; + + when Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Conditional_Variable_Assignment_Statement => + null; + + when Iir_Kind_If_Statement => + if Get_Suspend_Flag (Stmt) then + declare + Clause: Iir; + Stmts : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Stmts := Get_Sequential_Statement_Chain (Clause); + Stmts := Canon_Add_Suspend_State_Statement + (Stmts, Var); + Set_Sequential_Statement_Chain (Clause, Stmts); + Clause := Get_Else_Clause (Clause); + end loop; + end; + end if; + + when Iir_Kind_Wait_Statement => + S_Stmt := Canon_Insert_Suspend_State_Statement (Stmt, Var); + + when Iir_Kind_Case_Statement => + if Get_Suspend_Flag (Stmt) then + declare + Choice: Iir; + Stmts : Iir; + begin + Choice := Get_Case_Statement_Alternative_Chain (Stmt); + while Choice /= Null_Iir loop + -- FIXME: canon choice expr. + Stmts := Get_Associated_Chain (Choice); + Stmts := Canon_Add_Suspend_State_Statement + (Stmts, Var); + Set_Associated_Chain (Choice, Stmts); + Choice := Get_Chain (Choice); + end loop; + end; + end if; + + when Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + null; + + when Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement => + if Get_Suspend_Flag (Stmt) then + declare + Stmts : Iir; + begin + Stmts := Get_Sequential_Statement_Chain (Stmt); + Stmts := Canon_Add_Suspend_State_Statement + (Stmts, Var); + Set_Sequential_Statement_Chain (Stmt, Stmts); + end; + end if; + + when Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement => + null; + + when Iir_Kind_Procedure_Call_Statement => + if Get_Suspend_Flag (Stmt) then + S_Stmt := Canon_Insert_Suspend_State_Statement (Stmt, Var); + end if; + + when Iir_Kind_Null_Statement => + null; + + when Iir_Kind_Return_Statement => + null; + + when others => + Error_Kind ("canon_add_suspend_state_statement", Stmt); + end case; + + if S_Stmt /= Null_Iir then + Chain_Append (Res, Last, S_Stmt); + end if; + Chain_Append (Res, Last, Stmt); + + Stmt := Get_Chain (Stmt); + end loop; + + return Res; + end Canon_Add_Suspend_State_Statement; + + procedure Canon_Add_Suspend_State (Proc : Iir) + is + Var : Iir; + Stmts : Iir; + begin + pragma Assert (Kind_In (Proc, Iir_Kind_Process_Statement, + Iir_Kind_Procedure_Body)); + + -- Create suspend state variable. + Var := Create_Iir (Iir_Kind_Suspend_State_Declaration); + Set_Location (Var, Get_Location (Proc)); + Set_Parent (Var, Proc); + + -- Insert it. + Set_Chain (Var, Get_Declaration_Chain (Proc)); + Set_Declaration_Chain (Proc, Var); + + -- Add suspend state statements. + Stmts := Get_Sequential_Statement_Chain (Proc); + Stmts := Canon_Add_Suspend_State_Statement (Stmts, Var); + Set_Sequential_Statement_Chain (Proc, Stmts); + end Canon_Add_Suspend_State; + -- Create a statement transform from concurrent_signal_assignment -- statement STMT (either selected or conditional). -- waveform transformation is not done. @@ -1428,7 +1629,7 @@ package body Vhdl.Canon is -- the union of the sets constructed by applying th rule of Section 8.1 -- to each actual part associated with a formal parameter. Sensitivity_List := Create_Iir_List; - Canon_Extract_Sensitivity_Procedure_Call (Sensitivity_List, Call); + Canon_Extract_Sensitivity_Procedure_Call (Call, Sensitivity_List); if Is_Sensitized then Set_Sensitivity_List (Proc, Sensitivity_List); Set_Is_Ref (Proc, True); @@ -2050,6 +2251,11 @@ package body Vhdl.Canon is when Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement => + if Canon_Flag_Add_Suspend_State + and then Get_Kind (Stmt) = Iir_Kind_Process_Statement + then + Canon_Add_Suspend_State (Stmt); + end if; Canon_Declarations (Top, Stmt, Null_Iir); if Canon_Flag_Sequentials_Stmts then declare @@ -2953,6 +3159,12 @@ package body Vhdl.Canon is when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => Canon_Declarations (Top, Decl, Null_Iir); + if Canon_Flag_Add_Suspend_State + and then Get_Kind (Decl) = Iir_Kind_Procedure_Body + and then Get_Suspend_Flag (Decl) + then + Canon_Add_Suspend_State (Decl); + end if; if Canon_Flag_Sequentials_Stmts then Stmts := Get_Sequential_Statement_Chain (Decl); Stmts := Canon_Sequential_Stmts (Stmts); @@ -3058,6 +3270,9 @@ package body Vhdl.Canon is when Iir_Kind_Psl_Default_Clock => null; + when Iir_Kind_Suspend_State_Declaration => + null; + when others => Error_Kind ("canon_declaration", Decl); end case; diff --git a/src/vhdl/vhdl-canon.ads b/src/vhdl/vhdl-canon.ads index 2c9178257..2fc6ec09a 100644 --- a/src/vhdl/vhdl-canon.ads +++ b/src/vhdl/vhdl-canon.ads @@ -32,10 +32,6 @@ package Vhdl.Canon is -- association with a non globally expression). Canon_Flag_Associations : Boolean := True; - -- If true, create a concurrent signal assignment for internal - -- associations. - Canon_Flag_Inertial_Associations : Boolean := True; - -- If true, canon lists in specifications. Canon_Flag_Specification_Lists : Boolean := True; @@ -46,6 +42,9 @@ package Vhdl.Canon is -- (If true, Canon_Flag_Sequentials_Stmts must be true) Canon_Flag_All_Sensitivity : Boolean := False; + -- Add suspend state variables and statements. + Canon_Flag_Add_Suspend_State : Boolean := False; + -- Do canonicalization: -- Transforms concurrent statements into sensitized process statements -- (all but component instanciation and block). @@ -95,4 +94,25 @@ package Vhdl.Canon is -- Used for vhdl 08. function Canon_Extract_Sensitivity_Process (Proc : Iir_Sensitized_Process_Statement) return Iir_List; + + -- For a concurrent or sequential conditional signal assignment. + procedure Canon_Extract_Sensitivity_Conditional_Signal_Assignment + (Stmt : Iir; List : Iir_List); + + -- For a concurrent or sequential simple signal assignment. + procedure Canon_Extract_Sensitivity_Simple_Signal_Assignment + (Stmt : Iir; List : Iir_List); + + -- For a concurrent selected signal statement. + procedure Canon_Extract_Sensitivity_Selected_Signal_Assignment + (Stmt : Iir; List : Iir_List); + + -- For a concurrent or sequential simple assertion statement. + procedure Canon_Extract_Sensitivity_Assertion_Statement + (Stmt : Iir; List : Iir_List); + + -- For a procedure call. + procedure Canon_Extract_Sensitivity_Procedure_Call + (Call : Iir; Sensitivity_List : Iir_List); + end Vhdl.Canon; diff --git a/src/vhdl/vhdl-elocations.adb b/src/vhdl/vhdl-elocations.adb index dbd610d3c..b428c4fab 100644 --- a/src/vhdl/vhdl-elocations.adb +++ b/src/vhdl/vhdl-elocations.adb @@ -297,6 +297,7 @@ package body Vhdl.Elocations is | Iir_Kind_Interface_Function_Declaration | Iir_Kind_Interface_Procedure_Declaration | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Suspend_State_Declaration | Iir_Kind_Identity_Operator | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator @@ -386,6 +387,7 @@ package body Vhdl.Elocations is | Iir_Kind_Exit_Statement | Iir_Kind_Procedure_Call_Statement | Iir_Kind_Break_Statement + | Iir_Kind_Suspend_State_Statement | Iir_Kind_Character_Literal | Iir_Kind_Simple_Name | Iir_Kind_Selected_Name diff --git a/src/vhdl/vhdl-elocations.ads b/src/vhdl/vhdl-elocations.ads index eaa1f78a1..810507a9f 100644 --- a/src/vhdl/vhdl-elocations.ads +++ b/src/vhdl/vhdl-elocations.ads @@ -280,6 +280,7 @@ package Vhdl.Elocations is -- Iir_Kind_Guard_Signal_Declaration (None) -- Iir_Kind_Signal_Attribute_Declaration (None) + -- Iir_Kind_Suspend_State_Declaration (None) -- Iir_Kind_Constant_Declaration (L1) -- Iir_Kind_Iterator_Declaration (L1) @@ -566,6 +567,8 @@ package Vhdl.Elocations is -- Iir_Kind_Break_Element (None) + -- Iir_Kind_Suspend_State_Statement (None) + ---------------- -- operators -- ---------------- diff --git a/src/vhdl/vhdl-errors.adb b/src/vhdl/vhdl-errors.adb index ddb2a9868..78ac59779 100644 --- a/src/vhdl/vhdl-errors.adb +++ b/src/vhdl/vhdl-errors.adb @@ -88,13 +88,6 @@ package body Vhdl.Errors is Report_Msg (Id, Elaboration, +Loc, Msg, Args); end Warning_Msg_Elab; - -- Disp a message during semantic analysis. - -- LOC is used for location and current token. - procedure Error_Msg_Sem (Msg: String; Loc: Iir) is - begin - Report_Msg (Msgid_Error, Semantic, +Get_Location_Safe (Loc), Msg); - end Error_Msg_Sem; - procedure Error_Msg_Sem (Loc: Location_Type; Msg: String; Args : Earg_Arr := No_Eargs) is @@ -495,6 +488,9 @@ package body Vhdl.Errors is when Iir_Kind_Signal_Attribute_Declaration => -- Should not appear. return "signal attribute"; + when Iir_Kind_Suspend_State_Declaration => + -- Should not appear. + return "suspend state variable"; when Iir_Kind_Group_Template_Declaration => return Disp_Identifier (Node, "group template"); when Iir_Kind_Group_Declaration => @@ -841,6 +837,9 @@ package body Vhdl.Errors is return Disp_Label (Node, "report statement"); when Iir_Kind_Break_Statement => return Disp_Label (Node, "break statement"); + when Iir_Kind_Suspend_State_Statement => + -- Should not appear. + return "suspend state statement"; when Iir_Kind_Block_Configuration => return "block configuration"; @@ -1080,8 +1079,7 @@ package body Vhdl.Errors is -- Cascade error message. return; end if; - Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type " - & Disp_Node (A_Type), Expr); + Error_Msg_Sem (+Expr, "can't match %n with type %n", (+Expr, +A_Type)); end Error_Not_Match; function Get_Mode_Name (Mode : Iir_Mode) return String is diff --git a/src/vhdl/vhdl-evaluation.adb b/src/vhdl/vhdl-evaluation.adb index 8cb22f5c9..0cf803f97 100644 --- a/src/vhdl/vhdl-evaluation.adb +++ b/src/vhdl/vhdl-evaluation.adb @@ -858,8 +858,8 @@ package body Vhdl.Evaluation is for I in Flist_First .. Last loop -- Elements are static. Val := Get_Nth_Element (Els, I); - Write_Discrete (Res.Mem + Size_Type (I) * Typ.Vec_El.Sz, - Typ.Vec_El, Eval_Pos (Val)); + Write_Discrete (Res.Mem + Size_Type (I) * Typ.Arr_El.Sz, + Typ.Arr_El, Eval_Pos (Val)); end loop; end; when Iir_Kind_String_Literal8 => @@ -880,7 +880,7 @@ package body Vhdl.Evaluation is Lit := Get_Nth_Element (Literal_List, Natural (Str_Table.Element_String8 (Id, I))); - Write_Discrete (Res.Mem + Size_Type (I - 1), Typ.Vec_El, + Write_Discrete (Res.Mem + Size_Type (I - 1), Typ.Arr_El, Int64 (Get_Enum_Pos (Lit))); end loop; end; @@ -952,7 +952,7 @@ package body Vhdl.Evaluation is Idx_Type : Iir; begin Idx_Type := Create_Range_Subtype_From_Type (Base_Idx, Loc); - Rng := Convert_Bound_To_Node (Typ.Vbound, Base_Idx, Orig); + Rng := Convert_Bound_To_Node (Typ.Abound, Base_Idx, Orig); Set_Range_Constraint (Idx_Type, Rng); Res := Create_Array_Subtype (Btype, Loc); @@ -976,7 +976,7 @@ package body Vhdl.Evaluation is Literal_List : constant Iir_Flist := Get_Enumeration_Literal_List (Element_Type); - Len : constant Nat32 := Nat32 (Mt.Typ.Vbound.Len); + Len : constant Nat32 := Nat32 (Mt.Typ.Abound.Len); List : Iir_Flist; El : Int64; @@ -986,7 +986,7 @@ package body Vhdl.Evaluation is for I in 1 .. Len loop El := Read_Discrete (Mt.Mem + Size_Type (I - 1), - Mt.Typ.Vec_El); + Mt.Typ.Arr_El); Lit := Get_Nth_Element (Literal_List, Natural (El)); Set_Nth_Element (List, Natural (I - 1), Lit); end loop; @@ -2585,8 +2585,7 @@ package body Vhdl.Evaluation is | Iir_Predefined_Bit_Array_Match_Inequality | Iir_Predefined_Std_Ulogic_Array_Match_Equality | Iir_Predefined_Std_Ulogic_Array_Match_Inequality => - -- TODO - raise Internal_Error; + return Eval_Ieee_Operator (Orig, Imp, Left, Right); when Iir_Predefined_Enum_To_String | Iir_Predefined_Integer_To_String @@ -4061,23 +4060,24 @@ package body Vhdl.Evaluation is end if; end Eval_Expr_Check_If_Static; - function Eval_Int_In_Range (Val : Int64; Bound : Iir) return Boolean is + function Eval_Int_In_Range (Val : Int64; Bound : Iir) return Boolean + is + L, R : Iir; begin case Get_Kind (Bound) is when Iir_Kind_Range_Expression => + L := Get_Left_Limit (Bound); + R := Get_Right_Limit (Bound); + if Get_Kind (L) = Iir_Kind_Overflow_Literal + or else Get_Kind (R) = Iir_Kind_Overflow_Literal + then + return True; + end if; case Get_Direction (Bound) is when Dir_To => - if Val < Eval_Pos (Get_Left_Limit (Bound)) - or else Val > Eval_Pos (Get_Right_Limit (Bound)) - then - return False; - end if; + return Val >= Eval_Pos (L) and then Val <= Eval_Pos (R); when Dir_Downto => - if Val > Eval_Pos (Get_Left_Limit (Bound)) - or else Val < Eval_Pos (Get_Right_Limit (Bound)) - then - return False; - end if; + return Val <= Eval_Pos (L) and then Val >= Eval_Pos (R); end case; when others => Error_Kind ("eval_int_in_range", Bound); diff --git a/src/vhdl/vhdl-ieee-math_real.adb b/src/vhdl/vhdl-ieee-math_real.adb index d11030d49..d52b8ae85 100644 --- a/src/vhdl/vhdl-ieee-math_real.adb +++ b/src/vhdl/vhdl-ieee-math_real.adb @@ -16,11 +16,13 @@ with Std_Names; use Std_Names; +with Vhdl.Std_Package; + package body Vhdl.Ieee.Math_Real is procedure Extract_Declarations (Pkg : Iir_Package_Declaration) is Decl : Iir; - Predef : Iir_Predefined_Functions; + Def : Iir_Predefined_Functions; begin Math_Real_Pkg := Pkg; @@ -36,28 +38,43 @@ package body Vhdl.Ieee.Math_Real is case Get_Kind (Decl) is when Iir_Kind_Function_Declaration => - Predef := Iir_Predefined_None; + Def := Iir_Predefined_None; case Get_Identifier (Decl) is + when Name_Sign => + Def := Iir_Predefined_Ieee_Math_Real_Sign; + when Name_Mod => + Def := Iir_Predefined_Ieee_Math_Real_Mod; when Name_Ceil => - Predef := Iir_Predefined_Ieee_Math_Real_Ceil; + Def := Iir_Predefined_Ieee_Math_Real_Ceil; when Name_Floor => - Predef := Iir_Predefined_Ieee_Math_Real_Floor; + Def := Iir_Predefined_Ieee_Math_Real_Floor; when Name_Round => - Predef := Iir_Predefined_Ieee_Math_Real_Round; + Def := Iir_Predefined_Ieee_Math_Real_Round; when Name_Log2 => - Predef := Iir_Predefined_Ieee_Math_Real_Log2; + Def := Iir_Predefined_Ieee_Math_Real_Log2; when Name_Sin => - Predef := Iir_Predefined_Ieee_Math_Real_Sin; + Def := Iir_Predefined_Ieee_Math_Real_Sin; when Name_Cos => - Predef := Iir_Predefined_Ieee_Math_Real_Cos; + Def := Iir_Predefined_Ieee_Math_Real_Cos; when Name_Arctan => - Predef := Iir_Predefined_Ieee_Math_Real_Arctan; + Def := Iir_Predefined_Ieee_Math_Real_Arctan; when Name_Op_Exp => - Predef := Iir_Predefined_Ieee_Math_Real_Pow; + declare + use Vhdl.Std_Package; + Inter : constant Iir := + Get_Interface_Declaration_Chain (Decl); + Itype : constant Iir := Get_Type (Inter); + begin + if Itype = Integer_Subtype_Definition then + Def := Iir_Predefined_Ieee_Math_Real_Pow_Int_Real; + elsif Itype = Real_Subtype_Definition then + Def := Iir_Predefined_Ieee_Math_Real_Pow_Real_Real; + end if; + end; when others => null; end case; - Set_Implicit_Definition (Decl, Predef); + Set_Implicit_Definition (Decl, Def); when Iir_Kind_Constant_Declaration => null; when others => diff --git a/src/vhdl/vhdl-ieee-numeric.adb b/src/vhdl/vhdl-ieee-numeric.adb index 2e26eb187..3a77bd0e8 100644 --- a/src/vhdl/vhdl-ieee-numeric.adb +++ b/src/vhdl/vhdl-ieee-numeric.adb @@ -466,9 +466,13 @@ package body Vhdl.Ieee.Numeric is (Pkg_Std => (Type_Unsigned => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_And_Uns_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_And_Log_Uns, others => Iir_Predefined_None), Type_Signed => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Sgn, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_And_Log_Sgn, others => Iir_Predefined_None)), Pkg_Bit => (others => @@ -478,9 +482,13 @@ package body Vhdl.Ieee.Numeric is (Pkg_Std => (Type_Unsigned => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Uns, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Or_Log_Uns, others => Iir_Predefined_None), Type_Signed => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Sgn, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Or_Log_Sgn, others => Iir_Predefined_None)), Pkg_Bit => (others => @@ -490,9 +498,13 @@ package body Vhdl.Ieee.Numeric is (Pkg_Std => (Type_Unsigned => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Uns, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Nand_Log_Uns, others => Iir_Predefined_None), Type_Signed => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Sgn, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Nand_Log_Sgn, others => Iir_Predefined_None)), Pkg_Bit => (others => @@ -502,9 +514,13 @@ package body Vhdl.Ieee.Numeric is (Pkg_Std => (Type_Unsigned => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Uns, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Nor_Log_Uns, others => Iir_Predefined_None), Type_Signed => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Sgn, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Nor_Log_Sgn, others => Iir_Predefined_None)), Pkg_Bit => (others => @@ -514,9 +530,13 @@ package body Vhdl.Ieee.Numeric is (Pkg_Std => (Type_Unsigned => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Uns, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Xor_Log_Uns, others => Iir_Predefined_None), Type_Signed => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Sgn, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Xor_Log_Sgn, others => Iir_Predefined_None)), Pkg_Bit => (others => @@ -526,9 +546,13 @@ package body Vhdl.Ieee.Numeric is (Pkg_Std => (Type_Unsigned => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Uns, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Xnor_Log_Uns, others => Iir_Predefined_None), Type_Signed => (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Sgn, + Arg_Vect_Log => Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Log, + Arg_Log_Vect => Iir_Predefined_Ieee_Numeric_Std_Xnor_Log_Sgn, others => Iir_Predefined_None)), Pkg_Bit => (others => @@ -582,6 +606,34 @@ package body Vhdl.Ieee.Numeric is (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_Find_Rightmost_Sgn, Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_Find_Rightmost_Uns); + To_01_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_To_01_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_To_01_Uns); + + To_X01_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_To_X01_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_To_X01_Uns); + + To_X01z_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_To_X01Z_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_To_X01Z_Uns); + + To_Ux01_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_To_UX01_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_To_UX01_Uns); + + Is_X_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_Is_X_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_Is_X_Uns); + + To_Hstring_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_To_Hstring_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_To_Hstring_Uns); + + To_Ostring_Patterns : constant Shift_Pattern_Type := + (Type_Signed => Iir_Predefined_Ieee_Numeric_Std_To_Ostring_Sgn, + Type_Unsigned => Iir_Predefined_Ieee_Numeric_Std_To_Ostring_Uns); + Error : exception; procedure Extract_Declarations (Pkg_Decl : Iir_Package_Declaration; @@ -618,6 +670,9 @@ package body Vhdl.Ieee.Numeric is elsif Arg_Type = Ieee.Std_Logic_1164.Std_Logic_Vector_Type then Sign := Type_Slv; Kind := Arg_Vect; + elsif Arg_Type = Vhdl.Std_Package.Bit_Type_Definition then + Sign := Type_Log; + Kind := Arg_Scal; else raise Error; end if; @@ -667,21 +722,36 @@ package body Vhdl.Ieee.Numeric is Set_Implicit_Definition (Decl, Pats (Pkg, Arg1_Sign)); end Handle_Unary; - procedure Handle_To_Unsigned is + procedure Handle_To_Unsigned + is + Predefined : Iir_Predefined_Functions; begin if Arg1_Kind = Arg_Scal and Arg1_Sign = Type_Unsigned then if Arg2_Kind = Arg_Scal and Arg2_Sign = Type_Unsigned then - Set_Implicit_Definition - (Decl, Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns); + case Pkg is + when Pkg_Std => + Predefined := + Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns; + when Pkg_Bit => + Predefined := + Iir_Predefined_Ieee_Numeric_Bit_Touns_Nat_Nat_Uns; + end case; elsif Arg2_Kind = Arg_Vect and Arg2_Sign = Type_Unsigned then - Set_Implicit_Definition - (Decl, Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Uns_Uns); + case Pkg is + when Pkg_Std => + Predefined := + Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Uns_Uns; + when Pkg_Bit => + Predefined := + Iir_Predefined_Ieee_Numeric_Bit_Touns_Nat_Uns_Uns; + end case; else raise Error; end if; else raise Error; end if; + Set_Implicit_Definition (Decl, Predefined); end Handle_To_Unsigned; procedure Handle_To_Signed is @@ -786,18 +856,20 @@ package body Vhdl.Ieee.Numeric is raise Error; end if; - case Arg1_Sign is - when Type_Unsigned => - Predefined := Iir_Predefined_Ieee_Numeric_Std_To_01_Uns; - when Type_Signed => - Predefined := Iir_Predefined_Ieee_Numeric_Std_To_01_Sgn; - when others => - raise Error; - end case; + Predefined := To_01_Patterns (Arg1_Sign); Set_Implicit_Definition (Decl, Predefined); end Handle_To_01; + procedure Handle_To_X01 (Pats : Shift_Pattern_Type) is + begin + if Arg1_Kind /= Arg_Vect then + raise Error; + end if; + + Set_Implicit_Definition (Decl, Pats (Arg1_Sign)); + end Handle_To_X01; + procedure Handle_Shift (Pats : Shift_Pattern_Type; Sh_Sign : Sign_Kind) is Res : Iir_Predefined_Functions; @@ -955,10 +1027,6 @@ package body Vhdl.Ieee.Numeric is Handle_Binary (Xor_Patterns); when Name_Xnor => Handle_Binary (Xnor_Patterns); - when Name_To_Bstring - | Name_To_Ostring - | Name_To_Hstring => - null; when Name_To_Unsigned => Handle_To_Unsigned; when Name_To_Signed => @@ -1019,6 +1087,20 @@ package body Vhdl.Ieee.Numeric is Handle_Unary (Red_Xor_Patterns); when Name_Xnor => Handle_Unary (Red_Xnor_Patterns); + when Name_To_X01 => + Handle_To_X01 (To_X01_Patterns); + when Name_To_X01Z => + Handle_To_X01 (To_X01z_Patterns); + when Name_To_UX01 => + Handle_To_X01 (To_Ux01_Patterns); + when Name_Is_X => + Handle_To_X01 (Is_X_Patterns); + when Name_To_Bstring => + null; + when Name_To_Ostring => + Handle_To_X01 (To_Ostring_Patterns); + when Name_To_Hstring => + Handle_To_X01 (To_Hstring_Patterns); when others => null; end case; @@ -1048,4 +1130,18 @@ package body Vhdl.Ieee.Numeric is Numeric_Std_Unsigned_Type := Null_Iir; Numeric_Std_Signed_Type := Null_Iir; end Extract_Std_Declarations; + + procedure Extract_Bit_Declarations (Pkg : Iir_Package_Declaration) is + begin + Numeric_Bit_Pkg := Pkg; + + Extract_Declarations + (Pkg, Pkg_Bit, Numeric_Bit_Unsigned_Type, Numeric_Bit_Signed_Type); + exception + when Error => + Error_Msg_Sem (+Pkg, "package ieee.numeric_bit is ill-formed"); + Numeric_Bit_Pkg := Null_Iir; + Numeric_Bit_Unsigned_Type := Null_Iir; + Numeric_Bit_Signed_Type := Null_Iir; + end Extract_Bit_Declarations; end Vhdl.Ieee.Numeric; diff --git a/src/vhdl/vhdl-ieee-numeric.ads b/src/vhdl/vhdl-ieee-numeric.ads index 6a329d07c..7b2a7ae8c 100644 --- a/src/vhdl/vhdl-ieee-numeric.ads +++ b/src/vhdl/vhdl-ieee-numeric.ads @@ -19,6 +19,13 @@ package Vhdl.Ieee.Numeric is Numeric_Std_Unsigned_Type : Iir_Array_Type_Definition := Null_Iir; Numeric_Std_Signed_Type : Iir_Array_Type_Definition := Null_Iir; + Numeric_Bit_Pkg : Iir_Package_Declaration := Null_Iir; + Numeric_Bit_Unsigned_Type : Iir_Array_Type_Definition := Null_Iir; + Numeric_Bit_Signed_Type : Iir_Array_Type_Definition := Null_Iir; + -- Extract declarations from PKG (ieee.numeric_std). procedure Extract_Std_Declarations (Pkg : Iir_Package_Declaration); + + -- Extract declarations from PKG (ieee.numeric_bit). + procedure Extract_Bit_Declarations (Pkg : Iir_Package_Declaration); end Vhdl.Ieee.Numeric; diff --git a/src/vhdl/vhdl-ieee-numeric_std_unsigned.adb b/src/vhdl/vhdl-ieee-numeric_std_unsigned.adb index 7d8edbb96..06baad51d 100644 --- a/src/vhdl/vhdl-ieee-numeric_std_unsigned.adb +++ b/src/vhdl/vhdl-ieee-numeric_std_unsigned.adb @@ -55,10 +55,65 @@ package body Vhdl.Ieee.Numeric_Std_Unsigned is Classify_Arg (Arg1, Arg1_Kind); Classify_Arg (Arg2, Arg2_Kind); case Get_Identifier (Decl) is + when Name_Op_Plus => + if Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Slv; + elsif Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Int then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Nat; + elsif Arg1_Kind = Arg_Int and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Nat_Slv; + end if; + when Name_Op_Minus => + if Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Slv; + elsif Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Int then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Nat; + elsif Arg1_Kind = Arg_Int and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Nat_Slv; + end if; when Name_To_Stdlogicvector => if Arg1_Kind = Arg_Int and Arg2_Kind = Arg_Int then - Res := - Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Nat_Slv; + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Nat; + elsif Arg1_Kind = Arg_Int and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Slv; + end if; + when Name_To_Stdulogicvector => + if Arg1_Kind = Arg_Int and Arg2_Kind = Arg_Int then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Suv_Nat_Nat; + elsif Arg1_Kind = Arg_Int and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Suv_Nat_Suv; + end if; + when Name_Resize => + if Arg2_Kind = Arg_Int then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Resize_Slv_Nat; + elsif Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Resize_Slv_Slv; + end if; + when Name_Find_Leftmost => + pragma Assert (Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Log); + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Find_Leftmost; + when Name_Find_Rightmost => + pragma Assert (Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Log); + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Find_Rightmost; + when Name_Shift_Left => + pragma Assert (Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Int); + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Shift_Left; + when Name_Shift_Right => + pragma Assert (Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Int); + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Shift_Right; + when Name_Rotate_Left => + pragma Assert (Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Int); + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Rotate_Left; + when Name_Rotate_Right => + pragma Assert (Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Int); + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Rotate_Right; + when Name_Maximum => + if Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Maximum_Slv_Slv; + end if; + when Name_Minimum => + if Arg1_Kind = Arg_Slv and Arg2_Kind = Arg_Slv then + Res := Iir_Predefined_Ieee_Numeric_Std_Unsigned_Minimum_Slv_Slv; end if; when others => null; diff --git a/src/vhdl/vhdl-ieee-std_logic_1164.adb b/src/vhdl/vhdl-ieee-std_logic_1164.adb index 43c20dc79..207d2f0c5 100644 --- a/src/vhdl/vhdl-ieee-std_logic_1164.adb +++ b/src/vhdl/vhdl-ieee-std_logic_1164.adb @@ -369,6 +369,13 @@ package body Vhdl.Ieee.Std_Logic_1164 is Predefined := Iir_Predefined_Ieee_1164_To_Stdulogicvector_Bv; end if; + when Name_To_01 => + if Is_Suv_Log_Function (Decl) then + -- TODO: distinguish slv/suv. + Predefined := Iir_Predefined_Ieee_1164_To_01_Slv_Log; + elsif Is_Scalar_Scalar_Function (Decl) then + Predefined := Iir_Predefined_Ieee_1164_To_01_Log_Log; + end if; when Name_To_X01 => if Is_Vector_Function (Decl) then -- TODO: distinguish slv/suv. @@ -376,6 +383,24 @@ package body Vhdl.Ieee.Std_Logic_1164 is elsif Is_Scalar_Function (Decl) then Predefined := Iir_Predefined_Ieee_1164_To_X01_Log; end if; + when Name_To_UX01 => + if Is_Vector_Function (Decl) then + -- TODO: distinguish slv/suv. + Predefined := Iir_Predefined_Ieee_1164_To_UX01_Slv; + elsif Is_Scalar_Function (Decl) then + Predefined := Iir_Predefined_Ieee_1164_To_UX01_Log; + end if; + when Name_To_X01Z => + if Is_Vector_Function (Decl) then + -- TODO: distinguish slv/suv. + Predefined := Iir_Predefined_Ieee_1164_To_X01Z_Slv; + elsif Is_Scalar_Function (Decl) then + Predefined := Iir_Predefined_Ieee_1164_To_X01Z_Log; + end if; + when Name_To_Hstring => + Predefined := Iir_Predefined_Ieee_1164_To_Hstring; + when Name_To_Ostring => + Predefined := Iir_Predefined_Ieee_1164_To_Ostring; when others => if Is_Scalar_Scalar_Function (Decl) then case Get_Identifier (Decl) is @@ -402,8 +427,7 @@ package body Vhdl.Ieee.Std_Logic_1164 is Predefined := Iir_Predefined_Ieee_1164_Condition_Operator; when Name_Is_X => - Predefined := - Iir_Predefined_Ieee_1164_Scalar_Is_X; + Predefined := Iir_Predefined_Ieee_1164_Is_X_Log; when others => Predefined := Iir_Predefined_None; end case; @@ -441,8 +465,7 @@ package body Vhdl.Ieee.Std_Logic_1164 is when Name_Xnor => Predefined := Iir_Predefined_Ieee_1164_Xnor_Suv; when Name_Is_X => - Predefined := - Iir_Predefined_Ieee_1164_Scalar_Is_X; + Predefined := Iir_Predefined_Ieee_1164_Is_X_Slv; when others => Predefined := Iir_Predefined_None; end case; diff --git a/src/vhdl/vhdl-nodes.adb b/src/vhdl/vhdl-nodes.adb index 947cd771d..b2946d62c 100644 --- a/src/vhdl/vhdl-nodes.adb +++ b/src/vhdl/vhdl-nodes.adb @@ -1083,6 +1083,7 @@ package body Vhdl.Nodes is | Iir_Kind_Interface_Terminal_Declaration | Iir_Kind_Interface_Type_Declaration | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Suspend_State_Declaration | Iir_Kind_Identity_Operator | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator @@ -1177,6 +1178,7 @@ package body Vhdl.Nodes is | Iir_Kind_Procedure_Call_Statement | Iir_Kind_Break_Statement | Iir_Kind_If_Statement + | Iir_Kind_Suspend_State_Statement | Iir_Kind_Elsif | Iir_Kind_Character_Literal | Iir_Kind_Simple_Name @@ -6072,6 +6074,22 @@ package body Vhdl.Nodes is Set_Flag4 (Name, Flag); end Set_In_Formal_Flag; + function Get_Inertial_Flag (Name : Iir) return Boolean is + begin + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_Inertial_Flag (Get_Kind (Name)), + "no field Inertial_Flag"); + return Get_Flag5 (Name); + end Get_Inertial_Flag; + + procedure Set_Inertial_Flag (Name : Iir; Flag : Boolean) is + begin + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_Inertial_Flag (Get_Kind (Name)), + "no field Inertial_Flag"); + Set_Flag5 (Name, Flag); + end Set_Inertial_Flag; + function Get_Slice_Subtype (Slice : Iir) return Iir is begin pragma Assert (Slice /= Null_Iir); @@ -7408,4 +7426,36 @@ package body Vhdl.Nodes is Set_Field1 (N, Int32_To_Iir (En)); end Set_Foreign_Node; + function Get_Suspend_State_Index (N : Iir) return Int32 is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Suspend_State_Index (Get_Kind (N)), + "no field Suspend_State_Index"); + return Iir_To_Int32 (Get_Field3 (N)); + end Get_Suspend_State_Index; + + procedure Set_Suspend_State_Index (N : Iir; Num : Int32) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Suspend_State_Index (Get_Kind (N)), + "no field Suspend_State_Index"); + Set_Field3 (N, Int32_To_Iir (Num)); + end Set_Suspend_State_Index; + + function Get_Suspend_State_Chain (N : Iir) return Iir is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Suspend_State_Chain (Get_Kind (N)), + "no field Suspend_State_Chain"); + return Get_Field4 (N); + end Get_Suspend_State_Chain; + + procedure Set_Suspend_State_Chain (N : Iir; Chain : Iir) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Suspend_State_Chain (Get_Kind (N)), + "no field Suspend_State_Chain"); + Set_Field4 (N, Chain); + end Set_Suspend_State_Chain; + end Vhdl.Nodes; diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 1e97286d0..4a9fc797f 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -485,6 +485,10 @@ package Vhdl.Nodes is -- -- Get/Set_In_Formal_Flag (Flag4) -- + -- Only for Iir_Kind_Association_Element_By_Expression: + -- True for inertial associations (even without the inertial word). + -- Get/Set_Inertial_Flag (Flag5) + -- -- Only for Iir_Kind_Association_Element_By_Individual: -- Must be Locally unless there is an error on one choice. -- Get/Set_Choice_Staticness (State1) @@ -901,6 +905,10 @@ package Vhdl.Nodes is -- Get/Set_Type_Marks_List (Field2) -- -- Get/Set_Return_Type_Mark (Field8) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Is_Forward_Ref (Flag1) -- Iir_Kind_Overload_List (Short) -- @@ -1602,12 +1610,14 @@ package Vhdl.Nodes is -- -- Get/Set_Implicit_Definition (Field7) -- + -- Only for Iir_Kind_Function_Declaration: -- Get/Set_Return_Type_Mark (Field8) -- -- Get/Set_Subprogram_Body (Field9) -- -- Get/Set_Subprogram_Depth (Field10) -- + -- Only for Iir_Kind_Function_Declaration: -- Get/Set_Return_Identifier (Field11) -- -- Get/Set_Overload_Number (Field12) @@ -1872,6 +1882,17 @@ package Vhdl.Nodes is -- Chain of signals -- Get/Set_Signal_Attribute_Chain (Field3) + -- Iir_Kind_Suspend_State_Declaration (Short) + -- + -- Implicit state variable to handle suspension. Added after semantic + -- analysis. + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Suspend_State_Chain (Field4) + -- Iir_Kind_Constant_Declaration (Medium) -- Iir_Kind_Iterator_Declaration (Short) -- @@ -2692,6 +2713,9 @@ package Vhdl.Nodes is -- Get/Set_Has_Signal_Flag (Flag3) -- Iir_Kind_Protected_Type_Declaration (Short) + -- The parent of a protected type declarationi s the same parent as the + -- type declaration. + -- Get/Set_Parent (Field0) -- -- Get/Set_Declaration_Chain (Field1) -- @@ -4122,6 +4146,19 @@ package Vhdl.Nodes is -- -- Get/Set_Expression (Field5) + -- Iir_Kind_Suspend_State_Statement (Short) + -- + -- Implicit statement added to mark a suspend point. + -- + -- Get/Set_Parent (Field0) + -- + -- Next statement + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Suspend_State_Index (Field3) + -- + -- Get/Set_Suspend_State_Chain (Field4) + ---------------- -- operators -- ---------------- @@ -4998,6 +5035,7 @@ package Vhdl.Nodes is Iir_Kind_Interface_Procedure_Declaration, -- interface Iir_Kind_Signal_Attribute_Declaration, + Iir_Kind_Suspend_State_Declaration, -- Expressions. Iir_Kind_Identity_Operator, @@ -5117,6 +5155,7 @@ package Vhdl.Nodes is Iir_Kind_Procedure_Call_Statement, Iir_Kind_Break_Statement, Iir_Kind_If_Statement, + Iir_Kind_Suspend_State_Statement, Iir_Kind_Elsif, -- Names @@ -5291,11 +5330,6 @@ package Vhdl.Nodes is Iir_Predefined_Enum_Greater, Iir_Predefined_Enum_Greater_Equal, - -- LRM08 5.2.6 Predefined operations on scalar types. - Iir_Predefined_Enum_Minimum, - Iir_Predefined_Enum_Maximum, - Iir_Predefined_Enum_To_String, - -- Predefined operators for BIT type. -- LRM08 9.2.2 Logical Operators @@ -5318,10 +5352,6 @@ package Vhdl.Nodes is -- LRM08 9.2.9 Condition operator Iir_Predefined_Bit_Condition, - -- LRM08 5.2.6 Predefined operations on scalar types. - Iir_Predefined_Bit_Rising_Edge, - Iir_Predefined_Bit_Falling_Edge, - -- Predefined operators for any integer type. -- LRM08 9.2.3 Relational Operators @@ -5352,11 +5382,6 @@ package Vhdl.Nodes is -- LRM08 9.2.8 Miscellaneous operators Iir_Predefined_Integer_Exp, - -- LRM08 5.2.6 Predefined operations on scalar types. - Iir_Predefined_Integer_Minimum, - Iir_Predefined_Integer_Maximum, - Iir_Predefined_Integer_To_String, - -- Predefined operators for any floating type. -- LRM08 9.2.3 Relational Operators @@ -5385,13 +5410,6 @@ package Vhdl.Nodes is -- LRM08 9.2.8 Miscellaneous operators Iir_Predefined_Floating_Exp, - -- LRM08 5.2.6 Predefined operations on scalar types. - Iir_Predefined_Floating_Minimum, - Iir_Predefined_Floating_Maximum, - Iir_Predefined_Floating_To_String, - Iir_Predefined_Real_To_String_Digits, - Iir_Predefined_Real_To_String_Format, - -- Predefined operator for universal types. -- LRM08 9.2.7 Multiplying operators @@ -5431,12 +5449,6 @@ package Vhdl.Nodes is Iir_Predefined_Physical_Mod, Iir_Predefined_Physical_Rem, - -- LRM08 5.2.6 Predefined operations on scalar types. - Iir_Predefined_Physical_Minimum, - Iir_Predefined_Physical_Maximum, - Iir_Predefined_Physical_To_String, - Iir_Predefined_Time_To_String_Unit, - -- Predefined operators for access. -- LRM08 9.2.3 Relational Operators @@ -5519,11 +5531,6 @@ package Vhdl.Nodes is Iir_Predefined_Bit_Array_Match_Equality, Iir_Predefined_Bit_Array_Match_Inequality, - -- LRM08 5.3.2.4 Predefined operations on array types - Iir_Predefined_Array_Char_To_String, - Iir_Predefined_Bit_Vector_To_Ostring, - Iir_Predefined_Bit_Vector_To_Hstring, - -- LRM08 9.2.3 Relational Operators -- IEEE.Std_Logic_1164.Std_Ulogic Iir_Predefined_Std_Ulogic_Match_Equality, @@ -5537,6 +5544,38 @@ package Vhdl.Nodes is Iir_Predefined_Std_Ulogic_Array_Match_Equality, Iir_Predefined_Std_Ulogic_Array_Match_Inequality, + -- LRM08 5.2.6 Predefined operations on scalar types. + Iir_Predefined_Enum_Minimum, + Iir_Predefined_Enum_Maximum, + Iir_Predefined_Enum_To_String, + + -- LRM08 5.2.6 Predefined operations on scalar types. + Iir_Predefined_Integer_Minimum, + Iir_Predefined_Integer_Maximum, + Iir_Predefined_Integer_To_String, + + -- LRM08 5.2.6 Predefined operations on scalar types. + Iir_Predefined_Bit_Rising_Edge, + Iir_Predefined_Bit_Falling_Edge, + + -- LRM08 5.2.6 Predefined operations on scalar types. + Iir_Predefined_Floating_Minimum, + Iir_Predefined_Floating_Maximum, + Iir_Predefined_Floating_To_String, + Iir_Predefined_Real_To_String_Digits, + Iir_Predefined_Real_To_String_Format, + + -- LRM08 5.2.6 Predefined operations on scalar types. + Iir_Predefined_Physical_Minimum, + Iir_Predefined_Physical_Maximum, + Iir_Predefined_Physical_To_String, + Iir_Predefined_Time_To_String_Unit, + + -- LRM08 5.3.2.4 Predefined operations on array types + Iir_Predefined_Array_Char_To_String, + Iir_Predefined_Bit_Vector_To_Ostring, + Iir_Predefined_Bit_Vector_To_Hstring, + -- -- Predefined attribute functions. -- Iir_Predefined_Attribute_Image, -- Iir_Predefined_Attribute_Value, @@ -5584,6 +5623,13 @@ package Vhdl.Nodes is Iir_Predefined_Foreign_Textio_Read_Real, Iir_Predefined_Foreign_Textio_Write_Real, + -- Defined in package std.env + Iir_Predefined_Std_Env_Stop_Status, + Iir_Predefined_Std_Env_Stop, + Iir_Predefined_Std_Env_Finish_Status, + Iir_Predefined_Std_Env_Finish, + Iir_Predefined_Std_Env_Resolution_Limit, + -- Defined in package ieee.std_logic_1164 -- Std_Ulogic operations. @@ -5634,8 +5680,8 @@ package Vhdl.Nodes is Iir_Predefined_Ieee_1164_To_UX01_Bv_Suv, Iir_Predefined_Ieee_1164_To_UX01_Bit_Log, - Iir_Predefined_Ieee_1164_Vector_Is_X, - Iir_Predefined_Ieee_1164_Scalar_Is_X, + Iir_Predefined_Ieee_1164_Is_X_Slv, + Iir_Predefined_Ieee_1164_Is_X_Log, Iir_Predefined_Ieee_1164_Rising_Edge, Iir_Predefined_Ieee_1164_Falling_Edge, @@ -5669,6 +5715,12 @@ package Vhdl.Nodes is Iir_Predefined_Ieee_1164_Condition_Operator, + Iir_Predefined_Ieee_1164_To_01_Log_Log, + Iir_Predefined_Ieee_1164_To_01_Slv_Log, + + Iir_Predefined_Ieee_1164_To_Hstring, + Iir_Predefined_Ieee_1164_To_Ostring, + -- Numeric_Std. -- Abbreviations: -- Uns: Unsigned, Sgn: Signed, Nat: Natural, Int: Integer. @@ -5835,22 +5887,46 @@ package Vhdl.Nodes is Iir_Predefined_Ieee_Numeric_Std_Ror_Sgn_Int, Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Std_And_Uns_Log, + Iir_Predefined_Ieee_Numeric_Std_And_Log_Uns, Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Sgn, - - Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Uns, - Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Sgn, + Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Log, + Iir_Predefined_Ieee_Numeric_Std_And_Log_Sgn, Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Log, + Iir_Predefined_Ieee_Numeric_Std_Nand_Log_Uns, Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Sgn, + Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Log, + Iir_Predefined_Ieee_Numeric_Std_Nand_Log_Sgn, + + Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Log, + Iir_Predefined_Ieee_Numeric_Std_Or_Log_Uns, + Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Sgn, + Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Log, + Iir_Predefined_Ieee_Numeric_Std_Or_Log_Sgn, Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Log, + Iir_Predefined_Ieee_Numeric_Std_Nor_Log_Uns, Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Sgn, + Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Log, + Iir_Predefined_Ieee_Numeric_Std_Nor_Log_Sgn, Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Log, + Iir_Predefined_Ieee_Numeric_Std_Xor_Log_Uns, Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Sgn, + Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Log, + Iir_Predefined_Ieee_Numeric_Std_Xor_Log_Sgn, Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Log, + Iir_Predefined_Ieee_Numeric_Std_Xnor_Log_Uns, Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Sgn, + Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Log, + Iir_Predefined_Ieee_Numeric_Std_Xnor_Log_Sgn, -- Numeric_Std binary operators (end) -- Unary functions for numeric_std @@ -5918,19 +5994,97 @@ package Vhdl.Nodes is Iir_Predefined_Ieee_Numeric_Std_To_01_Uns, Iir_Predefined_Ieee_Numeric_Std_To_01_Sgn, + Iir_Predefined_Ieee_Numeric_Std_To_X01_Uns, + Iir_Predefined_Ieee_Numeric_Std_To_X01_Sgn, + + Iir_Predefined_Ieee_Numeric_Std_To_X01Z_Uns, + Iir_Predefined_Ieee_Numeric_Std_To_X01Z_Sgn, + + Iir_Predefined_Ieee_Numeric_Std_To_UX01_Uns, + Iir_Predefined_Ieee_Numeric_Std_To_UX01_Sgn, + + Iir_Predefined_Ieee_Numeric_Std_Is_X_Uns, + Iir_Predefined_Ieee_Numeric_Std_Is_X_Sgn, + + Iir_Predefined_Ieee_Numeric_Std_To_Hstring_Uns, + Iir_Predefined_Ieee_Numeric_Std_To_Ostring_Uns, + + Iir_Predefined_Ieee_Numeric_Std_To_Hstring_Sgn, + Iir_Predefined_Ieee_Numeric_Std_To_Ostring_Sgn, + + -- numeric_bit + + -- To_Integer, To_Unsigned, to_Signed + Iir_Predefined_Ieee_Numeric_Bit_Toint_Uns_Nat, + Iir_Predefined_Ieee_Numeric_Bit_Toint_Sgn_Int, + Iir_Predefined_Ieee_Numeric_Bit_Touns_Nat_Nat_Uns, + Iir_Predefined_Ieee_Numeric_Bit_Touns_Nat_Uns_Uns, + Iir_Predefined_Ieee_Numeric_Bit_Tosgn_Int_Nat_Sgn, + Iir_Predefined_Ieee_Numeric_Bit_Tosgn_Int_Sgn_Sgn, + -- Numeric_Std_Unsigned (ieee2008) + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Slv, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Nat, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Nat_Slv, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Slv, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Nat, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Nat_Slv, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Find_Rightmost, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Find_Leftmost, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Shift_Left, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Shift_Right, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Rotate_Left, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Rotate_Right, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Integer_Slv_Nat, - Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Nat_Slv, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Nat, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Slv_Nat_Slv, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Suv_Nat_Nat, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_To_Suv_Nat_Suv, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Resize_Slv_Nat, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Resize_Slv_Slv, + + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Maximum_Slv_Slv, + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Minimum_Slv_Slv, -- Math_Real + Iir_Predefined_Ieee_Math_Real_Sign, Iir_Predefined_Ieee_Math_Real_Ceil, Iir_Predefined_Ieee_Math_Real_Floor, Iir_Predefined_Ieee_Math_Real_Round, + Iir_Predefined_Ieee_Math_Real_Trunc, + Iir_Predefined_Ieee_Math_Real_Mod, + Iir_Predefined_Ieee_Math_Real_Realmax, + Iir_Predefined_Ieee_Math_Real_Realmin, + Iir_Predefined_Ieee_Math_Real_Sqrt, + Iir_Predefined_Ieee_Math_Real_Cbrt, + Iir_Predefined_Ieee_Math_Real_Pow_Int_Real, + Iir_Predefined_Ieee_Math_Real_Pow_Real_Real, + Iir_Predefined_Ieee_Math_Real_Exp, + Iir_Predefined_Ieee_Math_Real_Log, Iir_Predefined_Ieee_Math_Real_Log2, + Iir_Predefined_Ieee_Math_Real_Log10, + Iir_Predefined_Ieee_Math_Real_Log_Real_Real, Iir_Predefined_Ieee_Math_Real_Sin, Iir_Predefined_Ieee_Math_Real_Cos, + Iir_Predefined_Ieee_Math_Real_Tan, + Iir_Predefined_Ieee_Math_Real_Arcsin, + Iir_Predefined_Ieee_Math_Real_Arccos, Iir_Predefined_Ieee_Math_Real_Arctan, - Iir_Predefined_Ieee_Math_Real_Pow, + Iir_Predefined_Ieee_Math_Real_Arctan_Real_Real, + Iir_Predefined_Ieee_Math_Real_Sinh, + Iir_Predefined_Ieee_Math_Real_Cosh, + Iir_Predefined_Ieee_Math_Real_Tanh, + Iir_Predefined_Ieee_Math_Real_Arcsinh, + Iir_Predefined_Ieee_Math_Real_Arccosh, + Iir_Predefined_Ieee_Math_Real_Arctanh, -- Std_Logic_Unsigned (synopsys extension). Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Slv, @@ -6199,6 +6353,9 @@ package Vhdl.Nodes is subtype Iir_Predefined_Pure_Functions is Iir_Predefined_Functions range Iir_Predefined_Boolean_And .. Iir_Predefined_Functions'Pred (Iir_Predefined_Deallocate); + subtype Iir_Predefined_Operators is Iir_Predefined_Functions range + Iir_Predefined_Boolean_And .. + Iir_Predefined_Std_Ulogic_Array_Match_Inequality; subtype Iir_Predefined_Impure_Functions is Iir_Predefined_Functions range Iir_Predefined_Deallocate .. Iir_Predefined_Functions'Pred (Iir_Predefined_None); @@ -6265,6 +6422,11 @@ package Vhdl.Nodes is Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Uns .. Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Sgn; + subtype Iir_Predefined_Ieee_Numeric_Std_Unsigned_Operators + is Iir_Predefined_Functions range + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Slv .. + Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Nat_Slv; + -- Size of scalar types. -- Their size is determined during analysis (using the range), so that -- all backends have the same view. @@ -6970,6 +7132,30 @@ package Vhdl.Nodes is --Iir_Kind_Break_Statement Iir_Kind_If_Statement; + -- All sequential statements + suspend_state_statement. + subtype Iir_Kinds_Sequential_Statement_Ext is Iir_Kind range + Iir_Kind_Simple_Signal_Assignment_Statement .. + --Iir_Kind_Conditional_Signal_Assignment_Statement + --Iir_Kind_Selected_Waveform_Assignment_Statement + --Iir_Kind_Signal_Force_Assignment_Statement + --Iir_Kind_Signal_Release_Assignment_Statement + --Iir_Kind_Null_Statement + --Iir_Kind_Assertion_Statement + --Iir_Kind_Report_Statement + --Iir_Kind_Wait_Statement + --Iir_Kind_Variable_Assignment_Statement + --Iir_Kind_Conditional_Variable_Assignment_Statement + --Iir_Kind_Return_Statement + --Iir_Kind_For_Loop_Statement + --Iir_Kind_While_Loop_Statement + --Iir_Kind_Next_Statement + --Iir_Kind_Exit_Statement + --Iir_Kind_Case_Statement + --Iir_Kind_Procedure_Call_Statement + --Iir_Kind_Break_Statement + --Iir_Kind_If_Statement + Iir_Kind_Suspend_State_Statement; + subtype Iir_Kinds_Next_Exit_Statement is Iir_Kind range Iir_Kind_Next_Statement .. Iir_Kind_Exit_Statement; @@ -8908,6 +9094,11 @@ package Vhdl.Nodes is function Get_In_Formal_Flag (Name : Iir) return Boolean; procedure Set_In_Formal_Flag (Name : Iir; Flag : Boolean); + -- True iff the association is an internal association. + -- Field: Flag5 + function Get_Inertial_Flag (Name : Iir) return Boolean; + procedure Set_Inertial_Flag (Name : Iir; Flag : Boolean); + -- The subtype of a slice. Contrary to the Type field, this is not a -- reference. -- Field: Field3 @@ -9326,4 +9517,12 @@ package Vhdl.Nodes is -- Field: Field1 (uc) function Get_Foreign_Node (N : Iir) return Int32; procedure Set_Foreign_Node (N : Iir; En : Int32); + + -- Field: Field3 (uc) + function Get_Suspend_State_Index (N : Iir) return Int32; + procedure Set_Suspend_State_Index (N : Iir; Num : Int32); + + -- Field: Field4 Forward_Ref + function Get_Suspend_State_Chain (N : Iir) return Iir; + procedure Set_Suspend_State_Chain (N : Iir; Chain : Iir); end Vhdl.Nodes; diff --git a/src/vhdl/vhdl-nodes_meta.adb b/src/vhdl/vhdl-nodes_meta.adb index 9fd729275..81b66f3a3 100644 --- a/src/vhdl/vhdl-nodes_meta.adb +++ b/src/vhdl/vhdl-nodes_meta.adb @@ -307,6 +307,7 @@ package body Vhdl.Nodes_Meta is Field_Pathname_Suffix => Type_Iir, Field_Pathname_Expression => Type_Iir, Field_In_Formal_Flag => Type_Boolean, + Field_Inertial_Flag => Type_Boolean, Field_Slice_Subtype => Type_Iir, Field_Suffix => Type_Iir, Field_Index_Subtype => Type_Iir, @@ -389,7 +390,9 @@ package body Vhdl.Nodes_Meta is Field_Count_Expression => Type_Iir, Field_Clock_Expression => Type_Iir, Field_Default_Clock => Type_Iir, - Field_Foreign_Node => Type_Int32 + Field_Foreign_Node => Type_Int32, + Field_Suspend_State_Index => Type_Int32, + Field_Suspend_State_Chain => Type_Iir ); function Get_Field_Type (F : Fields_Enum) return Types_Enum is @@ -980,6 +983,8 @@ package body Vhdl.Nodes_Meta is return "pathname_expression"; when Field_In_Formal_Flag => return "in_formal_flag"; + when Field_Inertial_Flag => + return "inertial_flag"; when Field_Slice_Subtype => return "slice_subtype"; when Field_Suffix => @@ -1146,6 +1151,10 @@ package body Vhdl.Nodes_Meta is return "default_clock"; when Field_Foreign_Node => return "foreign_node"; + when Field_Suspend_State_Index => + return "suspend_state_index"; + when Field_Suspend_State_Chain => + return "suspend_state_chain"; end case; end Get_Field_Image; @@ -1436,6 +1445,8 @@ package body Vhdl.Nodes_Meta is return "interface_procedure_declaration"; when Iir_Kind_Signal_Attribute_Declaration => return "signal_attribute_declaration"; + when Iir_Kind_Suspend_State_Declaration => + return "suspend_state_declaration"; when Iir_Kind_Identity_Operator => return "identity_operator"; when Iir_Kind_Negation_Operator => @@ -1654,6 +1665,8 @@ package body Vhdl.Nodes_Meta is return "break_statement"; when Iir_Kind_If_Statement => return "if_statement"; + when Iir_Kind_Suspend_State_Statement => + return "suspend_state_statement"; when Iir_Kind_Elsif => return "elsif"; when Iir_Kind_Character_Literal => @@ -2378,6 +2391,8 @@ package body Vhdl.Nodes_Meta is return Attr_None; when Field_In_Formal_Flag => return Attr_None; + when Field_Inertial_Flag => + return Attr_None; when Field_Slice_Subtype => return Attr_None; when Field_Suffix => @@ -2544,6 +2559,10 @@ package body Vhdl.Nodes_Meta is return Attr_Ref; when Field_Foreign_Node => return Attr_None; + when Field_Suspend_State_Index => + return Attr_None; + when Field_Suspend_State_Chain => + return Attr_Forward_Ref; end case; end Get_Field_Attribute; @@ -2679,6 +2698,7 @@ package body Vhdl.Nodes_Meta is Field_Whole_Association_Flag, Field_Collapse_Signal_Flag, Field_In_Formal_Flag, + Field_Inertial_Flag, Field_Formal, Field_Chain, Field_Actual, @@ -2827,9 +2847,11 @@ package body Vhdl.Nodes_Meta is Field_Attribute_Specification, Field_Base_Name, -- Iir_Kind_Signature + Field_Is_Forward_Ref, Field_Signature_Prefix, Field_Type_Marks_List, Field_Return_Type_Mark, + Field_Named_Entity, -- Iir_Kind_Aggregate_Info Field_Aggr_Min_Length, Field_Aggr_Others_Flag, @@ -2933,6 +2955,7 @@ package body Vhdl.Nodes_Meta is Field_End_Has_Reserved_Id, Field_End_Has_Identifier, Field_Type_Staticness, + Field_Parent, Field_Declaration_Chain, Field_Protected_Type_Body, Field_Type_Declarator, @@ -3517,9 +3540,7 @@ package body Vhdl.Nodes_Meta is Field_Chain, Field_Interface_Declaration_Chain, Field_Generic_Chain, - Field_Return_Type_Mark, Field_Subprogram_Body, - Field_Return_Identifier, -- Iir_Kind_Function_Body Field_Impure_Depth, Field_End_Has_Reserved_Id, @@ -3922,6 +3943,10 @@ package body Vhdl.Nodes_Meta is Field_Parent, Field_Chain, Field_Signal_Attribute_Chain, + -- Iir_Kind_Suspend_State_Declaration + Field_Parent, + Field_Chain, + Field_Suspend_State_Chain, -- Iir_Kind_Identity_Operator Field_Expr_Staticness, Field_Type, @@ -4776,6 +4801,11 @@ package body Vhdl.Nodes_Meta is Field_Sequential_Statement_Chain, Field_Else_Clause, Field_Chain, + -- Iir_Kind_Suspend_State_Statement + Field_Suspend_State_Index, + Field_Parent, + Field_Chain, + Field_Suspend_State_Chain, -- Iir_Kind_Elsif Field_Is_Ref, Field_End_Has_Identifier, @@ -5282,306 +5312,308 @@ package body Vhdl.Nodes_Meta is Iir_Kind_Waveform_Element => 97, Iir_Kind_Conditional_Waveform => 101, Iir_Kind_Conditional_Expression => 105, - Iir_Kind_Association_Element_By_Expression => 113, - Iir_Kind_Association_Element_By_Name => 121, - Iir_Kind_Association_Element_By_Individual => 130, - Iir_Kind_Association_Element_Open => 136, - Iir_Kind_Association_Element_Package => 142, - Iir_Kind_Association_Element_Type => 150, - Iir_Kind_Association_Element_Subprogram => 156, - Iir_Kind_Association_Element_Terminal => 162, - Iir_Kind_Choice_By_Range => 170, - Iir_Kind_Choice_By_Expression => 178, - Iir_Kind_Choice_By_Others => 184, - Iir_Kind_Choice_By_None => 190, - Iir_Kind_Choice_By_Name => 197, - Iir_Kind_Entity_Aspect_Entity => 199, - Iir_Kind_Entity_Aspect_Configuration => 200, - Iir_Kind_Entity_Aspect_Open => 200, - Iir_Kind_Psl_Hierarchical_Name => 202, - Iir_Kind_Block_Configuration => 208, - Iir_Kind_Block_Header => 212, - Iir_Kind_Component_Configuration => 219, - Iir_Kind_Binding_Indication => 223, - Iir_Kind_Entity_Class => 225, - Iir_Kind_Attribute_Value => 233, - Iir_Kind_Signature => 236, - Iir_Kind_Aggregate_Info => 243, - Iir_Kind_Procedure_Call => 247, - Iir_Kind_Record_Element_Constraint => 255, - Iir_Kind_Array_Element_Resolution => 257, - Iir_Kind_Record_Resolution => 258, - Iir_Kind_Record_Element_Resolution => 261, - Iir_Kind_Break_Element => 265, - Iir_Kind_Attribute_Specification => 274, - Iir_Kind_Disconnection_Specification => 280, - Iir_Kind_Step_Limit_Specification => 286, - Iir_Kind_Configuration_Specification => 292, - Iir_Kind_Access_Type_Definition => 299, - Iir_Kind_Incomplete_Type_Definition => 306, - Iir_Kind_Interface_Type_Definition => 312, - Iir_Kind_File_Type_Definition => 318, - Iir_Kind_Protected_Type_Declaration => 327, - Iir_Kind_Record_Type_Definition => 337, - Iir_Kind_Array_Type_Definition => 348, - Iir_Kind_Array_Subtype_Definition => 365, - Iir_Kind_Record_Subtype_Definition => 378, - Iir_Kind_Access_Subtype_Definition => 386, - Iir_Kind_Physical_Subtype_Definition => 396, - Iir_Kind_Floating_Subtype_Definition => 407, - Iir_Kind_Integer_Subtype_Definition => 417, - Iir_Kind_Enumeration_Subtype_Definition => 427, - Iir_Kind_Enumeration_Type_Definition => 438, - Iir_Kind_Integer_Type_Definition => 446, - Iir_Kind_Floating_Type_Definition => 454, - Iir_Kind_Physical_Type_Definition => 465, - Iir_Kind_Range_Expression => 473, - Iir_Kind_Protected_Type_Body => 481, - Iir_Kind_Wildcard_Type_Definition => 485, - Iir_Kind_Foreign_Vector_Type_Definition => 486, - Iir_Kind_Subtype_Definition => 493, - Iir_Kind_Scalar_Nature_Definition => 501, - Iir_Kind_Record_Nature_Definition => 514, - Iir_Kind_Array_Nature_Definition => 528, - Iir_Kind_Array_Subnature_Definition => 543, - Iir_Kind_Overload_List => 544, - Iir_Kind_Foreign_Module => 549, - Iir_Kind_Entity_Declaration => 562, - Iir_Kind_Configuration_Declaration => 572, - Iir_Kind_Context_Declaration => 578, - Iir_Kind_Package_Declaration => 593, - Iir_Kind_Package_Instantiation_Declaration => 607, - Iir_Kind_Vmode_Declaration => 619, - Iir_Kind_Vprop_Declaration => 631, - Iir_Kind_Vunit_Declaration => 644, - Iir_Kind_Package_Body => 652, - Iir_Kind_Architecture_Body => 665, - Iir_Kind_Type_Declaration => 672, - Iir_Kind_Anonymous_Type_Declaration => 678, - Iir_Kind_Subtype_Declaration => 686, - Iir_Kind_Nature_Declaration => 692, - Iir_Kind_Subnature_Declaration => 699, - Iir_Kind_Package_Header => 701, - Iir_Kind_Unit_Declaration => 710, - Iir_Kind_Library_Declaration => 718, - Iir_Kind_Component_Declaration => 728, - Iir_Kind_Attribute_Declaration => 735, - Iir_Kind_Group_Template_Declaration => 741, - Iir_Kind_Group_Declaration => 748, - Iir_Kind_Element_Declaration => 756, - Iir_Kind_Nature_Element_Declaration => 763, - Iir_Kind_Non_Object_Alias_Declaration => 771, - Iir_Kind_Psl_Declaration => 779, - Iir_Kind_Psl_Endpoint_Declaration => 793, - Iir_Kind_Enumeration_Literal => 805, - Iir_Kind_Function_Declaration => 831, - Iir_Kind_Procedure_Declaration => 856, - Iir_Kind_Function_Body => 866, - Iir_Kind_Procedure_Body => 877, - Iir_Kind_Function_Instantiation_Declaration => 888, - Iir_Kind_Procedure_Instantiation_Declaration => 898, - Iir_Kind_Terminal_Declaration => 907, - Iir_Kind_Object_Alias_Declaration => 919, - Iir_Kind_Free_Quantity_Declaration => 931, - Iir_Kind_Spectrum_Quantity_Declaration => 944, - Iir_Kind_Noise_Quantity_Declaration => 956, - Iir_Kind_Across_Quantity_Declaration => 972, - Iir_Kind_Through_Quantity_Declaration => 988, - Iir_Kind_File_Declaration => 1003, - Iir_Kind_Guard_Signal_Declaration => 1017, - Iir_Kind_Signal_Declaration => 1034, - Iir_Kind_Variable_Declaration => 1047, - Iir_Kind_Constant_Declaration => 1061, - Iir_Kind_Iterator_Declaration => 1073, - Iir_Kind_Interface_Constant_Declaration => 1090, - Iir_Kind_Interface_Variable_Declaration => 1106, - Iir_Kind_Interface_Signal_Declaration => 1127, - Iir_Kind_Interface_File_Declaration => 1143, - Iir_Kind_Interface_Quantity_Declaration => 1159, - Iir_Kind_Interface_Terminal_Declaration => 1171, - Iir_Kind_Interface_Type_Declaration => 1182, - Iir_Kind_Interface_Package_Declaration => 1195, - Iir_Kind_Interface_Function_Declaration => 1213, - Iir_Kind_Interface_Procedure_Declaration => 1227, - Iir_Kind_Signal_Attribute_Declaration => 1230, - Iir_Kind_Identity_Operator => 1234, - Iir_Kind_Negation_Operator => 1238, - Iir_Kind_Absolute_Operator => 1242, - Iir_Kind_Not_Operator => 1246, - Iir_Kind_Implicit_Condition_Operator => 1250, - Iir_Kind_Condition_Operator => 1254, - Iir_Kind_Reduction_And_Operator => 1258, - Iir_Kind_Reduction_Or_Operator => 1262, - Iir_Kind_Reduction_Nand_Operator => 1266, - Iir_Kind_Reduction_Nor_Operator => 1270, - Iir_Kind_Reduction_Xor_Operator => 1274, - Iir_Kind_Reduction_Xnor_Operator => 1278, - Iir_Kind_And_Operator => 1283, - Iir_Kind_Or_Operator => 1288, - Iir_Kind_Nand_Operator => 1293, - Iir_Kind_Nor_Operator => 1298, - Iir_Kind_Xor_Operator => 1303, - Iir_Kind_Xnor_Operator => 1308, - Iir_Kind_Equality_Operator => 1313, - Iir_Kind_Inequality_Operator => 1318, - Iir_Kind_Less_Than_Operator => 1323, - Iir_Kind_Less_Than_Or_Equal_Operator => 1328, - Iir_Kind_Greater_Than_Operator => 1333, - Iir_Kind_Greater_Than_Or_Equal_Operator => 1338, - Iir_Kind_Match_Equality_Operator => 1343, - Iir_Kind_Match_Inequality_Operator => 1348, - Iir_Kind_Match_Less_Than_Operator => 1353, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1358, - Iir_Kind_Match_Greater_Than_Operator => 1363, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1368, - Iir_Kind_Sll_Operator => 1373, - Iir_Kind_Sla_Operator => 1378, - Iir_Kind_Srl_Operator => 1383, - Iir_Kind_Sra_Operator => 1388, - Iir_Kind_Rol_Operator => 1393, - Iir_Kind_Ror_Operator => 1398, - Iir_Kind_Addition_Operator => 1403, - Iir_Kind_Substraction_Operator => 1408, - Iir_Kind_Concatenation_Operator => 1413, - Iir_Kind_Multiplication_Operator => 1418, - Iir_Kind_Division_Operator => 1423, - Iir_Kind_Modulus_Operator => 1428, - Iir_Kind_Remainder_Operator => 1433, - Iir_Kind_Exponentiation_Operator => 1438, - Iir_Kind_Function_Call => 1446, - Iir_Kind_Aggregate => 1453, - Iir_Kind_Parenthesis_Expression => 1456, - Iir_Kind_Qualified_Expression => 1460, - Iir_Kind_Type_Conversion => 1465, - Iir_Kind_Allocator_By_Expression => 1470, - Iir_Kind_Allocator_By_Subtype => 1476, - Iir_Kind_Selected_Element => 1484, - Iir_Kind_Dereference => 1489, - Iir_Kind_Implicit_Dereference => 1494, - Iir_Kind_Slice_Name => 1501, - Iir_Kind_Indexed_Name => 1507, - Iir_Kind_Psl_Prev => 1513, - Iir_Kind_Psl_Stable => 1518, - Iir_Kind_Psl_Rose => 1523, - Iir_Kind_Psl_Fell => 1528, - Iir_Kind_Psl_Onehot => 1531, - Iir_Kind_Psl_Onehot0 => 1534, - Iir_Kind_Psl_Expression => 1536, - Iir_Kind_Sensitized_Process_Statement => 1557, - Iir_Kind_Process_Statement => 1577, - Iir_Kind_Concurrent_Simple_Signal_Assignment => 1590, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1603, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1617, - Iir_Kind_Concurrent_Assertion_Statement => 1625, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1632, - Iir_Kind_Concurrent_Break_Statement => 1640, - Iir_Kind_Psl_Assert_Directive => 1654, - Iir_Kind_Psl_Assume_Directive => 1666, - Iir_Kind_Psl_Cover_Directive => 1678, - Iir_Kind_Psl_Restrict_Directive => 1689, - Iir_Kind_Block_Statement => 1703, - Iir_Kind_If_Generate_Statement => 1714, - Iir_Kind_Case_Generate_Statement => 1723, - Iir_Kind_For_Generate_Statement => 1732, - Iir_Kind_Component_Instantiation_Statement => 1743, - Iir_Kind_Psl_Default_Clock => 1746, - Iir_Kind_Generate_Statement_Body => 1757, - Iir_Kind_If_Generate_Else_Clause => 1763, - Iir_Kind_Simple_Simultaneous_Statement => 1770, - Iir_Kind_Simultaneous_Null_Statement => 1774, - Iir_Kind_Simultaneous_Procedural_Statement => 1785, - Iir_Kind_Simultaneous_Case_Statement => 1794, - Iir_Kind_Simultaneous_If_Statement => 1803, - Iir_Kind_Simultaneous_Elsif => 1809, - Iir_Kind_Simple_Signal_Assignment_Statement => 1820, - Iir_Kind_Conditional_Signal_Assignment_Statement => 1831, - Iir_Kind_Selected_Waveform_Assignment_Statement => 1843, - Iir_Kind_Signal_Force_Assignment_Statement => 1853, - Iir_Kind_Signal_Release_Assignment_Statement => 1862, - Iir_Kind_Null_Statement => 1866, - Iir_Kind_Assertion_Statement => 1873, - Iir_Kind_Report_Statement => 1879, - Iir_Kind_Wait_Statement => 1887, - Iir_Kind_Variable_Assignment_Statement => 1894, - Iir_Kind_Conditional_Variable_Assignment_Statement => 1901, - Iir_Kind_Return_Statement => 1907, - Iir_Kind_For_Loop_Statement => 1918, - Iir_Kind_While_Loop_Statement => 1929, - Iir_Kind_Next_Statement => 1936, - Iir_Kind_Exit_Statement => 1943, - Iir_Kind_Case_Statement => 1952, - Iir_Kind_Procedure_Call_Statement => 1958, - Iir_Kind_Break_Statement => 1965, - Iir_Kind_If_Statement => 1975, - Iir_Kind_Elsif => 1981, - Iir_Kind_Character_Literal => 1988, - Iir_Kind_Simple_Name => 1995, - Iir_Kind_Selected_Name => 2003, - Iir_Kind_Operator_Symbol => 2008, - Iir_Kind_Reference_Name => 2013, - Iir_Kind_External_Constant_Name => 2022, - Iir_Kind_External_Signal_Name => 2031, - Iir_Kind_External_Variable_Name => 2041, - Iir_Kind_Selected_By_All_Name => 2047, - Iir_Kind_Parenthesis_Name => 2052, - Iir_Kind_Package_Pathname => 2056, - Iir_Kind_Absolute_Pathname => 2057, - Iir_Kind_Relative_Pathname => 2058, - Iir_Kind_Pathname_Element => 2063, - Iir_Kind_Base_Attribute => 2065, - Iir_Kind_Subtype_Attribute => 2070, - Iir_Kind_Element_Attribute => 2075, - Iir_Kind_Across_Attribute => 2080, - Iir_Kind_Through_Attribute => 2085, - Iir_Kind_Nature_Reference_Attribute => 2089, - Iir_Kind_Left_Type_Attribute => 2094, - Iir_Kind_Right_Type_Attribute => 2099, - Iir_Kind_High_Type_Attribute => 2104, - Iir_Kind_Low_Type_Attribute => 2109, - Iir_Kind_Ascending_Type_Attribute => 2114, - Iir_Kind_Image_Attribute => 2120, - Iir_Kind_Value_Attribute => 2126, - Iir_Kind_Pos_Attribute => 2132, - Iir_Kind_Val_Attribute => 2138, - Iir_Kind_Succ_Attribute => 2144, - Iir_Kind_Pred_Attribute => 2150, - Iir_Kind_Leftof_Attribute => 2156, - Iir_Kind_Rightof_Attribute => 2162, - Iir_Kind_Signal_Slew_Attribute => 2170, - Iir_Kind_Quantity_Slew_Attribute => 2178, - Iir_Kind_Ramp_Attribute => 2186, - Iir_Kind_Zoh_Attribute => 2194, - Iir_Kind_Ltf_Attribute => 2202, - Iir_Kind_Ztf_Attribute => 2212, - Iir_Kind_Dot_Attribute => 2219, - Iir_Kind_Integ_Attribute => 2226, - Iir_Kind_Above_Attribute => 2234, - Iir_Kind_Quantity_Delayed_Attribute => 2242, - Iir_Kind_Delayed_Attribute => 2251, - Iir_Kind_Stable_Attribute => 2260, - Iir_Kind_Quiet_Attribute => 2269, - Iir_Kind_Transaction_Attribute => 2278, - Iir_Kind_Event_Attribute => 2282, - Iir_Kind_Active_Attribute => 2286, - Iir_Kind_Last_Event_Attribute => 2290, - Iir_Kind_Last_Active_Attribute => 2294, - Iir_Kind_Last_Value_Attribute => 2298, - Iir_Kind_Driving_Attribute => 2302, - Iir_Kind_Driving_Value_Attribute => 2306, - Iir_Kind_Behavior_Attribute => 2306, - Iir_Kind_Structure_Attribute => 2306, - Iir_Kind_Simple_Name_Attribute => 2313, - Iir_Kind_Instance_Name_Attribute => 2318, - Iir_Kind_Path_Name_Attribute => 2323, - Iir_Kind_Left_Array_Attribute => 2330, - Iir_Kind_Right_Array_Attribute => 2337, - Iir_Kind_High_Array_Attribute => 2344, - Iir_Kind_Low_Array_Attribute => 2351, - Iir_Kind_Length_Array_Attribute => 2358, - Iir_Kind_Ascending_Array_Attribute => 2365, - Iir_Kind_Range_Array_Attribute => 2372, - Iir_Kind_Reverse_Range_Array_Attribute => 2379, - Iir_Kind_Attribute_Name => 2388 + Iir_Kind_Association_Element_By_Expression => 114, + Iir_Kind_Association_Element_By_Name => 122, + Iir_Kind_Association_Element_By_Individual => 131, + Iir_Kind_Association_Element_Open => 137, + Iir_Kind_Association_Element_Package => 143, + Iir_Kind_Association_Element_Type => 151, + Iir_Kind_Association_Element_Subprogram => 157, + Iir_Kind_Association_Element_Terminal => 163, + Iir_Kind_Choice_By_Range => 171, + Iir_Kind_Choice_By_Expression => 179, + Iir_Kind_Choice_By_Others => 185, + Iir_Kind_Choice_By_None => 191, + Iir_Kind_Choice_By_Name => 198, + Iir_Kind_Entity_Aspect_Entity => 200, + Iir_Kind_Entity_Aspect_Configuration => 201, + Iir_Kind_Entity_Aspect_Open => 201, + Iir_Kind_Psl_Hierarchical_Name => 203, + Iir_Kind_Block_Configuration => 209, + Iir_Kind_Block_Header => 213, + Iir_Kind_Component_Configuration => 220, + Iir_Kind_Binding_Indication => 224, + Iir_Kind_Entity_Class => 226, + Iir_Kind_Attribute_Value => 234, + Iir_Kind_Signature => 239, + Iir_Kind_Aggregate_Info => 246, + Iir_Kind_Procedure_Call => 250, + Iir_Kind_Record_Element_Constraint => 258, + Iir_Kind_Array_Element_Resolution => 260, + Iir_Kind_Record_Resolution => 261, + Iir_Kind_Record_Element_Resolution => 264, + Iir_Kind_Break_Element => 268, + Iir_Kind_Attribute_Specification => 277, + Iir_Kind_Disconnection_Specification => 283, + Iir_Kind_Step_Limit_Specification => 289, + Iir_Kind_Configuration_Specification => 295, + Iir_Kind_Access_Type_Definition => 302, + Iir_Kind_Incomplete_Type_Definition => 309, + Iir_Kind_Interface_Type_Definition => 315, + Iir_Kind_File_Type_Definition => 321, + Iir_Kind_Protected_Type_Declaration => 331, + Iir_Kind_Record_Type_Definition => 341, + Iir_Kind_Array_Type_Definition => 352, + Iir_Kind_Array_Subtype_Definition => 369, + Iir_Kind_Record_Subtype_Definition => 382, + Iir_Kind_Access_Subtype_Definition => 390, + Iir_Kind_Physical_Subtype_Definition => 400, + Iir_Kind_Floating_Subtype_Definition => 411, + Iir_Kind_Integer_Subtype_Definition => 421, + Iir_Kind_Enumeration_Subtype_Definition => 431, + Iir_Kind_Enumeration_Type_Definition => 442, + Iir_Kind_Integer_Type_Definition => 450, + Iir_Kind_Floating_Type_Definition => 458, + Iir_Kind_Physical_Type_Definition => 469, + Iir_Kind_Range_Expression => 477, + Iir_Kind_Protected_Type_Body => 485, + Iir_Kind_Wildcard_Type_Definition => 489, + Iir_Kind_Foreign_Vector_Type_Definition => 490, + Iir_Kind_Subtype_Definition => 497, + Iir_Kind_Scalar_Nature_Definition => 505, + Iir_Kind_Record_Nature_Definition => 518, + Iir_Kind_Array_Nature_Definition => 532, + Iir_Kind_Array_Subnature_Definition => 547, + Iir_Kind_Overload_List => 548, + Iir_Kind_Foreign_Module => 553, + Iir_Kind_Entity_Declaration => 566, + Iir_Kind_Configuration_Declaration => 576, + Iir_Kind_Context_Declaration => 582, + Iir_Kind_Package_Declaration => 597, + Iir_Kind_Package_Instantiation_Declaration => 611, + Iir_Kind_Vmode_Declaration => 623, + Iir_Kind_Vprop_Declaration => 635, + Iir_Kind_Vunit_Declaration => 648, + Iir_Kind_Package_Body => 656, + Iir_Kind_Architecture_Body => 669, + Iir_Kind_Type_Declaration => 676, + Iir_Kind_Anonymous_Type_Declaration => 682, + Iir_Kind_Subtype_Declaration => 690, + Iir_Kind_Nature_Declaration => 696, + Iir_Kind_Subnature_Declaration => 703, + Iir_Kind_Package_Header => 705, + Iir_Kind_Unit_Declaration => 714, + Iir_Kind_Library_Declaration => 722, + Iir_Kind_Component_Declaration => 732, + Iir_Kind_Attribute_Declaration => 739, + Iir_Kind_Group_Template_Declaration => 745, + Iir_Kind_Group_Declaration => 752, + Iir_Kind_Element_Declaration => 760, + Iir_Kind_Nature_Element_Declaration => 767, + Iir_Kind_Non_Object_Alias_Declaration => 775, + Iir_Kind_Psl_Declaration => 783, + Iir_Kind_Psl_Endpoint_Declaration => 797, + Iir_Kind_Enumeration_Literal => 809, + Iir_Kind_Function_Declaration => 835, + Iir_Kind_Procedure_Declaration => 858, + Iir_Kind_Function_Body => 868, + Iir_Kind_Procedure_Body => 879, + Iir_Kind_Function_Instantiation_Declaration => 890, + Iir_Kind_Procedure_Instantiation_Declaration => 900, + Iir_Kind_Terminal_Declaration => 909, + Iir_Kind_Object_Alias_Declaration => 921, + Iir_Kind_Free_Quantity_Declaration => 933, + Iir_Kind_Spectrum_Quantity_Declaration => 946, + Iir_Kind_Noise_Quantity_Declaration => 958, + Iir_Kind_Across_Quantity_Declaration => 974, + Iir_Kind_Through_Quantity_Declaration => 990, + Iir_Kind_File_Declaration => 1005, + Iir_Kind_Guard_Signal_Declaration => 1019, + Iir_Kind_Signal_Declaration => 1036, + Iir_Kind_Variable_Declaration => 1049, + Iir_Kind_Constant_Declaration => 1063, + Iir_Kind_Iterator_Declaration => 1075, + Iir_Kind_Interface_Constant_Declaration => 1092, + Iir_Kind_Interface_Variable_Declaration => 1108, + Iir_Kind_Interface_Signal_Declaration => 1129, + Iir_Kind_Interface_File_Declaration => 1145, + Iir_Kind_Interface_Quantity_Declaration => 1161, + Iir_Kind_Interface_Terminal_Declaration => 1173, + Iir_Kind_Interface_Type_Declaration => 1184, + Iir_Kind_Interface_Package_Declaration => 1197, + Iir_Kind_Interface_Function_Declaration => 1215, + Iir_Kind_Interface_Procedure_Declaration => 1229, + Iir_Kind_Signal_Attribute_Declaration => 1232, + Iir_Kind_Suspend_State_Declaration => 1235, + Iir_Kind_Identity_Operator => 1239, + Iir_Kind_Negation_Operator => 1243, + Iir_Kind_Absolute_Operator => 1247, + Iir_Kind_Not_Operator => 1251, + Iir_Kind_Implicit_Condition_Operator => 1255, + Iir_Kind_Condition_Operator => 1259, + Iir_Kind_Reduction_And_Operator => 1263, + Iir_Kind_Reduction_Or_Operator => 1267, + Iir_Kind_Reduction_Nand_Operator => 1271, + Iir_Kind_Reduction_Nor_Operator => 1275, + Iir_Kind_Reduction_Xor_Operator => 1279, + Iir_Kind_Reduction_Xnor_Operator => 1283, + Iir_Kind_And_Operator => 1288, + Iir_Kind_Or_Operator => 1293, + Iir_Kind_Nand_Operator => 1298, + Iir_Kind_Nor_Operator => 1303, + Iir_Kind_Xor_Operator => 1308, + Iir_Kind_Xnor_Operator => 1313, + Iir_Kind_Equality_Operator => 1318, + Iir_Kind_Inequality_Operator => 1323, + Iir_Kind_Less_Than_Operator => 1328, + Iir_Kind_Less_Than_Or_Equal_Operator => 1333, + Iir_Kind_Greater_Than_Operator => 1338, + Iir_Kind_Greater_Than_Or_Equal_Operator => 1343, + Iir_Kind_Match_Equality_Operator => 1348, + Iir_Kind_Match_Inequality_Operator => 1353, + Iir_Kind_Match_Less_Than_Operator => 1358, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1363, + Iir_Kind_Match_Greater_Than_Operator => 1368, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1373, + Iir_Kind_Sll_Operator => 1378, + Iir_Kind_Sla_Operator => 1383, + Iir_Kind_Srl_Operator => 1388, + Iir_Kind_Sra_Operator => 1393, + Iir_Kind_Rol_Operator => 1398, + Iir_Kind_Ror_Operator => 1403, + Iir_Kind_Addition_Operator => 1408, + Iir_Kind_Substraction_Operator => 1413, + Iir_Kind_Concatenation_Operator => 1418, + Iir_Kind_Multiplication_Operator => 1423, + Iir_Kind_Division_Operator => 1428, + Iir_Kind_Modulus_Operator => 1433, + Iir_Kind_Remainder_Operator => 1438, + Iir_Kind_Exponentiation_Operator => 1443, + Iir_Kind_Function_Call => 1451, + Iir_Kind_Aggregate => 1458, + Iir_Kind_Parenthesis_Expression => 1461, + Iir_Kind_Qualified_Expression => 1465, + Iir_Kind_Type_Conversion => 1470, + Iir_Kind_Allocator_By_Expression => 1475, + Iir_Kind_Allocator_By_Subtype => 1481, + Iir_Kind_Selected_Element => 1489, + Iir_Kind_Dereference => 1494, + Iir_Kind_Implicit_Dereference => 1499, + Iir_Kind_Slice_Name => 1506, + Iir_Kind_Indexed_Name => 1512, + Iir_Kind_Psl_Prev => 1518, + Iir_Kind_Psl_Stable => 1523, + Iir_Kind_Psl_Rose => 1528, + Iir_Kind_Psl_Fell => 1533, + Iir_Kind_Psl_Onehot => 1536, + Iir_Kind_Psl_Onehot0 => 1539, + Iir_Kind_Psl_Expression => 1541, + Iir_Kind_Sensitized_Process_Statement => 1562, + Iir_Kind_Process_Statement => 1582, + Iir_Kind_Concurrent_Simple_Signal_Assignment => 1595, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1608, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1622, + Iir_Kind_Concurrent_Assertion_Statement => 1630, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1637, + Iir_Kind_Concurrent_Break_Statement => 1645, + Iir_Kind_Psl_Assert_Directive => 1659, + Iir_Kind_Psl_Assume_Directive => 1671, + Iir_Kind_Psl_Cover_Directive => 1683, + Iir_Kind_Psl_Restrict_Directive => 1694, + Iir_Kind_Block_Statement => 1708, + Iir_Kind_If_Generate_Statement => 1719, + Iir_Kind_Case_Generate_Statement => 1728, + Iir_Kind_For_Generate_Statement => 1737, + Iir_Kind_Component_Instantiation_Statement => 1748, + Iir_Kind_Psl_Default_Clock => 1751, + Iir_Kind_Generate_Statement_Body => 1762, + Iir_Kind_If_Generate_Else_Clause => 1768, + Iir_Kind_Simple_Simultaneous_Statement => 1775, + Iir_Kind_Simultaneous_Null_Statement => 1779, + Iir_Kind_Simultaneous_Procedural_Statement => 1790, + Iir_Kind_Simultaneous_Case_Statement => 1799, + Iir_Kind_Simultaneous_If_Statement => 1808, + Iir_Kind_Simultaneous_Elsif => 1814, + Iir_Kind_Simple_Signal_Assignment_Statement => 1825, + Iir_Kind_Conditional_Signal_Assignment_Statement => 1836, + Iir_Kind_Selected_Waveform_Assignment_Statement => 1848, + Iir_Kind_Signal_Force_Assignment_Statement => 1858, + Iir_Kind_Signal_Release_Assignment_Statement => 1867, + Iir_Kind_Null_Statement => 1871, + Iir_Kind_Assertion_Statement => 1878, + Iir_Kind_Report_Statement => 1884, + Iir_Kind_Wait_Statement => 1892, + Iir_Kind_Variable_Assignment_Statement => 1899, + Iir_Kind_Conditional_Variable_Assignment_Statement => 1906, + Iir_Kind_Return_Statement => 1912, + Iir_Kind_For_Loop_Statement => 1923, + Iir_Kind_While_Loop_Statement => 1934, + Iir_Kind_Next_Statement => 1941, + Iir_Kind_Exit_Statement => 1948, + Iir_Kind_Case_Statement => 1957, + Iir_Kind_Procedure_Call_Statement => 1963, + Iir_Kind_Break_Statement => 1970, + Iir_Kind_If_Statement => 1980, + Iir_Kind_Suspend_State_Statement => 1984, + Iir_Kind_Elsif => 1990, + Iir_Kind_Character_Literal => 1997, + Iir_Kind_Simple_Name => 2004, + Iir_Kind_Selected_Name => 2012, + Iir_Kind_Operator_Symbol => 2017, + Iir_Kind_Reference_Name => 2022, + Iir_Kind_External_Constant_Name => 2031, + Iir_Kind_External_Signal_Name => 2040, + Iir_Kind_External_Variable_Name => 2050, + Iir_Kind_Selected_By_All_Name => 2056, + Iir_Kind_Parenthesis_Name => 2061, + Iir_Kind_Package_Pathname => 2065, + Iir_Kind_Absolute_Pathname => 2066, + Iir_Kind_Relative_Pathname => 2067, + Iir_Kind_Pathname_Element => 2072, + Iir_Kind_Base_Attribute => 2074, + Iir_Kind_Subtype_Attribute => 2079, + Iir_Kind_Element_Attribute => 2084, + Iir_Kind_Across_Attribute => 2089, + Iir_Kind_Through_Attribute => 2094, + Iir_Kind_Nature_Reference_Attribute => 2098, + Iir_Kind_Left_Type_Attribute => 2103, + Iir_Kind_Right_Type_Attribute => 2108, + Iir_Kind_High_Type_Attribute => 2113, + Iir_Kind_Low_Type_Attribute => 2118, + Iir_Kind_Ascending_Type_Attribute => 2123, + Iir_Kind_Image_Attribute => 2129, + Iir_Kind_Value_Attribute => 2135, + Iir_Kind_Pos_Attribute => 2141, + Iir_Kind_Val_Attribute => 2147, + Iir_Kind_Succ_Attribute => 2153, + Iir_Kind_Pred_Attribute => 2159, + Iir_Kind_Leftof_Attribute => 2165, + Iir_Kind_Rightof_Attribute => 2171, + Iir_Kind_Signal_Slew_Attribute => 2179, + Iir_Kind_Quantity_Slew_Attribute => 2187, + Iir_Kind_Ramp_Attribute => 2195, + Iir_Kind_Zoh_Attribute => 2203, + Iir_Kind_Ltf_Attribute => 2211, + Iir_Kind_Ztf_Attribute => 2221, + Iir_Kind_Dot_Attribute => 2228, + Iir_Kind_Integ_Attribute => 2235, + Iir_Kind_Above_Attribute => 2243, + Iir_Kind_Quantity_Delayed_Attribute => 2251, + Iir_Kind_Delayed_Attribute => 2260, + Iir_Kind_Stable_Attribute => 2269, + Iir_Kind_Quiet_Attribute => 2278, + Iir_Kind_Transaction_Attribute => 2287, + Iir_Kind_Event_Attribute => 2291, + Iir_Kind_Active_Attribute => 2295, + Iir_Kind_Last_Event_Attribute => 2299, + Iir_Kind_Last_Active_Attribute => 2303, + Iir_Kind_Last_Value_Attribute => 2307, + Iir_Kind_Driving_Attribute => 2311, + Iir_Kind_Driving_Value_Attribute => 2315, + Iir_Kind_Behavior_Attribute => 2315, + Iir_Kind_Structure_Attribute => 2315, + Iir_Kind_Simple_Name_Attribute => 2322, + Iir_Kind_Instance_Name_Attribute => 2327, + Iir_Kind_Path_Name_Attribute => 2332, + Iir_Kind_Left_Array_Attribute => 2339, + Iir_Kind_Right_Array_Attribute => 2346, + Iir_Kind_High_Array_Attribute => 2353, + Iir_Kind_Low_Array_Attribute => 2360, + Iir_Kind_Length_Array_Attribute => 2367, + Iir_Kind_Ascending_Array_Attribute => 2374, + Iir_Kind_Range_Array_Attribute => 2381, + Iir_Kind_Reverse_Range_Array_Attribute => 2388, + Iir_Kind_Attribute_Name => 2397 ); function Get_Fields_First (K : Iir_Kind) return Fields_Index is @@ -5700,6 +5732,8 @@ package body Vhdl.Nodes_Meta is return Get_Next_Flag (N); when Field_In_Formal_Flag => return Get_In_Formal_Flag (N); + when Field_Inertial_Flag => + return Get_Inertial_Flag (N); when Field_Aggr_Dynamic_Flag => return Get_Aggr_Dynamic_Flag (N); when Field_Aggr_Others_Flag => @@ -5854,6 +5888,8 @@ package body Vhdl.Nodes_Meta is Set_Next_Flag (N, V); when Field_In_Formal_Flag => Set_In_Formal_Flag (N, V); + when Field_Inertial_Flag => + Set_Inertial_Flag (N, V); when Field_Aggr_Dynamic_Flag => Set_Aggr_Dynamic_Flag (N, V); when Field_Aggr_Others_Flag => @@ -6492,6 +6528,8 @@ package body Vhdl.Nodes_Meta is return Get_Clock_Expression (N); when Field_Default_Clock => return Get_Default_Clock (N); + when Field_Suspend_State_Chain => + return Get_Suspend_State_Chain (N); when others => raise Internal_Error; end case; @@ -6950,6 +6988,8 @@ package body Vhdl.Nodes_Meta is Set_Clock_Expression (N, V); when Field_Default_Clock => Set_Default_Clock (N, V); + when Field_Suspend_State_Chain => + Set_Suspend_State_Chain (N, V); when others => raise Internal_Error; end case; @@ -7396,6 +7436,8 @@ package body Vhdl.Nodes_Meta is return Get_PSL_Nbr_States (N); when Field_Foreign_Node => return Get_Foreign_Node (N); + when Field_Suspend_State_Index => + return Get_Suspend_State_Index (N); when others => raise Internal_Error; end case; @@ -7418,6 +7460,8 @@ package body Vhdl.Nodes_Meta is Set_PSL_Nbr_States (N, V); when Field_Foreign_Node => Set_Foreign_Node (N, V); + when Field_Suspend_State_Index => + Set_Suspend_State_Index (N, V); when others => raise Internal_Error; end case; @@ -8570,6 +8614,7 @@ package body Vhdl.Nodes_Meta is | Iir_Kind_Interface_Function_Declaration | Iir_Kind_Interface_Procedure_Declaration | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Suspend_State_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Simple_Signal_Assignment @@ -8613,6 +8658,7 @@ package body Vhdl.Nodes_Meta is | Iir_Kind_Procedure_Call_Statement | Iir_Kind_Break_Statement | Iir_Kind_If_Statement + | Iir_Kind_Suspend_State_Statement | Iir_Kind_External_Constant_Name | Iir_Kind_External_Signal_Name | Iir_Kind_External_Variable_Name => @@ -9583,13 +9629,7 @@ package body Vhdl.Nodes_Meta is function Has_Return_Identifier (K : Iir_Kind) return Boolean is begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; + return K = Iir_Kind_Function_Declaration; end Has_Return_Identifier; function Has_Visible_Flag (K : Iir_Kind) return Boolean is @@ -10939,6 +10979,7 @@ package body Vhdl.Nodes_Meta is | Iir_Kind_Disconnection_Specification | Iir_Kind_Step_Limit_Specification | Iir_Kind_Configuration_Specification + | Iir_Kind_Protected_Type_Declaration | Iir_Kind_Protected_Type_Body | Iir_Kind_Foreign_Module | Iir_Kind_Entity_Declaration @@ -10997,6 +11038,7 @@ package body Vhdl.Nodes_Meta is | Iir_Kind_Interface_Function_Declaration | Iir_Kind_Interface_Procedure_Declaration | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Suspend_State_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Simple_Signal_Assignment @@ -11043,6 +11085,7 @@ package body Vhdl.Nodes_Meta is | Iir_Kind_Procedure_Call_Statement | Iir_Kind_Break_Statement | Iir_Kind_If_Statement + | Iir_Kind_Suspend_State_Statement | Iir_Kind_Elsif | Iir_Kind_External_Constant_Name | Iir_Kind_External_Signal_Name @@ -11132,7 +11175,8 @@ package body Vhdl.Nodes_Meta is function Has_Named_Entity (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_Selected_Element + when Iir_Kind_Signature + | Iir_Kind_Selected_Element | Iir_Kind_Character_Literal | Iir_Kind_Simple_Name | Iir_Kind_Selected_Name @@ -11693,6 +11737,11 @@ package body Vhdl.Nodes_Meta is end case; end Has_In_Formal_Flag; + function Has_Inertial_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_By_Expression; + end Has_Inertial_Flag; + function Has_Slice_Subtype (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Slice_Name; @@ -12072,7 +12121,6 @@ package body Vhdl.Nodes_Meta is case K is when Iir_Kind_Signature | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration | Iir_Kind_Interface_Function_Declaration | Iir_Kind_Interface_Procedure_Declaration => return True; @@ -12577,7 +12625,8 @@ package body Vhdl.Nodes_Meta is function Has_Is_Forward_Ref (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_Selected_Element + when Iir_Kind_Signature + | Iir_Kind_Selected_Element | Iir_Kind_Character_Literal | Iir_Kind_Simple_Name | Iir_Kind_Selected_Name @@ -12756,4 +12805,20 @@ package body Vhdl.Nodes_Meta is return K = Iir_Kind_Foreign_Module; end Has_Foreign_Node; + function Has_Suspend_State_Index (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Suspend_State_Statement; + end Has_Suspend_State_Index; + + function Has_Suspend_State_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Suspend_State_Declaration + | Iir_Kind_Suspend_State_Statement => + return True; + when others => + return False; + end case; + end Has_Suspend_State_Chain; + end Vhdl.Nodes_Meta; diff --git a/src/vhdl/vhdl-nodes_meta.ads b/src/vhdl/vhdl-nodes_meta.ads index 15e9c1b3d..bf7fdcae0 100644 --- a/src/vhdl/vhdl-nodes_meta.ads +++ b/src/vhdl/vhdl-nodes_meta.ads @@ -351,6 +351,7 @@ package Vhdl.Nodes_Meta is Field_Pathname_Suffix, Field_Pathname_Expression, Field_In_Formal_Flag, + Field_Inertial_Flag, Field_Slice_Subtype, Field_Suffix, Field_Index_Subtype, @@ -433,7 +434,9 @@ package Vhdl.Nodes_Meta is Field_Count_Expression, Field_Clock_Expression, Field_Default_Clock, - Field_Foreign_Node + Field_Foreign_Node, + Field_Suspend_State_Index, + Field_Suspend_State_Chain ); pragma Discard_Names (Fields_Enum); @@ -942,6 +945,7 @@ package Vhdl.Nodes_Meta is function Has_Pathname_Suffix (K : Iir_Kind) return Boolean; function Has_Pathname_Expression (K : Iir_Kind) return Boolean; function Has_In_Formal_Flag (K : Iir_Kind) return Boolean; + function Has_Inertial_Flag (K : Iir_Kind) return Boolean; function Has_Slice_Subtype (K : Iir_Kind) return Boolean; function Has_Suffix (K : Iir_Kind) return Boolean; function Has_Index_Subtype (K : Iir_Kind) return Boolean; @@ -1026,4 +1030,6 @@ package Vhdl.Nodes_Meta is function Has_Clock_Expression (K : Iir_Kind) return Boolean; function Has_Default_Clock (K : Iir_Kind) return Boolean; function Has_Foreign_Node (K : Iir_Kind) return Boolean; + function Has_Suspend_State_Index (K : Iir_Kind) return Boolean; + function Has_Suspend_State_Chain (K : Iir_Kind) return Boolean; end Vhdl.Nodes_Meta; diff --git a/src/vhdl/vhdl-nodes_walk.adb b/src/vhdl/vhdl-nodes_walk.adb index fdd6d0c5d..442c105b7 100644 --- a/src/vhdl/vhdl-nodes_walk.adb +++ b/src/vhdl/vhdl-nodes_walk.adb @@ -57,7 +57,7 @@ package body Vhdl.Nodes_Walk is Status : Walk_Status := Walk_Continue; Chain : Iir; begin - case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is + case Iir_Kinds_Sequential_Statement_Ext (Get_Kind (Stmt)) is when Iir_Kind_Simple_Signal_Assignment_Statement | Iir_Kind_Conditional_Signal_Assignment_Statement | Iir_Kind_Selected_Waveform_Assignment_Statement @@ -73,7 +73,8 @@ package body Vhdl.Nodes_Walk is | Iir_Kind_Exit_Statement | Iir_Kind_Variable_Assignment_Statement | Iir_Kind_Conditional_Variable_Assignment_Statement - | Iir_Kind_Break_Statement => + | Iir_Kind_Break_Statement + | Iir_Kind_Suspend_State_Statement => null; when Iir_Kind_For_Loop_Statement | Iir_Kind_While_Loop_Statement => diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index 6e574b0a5..60dfd103c 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -2145,16 +2145,23 @@ package body Vhdl.Parse is Tm := Parse_Type_Mark (Check_Paren => True); - if Current_Token = Tok_Of then + if Tm /= Null_Iir and then Current_Token = Tok_Of then if Vhdl_Std < Vhdl_19 then Error_Msg_Parse ("return identifier not allowed before vhdl 2019"); + elsif Get_Kind (Tm) /= Iir_Kind_Simple_Name then + Error_Msg_Parse ("return identifier must be an identifier"); end if; - pragma Assert (Get_Kind (Tm) = Iir_Kind_Simple_Name); Ret := Create_Iir (Iir_Kind_Subtype_Declaration); Location_Copy (Ret, Tm); Set_Identifier (Ret, Get_Identifier (Tm)); - Set_Return_Identifier (Subprg, Ret); + if Get_Kind (Subprg) = Iir_Kind_Interface_Function_Declaration + then + Error_Msg_Parse + ("return identifier not allowed in interface function"); + else + Set_Return_Identifier (Subprg, Ret); + end if; Free_Iir (Tm); -- Skip 'of' @@ -6320,7 +6327,14 @@ package body Vhdl.Parse is Scan; -- Resize. - Resize_Bit_String (Res, Nat32 (Int)); + if Int > 2048 then + -- What is a reasonable limit ? + Error_Msg_Parse + (Get_Token_Location, + "bit string size is too large (> 2048)"); + else + Resize_Bit_String (Res, Nat32 (Int)); + end if; else Error_Msg_Parse (Get_Token_Location, @@ -7358,6 +7372,8 @@ package body Vhdl.Parse is | Iir_Kind_Signature => Error_Msg_Parse ("invalid name for a procedure call or missing assignment"); + when Iir_Kind_Error => + null; when others => Error_Kind ("parenthesis_name_to_procedure_call", Name); end case; @@ -10786,10 +10802,13 @@ package body Vhdl.Parse is -- Parse configuration item list declare First, Last : Iir; + Item : Iir; begin Chain_Init (First, Last); while Current_Token = Tok_For loop - Chain_Append (First, Last, Parse_Configuration_Item); + Item := Parse_Configuration_Item; + exit when Item = Null_Iir; + Chain_Append (First, Last, Item); end loop; Set_Configuration_Item_Chain (Res, First); end; @@ -11234,6 +11253,7 @@ package body Vhdl.Parse is -- Skip identifier. Scan; else + Id := Null_Identifier; Expect (Tok_Identifier); end if; @@ -11524,7 +11544,11 @@ package body Vhdl.Parse is is End_Loc : Location_Type; begin - Set_Library_Unit (Unit, Decl); + if Get_Kind (Unit) = Iir_Kind_Context_Declaration then + Error_Msg_Parse ("nested context declaration not allowed"); + else + Set_Library_Unit (Unit, Decl); + end if; -- Skip 'is' Scan; diff --git a/src/vhdl/vhdl-parse_psl.adb b/src/vhdl/vhdl-parse_psl.adb index e456514bf..d6168ca23 100644 --- a/src/vhdl/vhdl-parse_psl.adb +++ b/src/vhdl/vhdl-parse_psl.adb @@ -48,12 +48,18 @@ package body Vhdl.Parse_Psl is function Parse_Number return Node is + V : Int64; Res : Node; begin if Current_Token = Tok_Integer then Res := Create_Node_Loc (N_Number); -- FIXME: handle overflow. - Set_Value (Res, Uns32 (Current_Iir_Int64)); + V := Current_Iir_Int64; + if V > Int64 (Uns32'Last) then + Error_Msg_Parse ("number if too large"); + V := Int64 (Uns32'Last); + end if; + Set_Value (Res, Uns32 (V)); Scan; return Res; elsif Current_Token = Tok_Inf then @@ -70,9 +76,15 @@ package body Vhdl.Parse_Psl is is Low_B : constant Node := Get_Low_Bound (N); High_B : constant Node := Get_High_Bound (N); - Low : constant Uns32 := Get_Value (Low_B); + Low : Uns32; High : Uns32; begin + if Low_B = Null_Node then + -- Avoid crash on error. + return; + end if; + + Low := Get_Value (Low_B); if Get_Kind (High_B) = N_Inf then return; end if; diff --git a/src/vhdl/vhdl-post_sems.adb b/src/vhdl/vhdl-post_sems.adb index ba5a35419..cbf508f78 100644 --- a/src/vhdl/vhdl-post_sems.adb +++ b/src/vhdl/vhdl-post_sems.adb @@ -16,6 +16,7 @@ with Types; use Types; with Std_Names; use Std_Names; with Vhdl.Sem_Specs; +with Vhdl.Std_Env; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Ieee.Vital_Timing; with Vhdl.Ieee.Numeric; @@ -58,6 +59,9 @@ package body Vhdl.Post_Sems is Vhdl.Ieee.Std_Logic_1164.Extract_Declarations (Lib_Unit); when Name_VITAL_Timing => Vhdl.Ieee.Vital_Timing.Extract_Declarations (Lib_Unit); + when Name_Numeric_Bit => + Vhdl.Ieee.Numeric.Extract_Bit_Declarations + (Lib_Unit); when Name_Numeric_Std => Vhdl.Ieee.Numeric.Extract_Std_Declarations (Lib_Unit); @@ -80,6 +84,13 @@ package body Vhdl.Post_Sems is null; end case; end if; + elsif Get_Identifier (Lib) = Name_Std then + -- This is a unit of Std. + if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration + and then Id = Name_Env + then + Vhdl.Std_Env.Extract_Declarations (Lib_Unit); + end if; end if; -- Look for VITAL attributes. diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb index 0527cd131..a6c7b64dd 100644 --- a/src/vhdl/vhdl-scanner.adb +++ b/src/vhdl/vhdl-scanner.adb @@ -771,7 +771,7 @@ package body Vhdl.Scanner is end loop; end Add_One_To_Carries; begin - pragma Assert (Source (Pos) = '"'); + pragma Assert (Source (Pos) = '"' or Source (Pos) = '%'); Pos := Pos + 1; Length := 0; Id := Create_String8; diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index ce0428476..20b5f13ad 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -128,6 +128,9 @@ package body Vhdl.Sem is Entity := Get_Library_Unit (Entity); Set_Named_Entity (Name, Entity); Xrefs.Xref_Ref (Name, Entity); + elsif Get_Kind (Name) not in Iir_Kinds_Denoting_Name then + Error_Msg_Sem (+Name, "entity name expected"); + return Null_Iir; else -- Certainly an expanded name. Use the standard name analysis. Name := Sem_Denoting_Name (Name); @@ -566,6 +569,9 @@ package body Vhdl.Sem is -- The actual, if an expression, must be a globally -- static expression. if Get_Expr_Staticness (Actual) < Globally then + -- This is an inertial association. + Set_Inertial_Flag (Assoc, True); + if Flags.Vhdl_Std < Vhdl_08 then -- LRM08 6.5.6.3 Port clauses Error_Msg_Sem @@ -1388,20 +1394,14 @@ package body Vhdl.Sem is -- A simple name can be replaced by an expanded name in which this -- simple name is the selector, if and only if at both places the -- meaning of the simple name is given by the same declaration. - case Get_Kind (Left) is - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - case Get_Kind (Right) is - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - return Are_Trees_Equal (Get_Named_Entity (Left), - Get_Named_Entity (Right)); - when others => - return False; - end case; - when others => - null; - end case; + if Get_Kind (Left) in Iir_Kinds_Denoting_Name then + if Get_Kind (Right) in Iir_Kinds_Denoting_Name then + return Get_Identifier (Left) = Get_Identifier (Right) + and then Get_Named_Entity (Left) = Get_Named_Entity (Right); + else + return False; + end if; + end if; -- If nodes are not of the same kind, then they are not equals! if Get_Kind (Left) /= Get_Kind (Right) then @@ -1654,6 +1654,10 @@ package body Vhdl.Sem is (Get_Association_Choices_Chain (Left), Get_Association_Choices_Chain (Right)); + when Iir_Kind_Simple_Aggregate => + return Are_Trees_Equal (Get_Literal_Origin (Left), + Get_Literal_Origin (Right)); + when Iir_Kind_Choice_By_None | Iir_Kind_Choice_By_Others => return Are_Trees_Equal (Get_Associated_Expr (Left), @@ -1995,13 +1999,32 @@ package body Vhdl.Sem is end loop; end; - -- Mark the procedure as suspendable, unless in a std packages. + -- Mark the procedure as suspendable, unless in a std or + -- most ieee packages. -- This is a minor optimization. - if Get_Library (Get_Design_File (Get_Current_Design_Unit)) - /= Libraries.Std_Library - then - Set_Suspend_Flag (Subprg, True); - end if; + declare + Lib : constant Iir := + Get_Library (Get_Design_File (Get_Current_Design_Unit)); + begin + if Lib = Libraries.Std_Library then + -- No procedures in std have a wait statement. + null; + elsif Get_Identifier (Lib) = Std_Names.Name_Ieee then + -- Package ieee.vital_primitives has wait statements. + declare + Unit : constant Iir := + Get_Library_Unit (Get_Current_Design_Unit); + Unit_Id : constant Name_Id := Get_Identifier (Unit); + begin + if Unit_Id = Std_Names.Name_VITAL_Primitives then + Set_Suspend_Flag (Subprg, True); + end if; + end; + else + -- User procedures may have wait statements. + Set_Suspend_Flag (Subprg, True); + end if; + end; when others => Error_Kind ("sem_subprogram_declaration", Subprg); end case; @@ -2844,7 +2867,10 @@ package body Vhdl.Sem is Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Inter); begin - if Get_Macro_Expanded_Flag (Pkg) then + -- Could be an error. + if Get_Kind (Pkg) = Iir_Kind_Package_Declaration + and then Get_Macro_Expanded_Flag (Pkg) + then return True; end if; end; @@ -3035,17 +3061,23 @@ package body Vhdl.Sem is Name : Iir; Pkg : Iir; begin - Name := Sem_Denoting_Name (Get_Uninstantiated_Package_Name (Decl)); - Set_Uninstantiated_Package_Name (Decl, Name); - Pkg := Get_Named_Entity (Name); - if Is_Error (Pkg) then - null; - elsif Get_Kind (Pkg) /= Iir_Kind_Package_Declaration then - Error_Class_Match (Name, "package"); - Pkg := Create_Error (Pkg); - elsif not Is_Uninstantiated_Package (Pkg) then - Error_Msg_Sem (+Name, "%n is not an uninstantiated package", +Pkg); - Pkg := Create_Error (Pkg); + Name := Get_Uninstantiated_Package_Name (Decl); + if Get_Kind (Name) not in Iir_Kinds_Denoting_Name then + Error_Msg_Sem (+Name, "uninstantiated package name expected"); + Pkg := Create_Error (Name); + else + Name := Sem_Denoting_Name (Name); + Set_Uninstantiated_Package_Name (Decl, Name); + Pkg := Get_Named_Entity (Name); + if Is_Error (Pkg) then + null; + elsif Get_Kind (Pkg) /= Iir_Kind_Package_Declaration then + Error_Class_Match (Name, "package"); + Pkg := Create_Error (Pkg); + elsif not Is_Uninstantiated_Package (Pkg) then + Error_Msg_Sem (+Name, "%n is not an uninstantiated package", +Pkg); + Pkg := Create_Error (Pkg); + end if; end if; Set_Uninstantiated_Package_Decl (Decl, Pkg); diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index a667345a2..41c93273f 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -1571,6 +1571,12 @@ package body Vhdl.Sem_Assocs is -- Analyze actual. Actual := Get_Actual (Assoc); + if Get_Kind (Actual) not in Iir_Kinds_Denoting_Name then + Error_Msg_Sem + (+Assoc, + "actual of association must denote a package instantiation"); + return; + end if; Actual := Sem_Denoting_Name (Actual); Set_Actual (Assoc, Actual); @@ -2724,7 +2730,8 @@ package body Vhdl.Sem_Assocs is Pos := 0; while Inter /= Null_Iir loop if Inter_Matched (Pos) <= Open then - if Sem_Check_Missing_Association (Inter, Missing, Finish, Loc) + if Sem_Check_Missing_Association + (Inter, Missing, Finish, Inter_Matched (Pos) = Open, Loc) then Match := Not_Compatible; if not Finish then @@ -2738,9 +2745,11 @@ package body Vhdl.Sem_Assocs is end loop; end Sem_Association_Chain; - function Sem_Check_Missing_Association - (Inter : Iir; Missing : Missing_Type; Finish : Boolean; Loc : Iir) - return Boolean + function Sem_Check_Missing_Association (Inter : Iir; + Missing : Missing_Type; + Finish : Boolean; + Is_Open : Boolean; + Loc : Iir) return Boolean is Err : Boolean; begin @@ -2770,6 +2779,10 @@ package body Vhdl.Sem_Assocs is Error_Msg_Sem (+Loc, "%n of mode IN must be connected", +Inter); Err := True; + elsif not Is_Open then + Warning_Msg_Sem + (Warnid_No_Assoc, +Loc, + "%n of mode IN is not connected", +Inter); end if; when Iir_Out_Mode | Iir_Linkage_Mode @@ -2783,6 +2796,10 @@ package body Vhdl.Sem_Assocs is (+Loc, "unconstrained %n must be connected", +Inter); Err := True; + elsif not Is_Open then + Warning_Msg_Sem + (Warnid_No_Assoc, +Loc, + "%n of mode OUT is not connected", +Inter); end if; when Iir_Unknown_Mode => raise Internal_Error; diff --git a/src/vhdl/vhdl-sem_assocs.ads b/src/vhdl/vhdl-sem_assocs.ads index f59ecb3d3..fc334d828 100644 --- a/src/vhdl/vhdl-sem_assocs.ads +++ b/src/vhdl/vhdl-sem_assocs.ads @@ -98,7 +98,9 @@ package Vhdl.Sem_Assocs is -- INTER is an interface that is known not to be associated. -- Report an error according to MISSING iff FINISH is true. -- Return True iff not associating INTER is an error. - function Sem_Check_Missing_Association - (Inter : Iir; Missing : Missing_Type; Finish : Boolean; Loc : Iir) - return Boolean; + function Sem_Check_Missing_Association (Inter : Iir; + Missing : Missing_Type; + Finish : Boolean; + Is_Open : Boolean; + Loc : Iir) return Boolean; end Vhdl.Sem_Assocs; diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index 282137e90..843b24123 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -505,6 +505,16 @@ package body Vhdl.Sem_Decls is return; end if; + if Get_Is_Within_Flag (Pkg) then + -- Looks obvious, but there is apparently no such rule in the LRM. + -- Catch error like: + -- package gen is + -- generic(package g2 is new gen generic map(<>)); + -- end; + Error_Msg_Sem (+Inter, "generic package formal cannot be itself"); + return; + end if; + if Get_Generic_Map_Aspect_Chain (Inter) /= Null_Iir then Sem_Generic_Association_Chain (Get_Package_Header (Pkg), Inter); -- Not yet fully supported - need to check the instance. diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index ceb7af3b3..8a7ea0d89 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -398,6 +398,8 @@ package body Vhdl.Sem_Expr is | Iir_Kind_Procedure_Declaration | Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Subtype_Attribute + | Iir_Kind_Element_Attribute | Iir_Kind_Element_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Psl_Declaration @@ -3560,6 +3562,31 @@ package body Vhdl.Sem_Expr is "element is out of the bounds"); end if; + if Is_Array + and then Get_Kind (El) = Iir_Kind_Choice_By_Range + then + declare + Ch_Rng : constant Iir := Get_Choice_Range (El); + Expr_Type : constant Iir := Get_Type (Expr); + Idx : Iir; + begin + if Get_Expr_Staticness (Ch_Rng) = Locally + and then Get_Index_Constraint_Flag (Expr_Type) + then + Idx := Get_Index_Type (Expr_Type, 0); + if Get_Type_Staticness (Idx) = Locally + and then (Eval_Discrete_Type_Length (Idx) + /= Eval_Discrete_Range_Length (Ch_Rng)) + then + Warning_Msg_Sem (Warnid_Runtime_Error, +Expr, + "length mismatch"); + Expr := Build_Overflow (Expr, Expr_Type); + Set_Associated_Expr (El, Expr); + end if; + end if; + end; + end if; + Expr_Staticness := Min (Expr_Staticness, El_Staticness); Info.Nbr_Assocs := Info.Nbr_Assocs + 1; diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb index c4e26ee70..56312701b 100644 --- a/src/vhdl/vhdl-sem_lib.adb +++ b/src/vhdl/vhdl-sem_lib.adb @@ -354,9 +354,13 @@ package body Vhdl.Sem_Lib is -- Disable all warnings. Warnings are emitted only when the unit -- is analyzed. Save_Warnings_Setting (Warnings); - Disable_All_Warnings; if Get_Date_State (Design_Unit) = Date_Disk then + -- The unit is not loaded, so load it. + -- But disable warnings as the unit has already been analyzed. + -- The unit can be in memory but not yet analyzed when -c/-r is + -- used. In that case, warnings shouldn't be disabled. + Disable_All_Warnings; Load_Parse_Design_Unit (Design_Unit, Loc); end if; diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index 4ce05632f..bf195d91e 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -962,7 +962,7 @@ package body Vhdl.Sem_Names is if Get_Kind (Res) in Iir_Kinds_Denoting_Name then Set_Named_Entity (Res, Atype); else - return Create_Error_Type (Name); + Res := Create_Error_Type (Name); end if; elsif not Incomplete then if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then @@ -2587,7 +2587,10 @@ package body Vhdl.Sem_Names is | Iir_Kind_Procedure_Call_Statement | Iir_Kind_Attribute_Declaration | Iir_Kind_Type_Conversion - | Iir_Kind_Element_Attribute => + | Iir_Kind_Element_Attribute + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Unit_Declaration + | Iir_Kind_Variable_Assignment_Statement => if not Soft then Error_Msg_Sem (+Prefix_Loc, "%n cannot be selected by name", +Prefix); @@ -2963,6 +2966,22 @@ package body Vhdl.Sem_Names is Assoc_Chain, True, Missing_Parameter, Name, Match); end Error_Parenthesis_Function; + function Has_Error_In_Assocs (Chain : Iir) return Boolean + is + Assoc : Iir; + begin + Assoc := Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression + and then Is_Error (Get_Actual (Assoc)) + then + return True; + end if; + Assoc := Get_Chain (Assoc); + end loop; + return False; + end Has_Error_In_Assocs; + Actual : Iir; Actual_Expr : Iir; begin @@ -2978,29 +2997,33 @@ package body Vhdl.Sem_Names is Assoc_Chain := Get_Association_Chain (Name); Actual := Get_One_Actual (Assoc_Chain); - if Kind_In (Prefix, - Iir_Kind_Type_Declaration, Iir_Kind_Subtype_Declaration) - then - -- A type conversion. The prefix is a type mark. - declare - In_Formal : Boolean; - begin - if Actual = Null_Iir then - -- More than one actual. Keep only the first. - Error_Msg_Sem - (+Name, "type conversion allows only one expression"); - In_Formal := False; - else - In_Formal := Get_In_Formal_Flag (Assoc_Chain); - end if; + case Get_Kind (Prefix) is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Subtype_Attribute + | Iir_Kind_Element_Attribute => + -- A type conversion. The prefix is a type mark. + declare + In_Formal : Boolean; + begin + if Actual = Null_Iir then + -- More than one actual. Keep only the first. + Error_Msg_Sem + (+Name, "type conversion allows only one expression"); + In_Formal := False; + else + In_Formal := Get_In_Formal_Flag (Assoc_Chain); + end if; - -- This is certainly the easiest case: the prefix is not - -- overloaded, so the result can be computed. - Set_Named_Entity - (Name, Sem_Type_Conversion (Name, Prefix, Actual, In_Formal)); - end; - return; - end if; + -- This is certainly the easiest case: the prefix is not + -- overloaded, so the result can be computed. + Set_Named_Entity + (Name, Sem_Type_Conversion (Name, Prefix, Actual, In_Formal)); + end; + return; + when others => + null; + end case; -- Select between slice or indexed name. Actual_Expr := Null_Iir; @@ -3063,7 +3086,9 @@ package body Vhdl.Sem_Names is Free_Overload_List (Prefix); Set_Named_Entity (Prefix_Name, Res_Prefix); end; - if Res = Null_Iir then + if Res = Null_Iir and then not Has_Error_In_Assocs (Assoc_Chain) + then + -- Emit an error, but avoid a storm. Error_Msg_Sem (+Name, "no overloaded function found matching %n", +Prefix_Name); @@ -3352,13 +3377,11 @@ package body Vhdl.Sem_Names is Error_Msg_Sem (+Attr, "prefix of user defined attribute cannot be " & "an anonymous object"); return Error_Mark; - when Iir_Kind_Attribute_Declaration => - Error_Msg_Sem (+Attr, "prefix of user defined attribute cannot be " - & "an attribute"); - return Error_Mark; when Iir_Kind_Function_Call | Iir_Kind_Type_Conversion - | Iir_Kinds_Attribute => + | Iir_Kinds_Attribute + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Library_Declaration => Error_Msg_Sem (+Attr, "invalid prefix for user defined attribute"); return Error_Mark; when Iir_Kinds_Object_Declaration @@ -3591,6 +3614,37 @@ package body Vhdl.Sem_Names is return Res; end Sem_Predefined_Type_Attribute; + function Is_Element_Attribute_Prefix_A_Type (Prefix : Iir) return Boolean + is + Pfx : Iir; + Ent : Iir; + begin + Pfx := Prefix; + loop + case Get_Kind (Pfx) is + when Iir_Kinds_Denoting_Name + | Iir_Kind_Attribute_Name => + Ent := Get_Named_Entity (Pfx); + case Get_Kind (Ent) is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Base_Attribute => + return True; + when Iir_Kind_Element_Attribute => + -- Continue. + Pfx := Get_Prefix (Ent); + when others => + return False; + end case; + when Iir_Kind_Element_Attribute => + -- Continue + Pfx := Get_Prefix (Pfx); + when others => + return False; + end case; + end loop; + end Is_Element_Attribute_Prefix_A_Type; + -- Called for attributes Length, Left, Right, High, Low, Range, -- Reverse_Range, Ascending. -- FIXME: handle overload @@ -3602,6 +3656,7 @@ package body Vhdl.Sem_Names is Prefix : Iir; Res : Iir; Res_Type : Iir; + Is_Prefix_Object : Boolean; begin Prefix := Get_Named_Entity (Prefix_Name); @@ -3636,6 +3691,7 @@ package body Vhdl.Sem_Names is | Iir_Kind_Attribute_Value | Iir_Kind_Image_Attribute => -- FIXME: list of expr. + Is_Prefix_Object := True; Prefix_Type := Get_Type (Prefix); case Get_Kind (Prefix_Type) is when Iir_Kind_Access_Type_Definition @@ -3656,21 +3712,24 @@ package body Vhdl.Sem_Names is end case; when Iir_Kind_Subtype_Declaration | Iir_Kind_Type_Declaration - | Iir_Kind_Base_Attribute - | Iir_Kind_Subtype_Attribute - | Iir_Kind_Element_Attribute => + | Iir_Kind_Base_Attribute => + Is_Prefix_Object := False; + Prefix_Type := Get_Type (Prefix); + when Iir_Kind_Subtype_Attribute => + -- Always constrained as the prefix is an object. + Is_Prefix_Object := True; Prefix_Type := Get_Type (Prefix); - if not Is_Fully_Constrained_Type (Prefix_Type) then - Error_Msg_Sem (+Attr, "prefix type is not constrained"); - -- We continue using the unconstrained array type. - -- At least, this type is valid; and even if the array was - -- constrained, the base type would be the same. - end if; when Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => + | Iir_Kind_Reverse_Range_Array_Attribute => -- For names such as pfx'Range'Left. - -- Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Null_Iir); + Is_Prefix_Object := False; -- Doesn't matter, it's scalar. + Prefix_Type := Get_Type (Prefix); + when Iir_Kind_Element_Attribute => Prefix_Type := Get_Type (Prefix); + -- We need to know if the prefix is or denotes an object, as in + -- that case the type is constrained. + Is_Prefix_Object := + not Is_Element_Attribute_Prefix_A_Type (Prefix); when Iir_Kind_Process_Statement => Error_Msg_Sem (+Attr, "%n is not an appropriate prefix for %i attribute", @@ -3694,6 +3753,16 @@ package body Vhdl.Sem_Names is return Error_Mark; end case; + -- If the prefix is an object, we know its type is constrained. + if not Is_Prefix_Object + and then not Get_Index_Constraint_Flag (Prefix_Type) + then + Error_Msg_Sem (+Attr, "prefix type is not constrained"); + -- We continue using the unconstrained array type. + -- At least, this type is valid; and even if the array was + -- constrained, the base type would be the same. + end if; + -- Type of the attribute. This is correct unless there is a parameter, -- and furthermore 'range and 'reverse_range has to be handled -- specially because the result is a range and not a value. @@ -3801,6 +3870,7 @@ package body Vhdl.Sem_Names is -- The type defined by 'element is always constrained. Create -- a subtype if it is not. + -- NO, it isn't. The prefix can be a type. Attr_Subtype := Get_Element_Subtype (Attr_Type); if False and not Is_Fully_Constrained_Type (Attr_Subtype) then Attr_Subtype := @@ -4539,6 +4609,9 @@ package body Vhdl.Sem_Names is Sem_Attribute_Name (Name); when Iir_Kinds_External_Name => Sem_External_Name (Name); + when Iir_Kind_Signature => + Error_Msg_Sem (+Name, "signature cannot be used here"); + Set_Named_Entity (Name, Create_Error_Name (Name)); when others => Error_Kind ("sem_name", Name); end case; @@ -4944,7 +5017,8 @@ package body Vhdl.Sem_Names is Atype : Iir; begin case Get_Kind (Name) is - when Iir_Kinds_Denoting_Name => + when Iir_Kinds_Denoting_Name + | Iir_Kind_Attribute_Name => -- Common correct case. Atype := Get_Named_Entity (Name); case Get_Kind (Atype) is diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index f17c49791..fc2c15fab 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -544,7 +544,8 @@ package body Vhdl.Sem_Psl is -- always/never. Sem_Property (Prop, Top); return Prop; - when N_Eventually => + when N_Eventually + | N_Strong => Sem_Property (Prop); return Prop; when N_Clock_Event => diff --git a/src/vhdl/vhdl-sem_scopes.adb b/src/vhdl/vhdl-sem_scopes.adb index 29c355f9a..086660316 100644 --- a/src/vhdl/vhdl-sem_scopes.adb +++ b/src/vhdl/vhdl-sem_scopes.adb @@ -1116,7 +1116,8 @@ package body Vhdl.Sem_Scopes is | Iir_Kind_Signal_Attribute_Declaration => null; - when Iir_Kind_Protected_Type_Body => + when Iir_Kind_Protected_Type_Body + | Iir_Kind_Suspend_State_Declaration => -- FIXME: allowed only in debugger (if the current scope is -- within a package body) ? null; diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index 38a808440..e75c786fb 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -1268,7 +1268,11 @@ package body Vhdl.Sem_Specs is if Is_Error (Entity_Name) then return Null_Iir; end if; - Entity_Name := Sem_Denoting_Name (Get_Entity_Name (Aspect)); + if Get_Kind (Entity_Name) not in Iir_Kinds_Denoting_Name then + Error_Msg_Sem (+Entity_Name, "name of an entity expected"); + return Null_Iir; + end if; + Entity_Name := Sem_Denoting_Name (Entity_Name); Set_Entity_Name (Aspect, Entity_Name); Entity := Get_Named_Entity (Entity_Name); if Entity = Error_Mark then @@ -1350,7 +1354,7 @@ package body Vhdl.Sem_Specs is end Sem_Entity_Aspect; procedure Sem_Check_Missing_Generic_Association - (Inter_Chain : Iir; Assoc1 : Iir; Assoc2 : Iir; Loc : Iir) + (Inter_Chain : Iir; Assoc1 : Iir; Assoc2 : Iir; Loc : Iir) is Inter : Iir; Inter_Iter : Iir; @@ -1389,7 +1393,7 @@ package body Vhdl.Sem_Specs is if Get_Open_Flag (Inter) then Set_Open_Flag (Inter, False); Err := Sem_Check_Missing_Association - (Inter, Missing_Generic, True, Loc); + (Inter, Missing_Generic, True, False, Loc); end if; Inter := Get_Chain (Inter); end loop; diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb index 3d77d8ab5..eb3b7e9a7 100644 --- a/src/vhdl/vhdl-sem_types.adb +++ b/src/vhdl/vhdl-sem_types.adb @@ -570,13 +570,14 @@ package body Vhdl.Sem_Types is procedure Sem_Protected_Type_Declaration (Type_Decl : Iir_Type_Declaration) is - Decl : Iir_Protected_Type_Declaration; + Decl : constant Iir_Protected_Type_Declaration := + Get_Type_Definition (Type_Decl); El : Iir; begin - Decl := Get_Type_Definition (Type_Decl); Set_Resolved_Flag (Decl, False); Set_Signal_Type_Flag (Decl, False); Set_Type_Staticness (Decl, None); + Set_Parent (Decl, Get_Parent (Type_Decl)); -- LRM 10.3 Visibility -- [...] except in the declaration of a design_unit or a protected type @@ -871,6 +872,7 @@ package body Vhdl.Sem_Types is Last_Type : Iir; El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); + Last : Integer; El : Iir; El_Type : Iir; Resolved_Flag : Boolean; @@ -889,7 +891,14 @@ package body Vhdl.Sem_Types is Composite_Found := False; Set_Signal_Type_Flag (Def, True); - for I in Flist_First .. Flist_Last (El_List) loop + if El_List = Null_Iir_Flist then + -- Avoid a crash is no elements. + Last := Flist_First - 1; + else + Last := Flist_Last (El_List); + end if; + + for I in Flist_First .. Last loop El := Get_Nth_Element (El_List, I); El_Type := Get_Subtype_Indication (El); if El_Type /= Null_Iir then @@ -1740,6 +1749,9 @@ package body Vhdl.Sem_Types is Error_Msg_Sem (+Resolution, "record resolution not allowed for array subtype"); + when Iir_Kind_Attribute_Name => + Error_Msg_Sem + (+Resolution, "%n not allowed as resolution", +Resolution); when others => Error_Kind ("sem_array_constraint(resolution)", Resolution); end case; @@ -2047,6 +2059,9 @@ package body Vhdl.Sem_Types is Error_Msg_Sem (+Resolution, "resolution indication must be an array element resolution"); + when Iir_Kind_Attribute_Name => + Error_Msg_Sem + (+Resolution, "%n not allowed as resolution", +Resolution); when others => Error_Kind ("sem_record_constraint(resolution)", Resolution); end case; @@ -2401,6 +2416,10 @@ package body Vhdl.Sem_Types is Free_Name (Def); return Type_Mark; + when Iir_Kind_Interface_Type_Definition => + Error_Msg_Sem (+Def, "interface types can't be constrained"); + return Type_Mark; + when Iir_Kind_Error => return Type_Mark; @@ -2455,7 +2474,9 @@ package body Vhdl.Sem_Types is Res := Sem_Subtype_Constraint (Def, Type_Mark, Get_Resolution_Indication (Def)); - if not Is_Error (Res) then + if not Is_Error (Res) + and then Get_Kind (Res) in Iir_Kinds_Subtype_Definition + then Set_Subtype_Type_Mark (Res, Type_Mark_Name); end if; return Res; diff --git a/src/vhdl/vhdl-std_env.adb b/src/vhdl/vhdl-std_env.adb new file mode 100644 index 000000000..03b3c364f --- /dev/null +++ b/src/vhdl/vhdl-std_env.adb @@ -0,0 +1,59 @@ +-- Nodes recognizer for ieee.math_real. +-- Copyright (C) 2019 Tristan Gingold +-- +-- 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, see <gnu.org/licenses>. + +with Types; use Types; +with Std_Names; use Std_Names; + +package body Vhdl.Std_Env is + procedure Extract_Declarations (Pkg : Iir_Package_Declaration) + is + Decl : Iir; + Predef : Iir_Predefined_Functions; + Inter : Iir; + begin + Std_Env_Pkg := Pkg; + + Decl := Get_Declaration_Chain (Pkg); + + while Decl /= Null_Iir loop + pragma Assert (Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration); + Inter := Get_Interface_Declaration_Chain (Decl); + case Get_Identifier (Decl) is + when Name_Stop => + if Inter = Null_Iir then + Predef := Iir_Predefined_Std_Env_Stop; + else + Predef := Iir_Predefined_Std_Env_Stop_Status; + pragma Assert (Get_Chain (Inter) = Null_Iir); + end if; + when Name_Finish => + if Inter = Null_Iir then + Predef := Iir_Predefined_Std_Env_Finish; + else + Predef := Iir_Predefined_Std_Env_Finish_Status; + pragma Assert (Get_Chain (Inter) = Null_Iir); + end if; + when Name_Resolution_Limit => + pragma Assert (Inter = Null_Iir); + Predef := Iir_Predefined_Std_Env_Resolution_Limit; + when others => + raise Internal_Error; + end case; + Set_Implicit_Definition (Decl, Predef); + Decl := Get_Chain (Decl); + end loop; + end Extract_Declarations; +end Vhdl.Std_Env; diff --git a/src/vhdl/vhdl-std_env.ads b/src/vhdl/vhdl-std_env.ads new file mode 100644 index 000000000..4a0c3416b --- /dev/null +++ b/src/vhdl/vhdl-std_env.ads @@ -0,0 +1,24 @@ +-- Nodes recognizer for std.env. +-- Copyright (C) 2022 Tristan Gingold +-- +-- 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, see <gnu.org/licenses>. + +with Vhdl.Nodes; use Vhdl.Nodes; + +package Vhdl.Std_Env is + Std_Env_Pkg : Iir_Package_Declaration := Null_Iir; + + -- Extract declarations from PKG (std_env). + procedure Extract_Declarations (Pkg : Iir_Package_Declaration); +end Vhdl.Std_Env; diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index 8e9d5af90..2d36c07ad 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -240,17 +240,17 @@ package body Vhdl.Utils is loop case Get_Kind (Adecl) is when Iir_Kinds_Non_Alias_Object_Declaration - | Iir_Kinds_Quantity_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Interface_Quantity_Declaration - | Iir_Kind_Interface_Terminal_Declaration - | Iir_Kind_Interface_Type_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Interface_Function_Declaration - | Iir_Kind_Interface_Procedure_Declaration - | Iir_Kind_External_Signal_Name - | Iir_Kind_External_Constant_Name - | Iir_Kind_External_Variable_Name => + | Iir_Kinds_Quantity_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Interface_Quantity_Declaration + | Iir_Kind_Interface_Terminal_Declaration + | Iir_Kind_Interface_Type_Declaration + | Iir_Kind_Interface_Package_Declaration + | Iir_Kind_Interface_Function_Declaration + | Iir_Kind_Interface_Procedure_Declaration + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Variable_Name => return Adecl; when Iir_Kind_Object_Alias_Declaration => if With_Alias then @@ -259,35 +259,36 @@ package body Vhdl.Utils is return Adecl; end if; when Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Selected_By_All_Name => + | Iir_Kind_Slice_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Selected_By_All_Name => Adecl := Get_Base_Name (Adecl); when Iir_Kinds_Literal - | Iir_Kind_Overflow_Literal - | Iir_Kind_Enumeration_Literal - | Iir_Kinds_Monadic_Operator - | Iir_Kinds_Dyadic_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Parenthesis_Expression - | Iir_Kinds_Attribute - | Iir_Kind_Attribute_Value - | Iir_Kind_Aggregate - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Unit_Declaration - | Iir_Kind_Psl_Expression - | Iir_Kinds_Concurrent_Statement - | Iir_Kinds_Sequential_Statement - | Iir_Kinds_Simultaneous_Statement => + | Iir_Kind_Overflow_Literal + | Iir_Kind_Enumeration_Literal + | Iir_Kinds_Monadic_Operator + | Iir_Kinds_Dyadic_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Parenthesis_Expression + | Iir_Kinds_Attribute + | Iir_Kind_Attribute_Value + | Iir_Kind_Aggregate + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Unit_Declaration + | Iir_Kind_Psl_Expression + | Iir_Kinds_Concurrent_Statement + | Iir_Kinds_Sequential_Statement + | Iir_Kinds_Simultaneous_Statement + | Iir_Kind_Suspend_State_Statement => return Adecl; when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => + | Iir_Kind_Selected_Name => Adecl := Get_Named_Entity (Adecl); when Iir_Kind_Attribute_Name => return Get_Named_Entity (Adecl); @@ -323,6 +324,7 @@ package body Vhdl.Utils is | Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Suspend_State_Declaration | Iir_Kind_Unaffected_Waveform | Iir_Kind_Waveform_Element | Iir_Kind_Conditional_Waveform @@ -674,6 +676,12 @@ package body Vhdl.Utils is end case; end Is_Parameter; + function Is_Copyback_Parameter (Inter : Iir) return Boolean is + begin + return Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration + and then Get_Mode (Inter) in Iir_Out_Mode .. Iir_Inout_Mode; + end Is_Copyback_Parameter; + function Find_Name_In_Flist (List : Iir_Flist; Lit : Name_Id) return Iir is El : Iir; @@ -1222,6 +1230,8 @@ package body Vhdl.Utils is | Iir_Kind_Across_Attribute | Iir_Kind_Through_Attribute => return Get_Type (Ind); + when Iir_Kind_Interface_Type_Definition => + return Ind; when Iir_Kind_Error => return Ind; when others => diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads index f51599cdf..01425a157 100644 --- a/src/vhdl/vhdl-utils.ads +++ b/src/vhdl/vhdl-utils.ads @@ -112,6 +112,10 @@ package Vhdl.Utils is -- Return True iff interface INTER is a (subprogram) parameter. function Is_Parameter (Inter : Iir) return Boolean; + -- Return True iff parameter INTER should be copied back (for out/inout + -- variable). + function Is_Copyback_Parameter (Inter : Iir) return Boolean; + -- Duplicate enumeration literal LIT. function Copy_Enumeration_Literal (Lit : Iir) return Iir; |