From 85d360929d13e6b0bcb082f144883a43f402ce22 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 5 May 2019 07:49:25 +0200 Subject: vhdl: move std_standard package to vhdl child. --- src/ghdldrv/ghdlcomp.adb | 6 +- src/ghdldrv/ghdllocal.adb | 6 +- src/ghdldrv/ghdlrun.adb | 8 +- src/ghdldrv/ghdlsimul.adb | 6 +- src/libraries.adb | 8 +- src/synth/synth-context.adb | 7 +- src/synth/synth-expr.adb | 6 +- src/synth/synth-types.adb | 6 +- src/vhdl/evaluation.adb | 2 +- src/vhdl/ieee-numeric.adb | 8 +- src/vhdl/ieee-vital_timing.adb | 2 +- src/vhdl/ieee.adb | 4 +- src/vhdl/iirs_utils.adb | 4 +- src/vhdl/nodes_gc.adb | 8 +- src/vhdl/simulate/simul-annotations.adb | 8 +- src/vhdl/simulate/simul-debugger.adb | 4 +- src/vhdl/simulate/simul-execution.adb | 6 +- src/vhdl/simulate/simul-simulation-main.adb | 4 +- src/vhdl/std_package.adb | 1363 --------------------------- src/vhdl/std_package.ads | 202 ---- src/vhdl/translate/trans-chap12.adb | 2 +- src/vhdl/translate/trans-chap14.adb | 2 +- src/vhdl/translate/trans-chap2.adb | 2 +- src/vhdl/translate/trans-chap4.adb | 2 +- src/vhdl/translate/trans-chap7.adb | 2 +- src/vhdl/translate/trans-chap8.adb | 2 +- src/vhdl/translate/trans-chap9.adb | 2 +- src/vhdl/translate/translation.adb | 2 +- src/vhdl/vhdl-configuration.adb | 6 +- src/vhdl/vhdl-disp_vhdl.adb | 12 +- src/vhdl/vhdl-sem.adb | 2 +- src/vhdl/vhdl-sem_assocs.adb | 4 +- src/vhdl/vhdl-sem_decls.adb | 2 +- src/vhdl/vhdl-sem_expr.adb | 2 +- src/vhdl/vhdl-sem_names.adb | 2 +- src/vhdl/vhdl-sem_psl.adb | 10 +- src/vhdl/vhdl-sem_specs.adb | 2 +- src/vhdl/vhdl-sem_stmts.adb | 2 +- src/vhdl/vhdl-sem_types.adb | 2 +- src/vhdl/vhdl-sem_utils.adb | 2 +- src/vhdl/vhdl-std_package.adb | 1363 +++++++++++++++++++++++++++ src/vhdl/vhdl-std_package.ads | 202 ++++ src/vhdl/xrefs.adb | 4 +- 43 files changed, 1651 insertions(+), 1650 deletions(-) delete mode 100644 src/vhdl/std_package.adb delete mode 100644 src/vhdl/std_package.ads create mode 100644 src/vhdl/vhdl-std_package.adb create mode 100644 src/vhdl/vhdl-std_package.ads (limited to 'src') diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 2ac085d9c..542042819 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -29,7 +29,7 @@ with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; with Name_Table; with Errorout; use Errorout; with Libraries; -with Std_Package; +with Vhdl.Std_Package; with Files_Map; with Version; @@ -682,7 +682,7 @@ package body Ghdlcomp is while Is_Valid (It) loop File := Get_Element (It); - if File = Std_Package.Std_Standard_File then + if File = Vhdl.Std_Package.Std_Standard_File then null; elsif Source_File_Modified (File) or else Is_File_Outdated (File) @@ -778,7 +778,7 @@ package body Ghdlcomp is function Is_Makeable_File (File : Iir_Design_File) return Boolean is begin - if File = Std_Package.Std_Standard_File then + if File = Vhdl.Std_Package.Std_Standard_File then return False; end if; return True; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index a400ff69d..8b261279b 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -21,7 +21,7 @@ with GNAT.Directory_Operations; with Types; use Types; with Libraries; with Vhdl.Sem_Lib; -with Std_Package; +with Vhdl.Std_Package; with Flags; with Name_Table; with Std_Names; @@ -1116,7 +1116,7 @@ package body Ghdllocal is end if; Flags.Bootstrap := True; Libraries.Load_Std_Library; - Vhdl.Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit); + Vhdl.Disp_Vhdl.Disp_Vhdl (Vhdl.Std_Package.Std_Standard_Unit); end Perform_Action; -- Command --find-top. @@ -1527,7 +1527,7 @@ package body Ghdllocal is return True; end if; Dep_File := Get_Design_File (Dep); - if Dep /= Std_Package.Std_Standard_Unit + if Dep /= Vhdl.Std_Package.Std_Standard_Unit and then Files_Map.Is_Gt (Get_Analysis_Time_Stamp (Dep_File), Stamp) diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index 6763498f7..f8b3adaaf 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -32,7 +32,7 @@ with Ortho_Jit; with Ortho_Nodes; use Ortho_Nodes; with Trans_Decls; with Iirs; use Iirs; -with Std_Package; +with Vhdl.Std_Package; with Flags; with Errorout; use Errorout; with Libraries; @@ -128,7 +128,7 @@ package body Ghdlrun is end if; if Time_Resolution /= 'a' then - Std_Package.Set_Time_Resolution (Time_Resolution); + Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution); end if; if Analyze_Only then @@ -173,7 +173,7 @@ package body Ghdlrun is end if; if Time_Resolution = 'a' then - Time_Resolution := Std_Package.Get_Minimal_Time_Resolution; + Time_Resolution := Vhdl.Std_Package.Get_Minimal_Time_Resolution; if Time_Resolution = '?' then Time_Resolution := 'f'; end if; @@ -195,7 +195,7 @@ package body Ghdlrun is end; end if; end if; - Std_Package.Set_Time_Resolution (Time_Resolution); + Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution); -- Overwrite time resolution in flag string. Flags.Flag_String (5) := Time_Resolution; diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index cc968048f..b465ed8cc 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -26,7 +26,7 @@ with Types; with Flags; with Name_Table; with Errorout; use Errorout; -with Std_Package; +with Vhdl.Std_Package; with Libraries; with Vhdl.Canon; with Vhdl.Configuration; @@ -61,14 +61,14 @@ package body Ghdlsimul is end if; if Time_Resolution /= 'a' then - Std_Package.Set_Time_Resolution (Time_Resolution); + Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution); end if; if Analyze_Only then return; end if; - Simul.Annotations.Annotate (Std_Package.Std_Standard_Unit); + Simul.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); Vhdl.Canon.Canon_Flag_Add_Labels := True; Vhdl.Canon.Canon_Flag_Sequentials_Stmts := True; diff --git a/src/libraries.adb b/src/libraries.adb index bf0d63503..716438ca6 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -28,7 +28,7 @@ with Str_Table; with Vhdl.Tokens; with Files_Map; with Flags; -with Std_Package; +with Vhdl.Std_Package; package body Libraries is -- Chain of known libraries. This is also the top node of all iir node. @@ -626,7 +626,7 @@ package body Libraries is -- Note: the scanner shouldn't be in use, since this procedure uses it. procedure Load_Std_Library (Build_Standard : Boolean := True) is - use Std_Package; + use Vhdl.Std_Package; Dir : Name_Id; begin if Libraries_Chain /= Null_Iir then @@ -637,7 +637,7 @@ package body Libraries is Flags.Create_Flag_String; Create_Virtual_Locations; - Std_Package.Create_First_Nodes; + Vhdl.Std_Package.Create_First_Nodes; -- Create the library. Std_Library := Create_Iir (Iir_Kind_Library_Declaration); @@ -1325,7 +1325,7 @@ package body Libraries is Design_File := Get_Design_File_Chain (Library); while Design_File /= Null_Iir loop -- Ignore std.standard as there is no corresponding file. - if Design_File = Std_Package.Std_Standard_File then + if Design_File = Vhdl.Std_Package.Std_Standard_File then goto Continue; end if; Design_Unit := Get_First_Design_Unit (Design_File); diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 96242ee73..607c94555 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -25,7 +25,7 @@ with Grt.Types; use Grt.Types; with Errorout; use Errorout; with Iirs_Utils; -with Std_Package; +with Vhdl.Std_Package; with Ieee.Std_Logic_1164; with Simul.Annotations; use Simul.Annotations; @@ -139,8 +139,9 @@ package body Synth.Context is case Val.Lit.Kind is when Iir_Value_B1 => pragma Assert - (Val.Lit_Type = Std_Package.Boolean_Type_Definition - or else Val.Lit_Type = Std_Package.Bit_Type_Definition); + (Val.Lit_Type = Vhdl.Std_Package.Boolean_Type_Definition + or else + Val.Lit_Type = Vhdl.Std_Package.Bit_Type_Definition); return Build_Const_UB32 (Build_Context, Ghdl_B1'Pos (Val.Lit.B1), 1); when Iir_Value_E8 => diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index dea474e6c..cbc9f87d2 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -22,7 +22,7 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Std_Names; with Ieee.Std_Logic_1164; -with Std_Package; +with Vhdl.Std_Package; with Errorout; use Errorout; with Simul.Execution; with Grt.Types; use Grt.Types; @@ -695,11 +695,11 @@ package body Synth.Expr is return Build_Edge (Build_Context, True, Clk); end if; Lit := Get_Named_Entity (Right); - if Lit = Std_Package.Bit_0 + if Lit = Vhdl.Std_Package.Bit_0 or else Lit = Ieee.Std_Logic_1164.Std_Ulogic_0 then Posedge := False; - elsif Lit = Std_Package.Bit_1 + elsif Lit = Vhdl.Std_Package.Bit_1 or else Lit = Ieee.Std_Logic_1164.Std_Ulogic_1 then Posedge := True; diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb index 87fc1826c..88542ab6b 100644 --- a/src/synth/synth-types.adb +++ b/src/synth/synth-types.adb @@ -19,7 +19,7 @@ -- MA 02110-1301, USA. with Types; use Types; -with Std_Package; +with Vhdl.Std_Package; with Ieee.Std_Logic_1164; with Iirs_Utils; use Iirs_Utils; @@ -32,8 +32,8 @@ package body Synth.Types is begin return Atype = Ieee.Std_Logic_1164.Std_Ulogic_Type or else Atype = Ieee.Std_Logic_1164.Std_Logic_Type - or else Atype = Std_Package.Boolean_Type_Definition - or else Atype = Std_Package.Bit_Type_Definition; + or else Atype = Vhdl.Std_Package.Boolean_Type_Definition + or else Atype = Vhdl.Std_Package.Bit_Type_Definition; end Is_Bit_Type; function Is_Vector_Type (Atype : Iir) return Boolean is diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index ec366aeef..a3355f7a6 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -22,7 +22,7 @@ with Errorout; use Errorout; with Name_Table; use Name_Table; with Str_Table; with Iirs_Utils; use Iirs_Utils; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Flags; use Flags; with Std_Names; with Ada.Characters.Handling; diff --git a/src/vhdl/ieee-numeric.adb b/src/vhdl/ieee-numeric.adb index d87cb1898..c6dfcb17a 100644 --- a/src/vhdl/ieee-numeric.adb +++ b/src/vhdl/ieee-numeric.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Types; use Types; -with Std_Package; +with Vhdl.Std_Package; with Std_Names; use Std_Names; with Errorout; use Errorout; with Ieee.Std_Logic_1164; @@ -88,10 +88,10 @@ package body Ieee.Numeric is elsif Arg_Type = Unsigned_Type then Sign := Type_Unsigned; Kind := Arg_Vect; - elsif Arg_Type = Std_Package.Integer_Subtype_Definition then + elsif Arg_Type = Vhdl.Std_Package.Integer_Subtype_Definition then Sign := Type_Signed; Kind := Arg_Scal; - elsif Arg_Type = Std_Package.Natural_Subtype_Definition then + elsif Arg_Type = Vhdl.Std_Package.Natural_Subtype_Definition then Sign := Type_Unsigned; Kind := Arg_Scal; elsif Arg_Type = Ieee.Std_Logic_1164.Std_Ulogic_Type then @@ -157,7 +157,7 @@ package body Ieee.Numeric is if Decl /= Null_Iir and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration and then (Get_Base_Type (Get_Type (Decl)) - = Std_Package.String_Type_Definition) + = Vhdl.Std_Package.String_Type_Definition) then Decl := Get_Chain (Decl); end if; diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb index a1413285e..d4777d651 100644 --- a/src/vhdl/ieee-vital_timing.adb +++ b/src/vhdl/ieee-vital_timing.adb @@ -18,7 +18,7 @@ with Types; use Types; with Std_Names; with Errorout; use Errorout; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Tokens; use Vhdl.Tokens; with Name_Table; with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164; diff --git a/src/vhdl/ieee.adb b/src/vhdl/ieee.adb index d730bf388..393a05d32 100644 --- a/src/vhdl/ieee.adb +++ b/src/vhdl/ieee.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Iirs_Utils; use Iirs_Utils; -with Std_Package; +with Vhdl.Std_Package; package body Ieee is function Skip_Copyright_Notice (Decl : Iir) return Iir @@ -26,7 +26,7 @@ package body Ieee is if Decl /= Null_Iir and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration and then (Get_Base_Type (Get_Type (Decl)) - = Std_Package.String_Type_Definition) + = Vhdl.Std_Package.String_Type_Definition) then return Get_Chain (Decl); else diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 034fdd051..89b9d46ec 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -21,7 +21,7 @@ with Errorout; use Errorout; with Name_Table; with Str_Table; with Std_Names; use Std_Names; -with Std_Package; +with Vhdl.Std_Package; with Flags; use Flags; with PSL.Nodes; @@ -1358,7 +1358,7 @@ package body Iirs_Utils is Name : constant Iir := Get_Entity_Name (Decl); Res : constant Iir := Get_Named_Entity (Name); begin - if Res = Std_Package.Error_Mark then + if Res = Vhdl.Std_Package.Error_Mark then return Null_Iir; end if; diff --git a/src/vhdl/nodes_gc.adb b/src/vhdl/nodes_gc.adb index 1ee3696ab..eb7d4dee3 100644 --- a/src/vhdl/nodes_gc.adb +++ b/src/vhdl/nodes_gc.adb @@ -24,7 +24,7 @@ with Nodes_Meta; use Nodes_Meta; with Errorout; use Errorout; with Libraries; with Vhdl.Disp_Tree; -with Std_Package; +with Vhdl.Std_Package; package body Nodes_GC is @@ -375,7 +375,7 @@ package body Nodes_GC is -- but referenced nodes in std_package. procedure Mark_Init is - use Std_Package; + use Vhdl.Std_Package; begin Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); @@ -389,7 +389,7 @@ package body Nodes_GC is -- Marks known nodes that aren't owned. procedure Mark_Not_Owned is - use Std_Package; + use Vhdl.Std_Package; begin -- These nodes are owned by type/subtype declarations, so unmark them -- before marking their owner. @@ -478,7 +478,7 @@ package body Nodes_GC is procedure Report_Unreferenced is - use Std_Package; + use Vhdl.Std_Package; El : Iir; Nbr_Unreferenced : Natural; begin diff --git a/src/vhdl/simulate/simul-annotations.adb b/src/vhdl/simulate/simul-annotations.adb index f02f642b1..22ca12a07 100644 --- a/src/vhdl/simulate/simul-annotations.adb +++ b/src/vhdl/simulate/simul-annotations.adb @@ -18,7 +18,7 @@ with Tables; with Ada.Text_IO; -with Std_Package; +with Vhdl.Std_Package; with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; with Types; use Types; @@ -279,8 +279,8 @@ package body Simul.Annotations is declare Mode : Iir_Value_Kind; begin - if Def = Std_Package.Boolean_Type_Definition - or else Def = Std_Package.Bit_Type_Definition + if Def = Vhdl.Std_Package.Boolean_Type_Definition + or else Def = Vhdl.Std_Package.Bit_Type_Definition then Mode := Iir_Value_B1; elsif (Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)) @@ -1161,7 +1161,7 @@ package body Simul.Annotations is Annotate_Architecture (El); when Iir_Kind_Package_Declaration => declare - use Std_Package; + use Vhdl.Std_Package; begin if El = Standard_Package then pragma Assert (Global_Info = null); diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb index 8c911a706..e96a8100e 100644 --- a/src/vhdl/simulate/simul-debugger.adb +++ b/src/vhdl/simulate/simul-debugger.adb @@ -31,7 +31,7 @@ with Vhdl.Sem_Scopes; with Vhdl.Canon; with Std_Names; with Libraries; -with Std_Package; +with Vhdl.Std_Package; with Simul.Annotations; use Simul.Annotations; with Simul.Elaboration; use Simul.Elaboration; with Simul.Execution; use Simul.Execution; @@ -1826,7 +1826,7 @@ package body Simul.Debugger is -- Add STD Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False); - Use_All_Names (Std_Package.Standard_Package); + Use_All_Names (Vhdl.Std_Package.Standard_Package); Foreach_Scopes (Node, Add_Decls_For'Access); end Enter_Scope; diff --git a/src/vhdl/simulate/simul-execution.adb b/src/vhdl/simulate/simul-execution.adb index 3a1c11028..59d91c8ef 100644 --- a/src/vhdl/simulate/simul-execution.adb +++ b/src/vhdl/simulate/simul-execution.adb @@ -22,7 +22,7 @@ with System; with Grt.Types; use Grt.Types; with Flags; use Flags; with Errorout; use Errorout; -with Std_Package; +with Vhdl.Std_Package; with Evaluation; with Iirs_Utils; use Iirs_Utils; with Simul.Annotations; use Simul.Annotations; @@ -1321,7 +1321,7 @@ package body Simul.Execution is Pos : constant Natural := Get_Enum_Pos (Left); Id : Name_Id; begin - if Base_Type = Std_Package.Character_Type_Definition then + if Base_Type = Vhdl.Std_Package.Character_Type_Definition then Result := String_To_Iir_Value ((1 => Character'Val (Pos))); else Id := Get_Identifier (Get_Nth_Element (Lits, Pos)); @@ -1418,7 +1418,7 @@ package body Simul.Execution is First : Natural; Unit : Iir; begin - Unit := Get_Unit_Chain (Std_Package.Time_Type_Definition); + Unit := Get_Unit_Chain (Vhdl.Std_Package.Time_Type_Definition); while Unit /= Null_Iir loop exit when Evaluation.Get_Physical_Value (Unit) = Iir_Int64 (Right.I64); diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb index 7d6f0e7c7..2d0558308 100644 --- a/src/vhdl/simulate/simul-simulation-main.adb +++ b/src/vhdl/simulate/simul-simulation-main.adb @@ -24,7 +24,7 @@ with Errorout; use Errorout; with PSL.Nodes; with PSL.NFAs; with PSL.NFAs.Utils; -with Std_Package; +with Vhdl.Std_Package; with Trans_Analyzes; with Simul.Elaboration; use Simul.Elaboration; with Simul.Execution; use Simul.Execution; @@ -379,7 +379,7 @@ package body Simul.Simulation.Main is Res : Iir_Value_Literal_Acc; begin Res := Execute_Expression (Instance, E); - if Rtype = Std_Package.Boolean_Type_Definition then + if Rtype = Vhdl.Std_Package.Boolean_Type_Definition then return Res.B1 = True; elsif Rtype = Ieee.Std_Logic_1164.Std_Ulogic_Type then return Res.E8 = 3 or Res.E8 = 7; -- 1 or H diff --git a/src/vhdl/std_package.adb b/src/vhdl/std_package.adb deleted file mode 100644 index 5dd659d6a..000000000 --- a/src/vhdl/std_package.adb +++ /dev/null @@ -1,1363 +0,0 @@ --- std.standard package declarations. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Files_Map; -with Name_Table; -with Str_Table; -with Std_Names; use Std_Names; -with Flags; use Flags; -with Iirs_Utils; -with Vhdl.Sem_Utils; -with Iir_Chains; - -package body Std_Package is - type Bound_Array is array (Boolean) of Iir_Int64; - Low_Bound : constant Bound_Array := (False => -(2 ** 31), - True => -(2 ** 63)); - High_Bound : constant Bound_Array := (False => (2 ** 31) - 1, - True => (2 ** 63) - 1); - - Std_Filename : Name_Id := Null_Identifier; - - -- Could be public. - Time_Fs_Unit: Iir_Unit_Declaration; - Time_Ps_Unit: Iir_Unit_Declaration; - Time_Ns_Unit: Iir_Unit_Declaration; - Time_Us_Unit: Iir_Unit_Declaration; - Time_Ms_Unit: Iir_Unit_Declaration; - Time_Sec_Unit: Iir_Unit_Declaration; - Time_Min_Unit: Iir_Unit_Declaration; - Time_Hr_Unit: Iir_Unit_Declaration; - - function Create_Std_Iir (Kind : Iir_Kind) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Kind); - Set_Location (Res, Std_Location); - return Res; - end Create_Std_Iir; - - function Create_Std_Decl (Kind : Iir_Kind) return Iir - is - Res : Iir; - begin - Res := Create_Std_Iir (Kind); - Set_Parent (Res, Standard_Package); - return Res; - end Create_Std_Decl; - - function Create_Std_Type_Mark (Ref : Iir) return Iir - is - Res : Iir; - begin - Res := Iirs_Utils.Build_Simple_Name (Ref, Std_Location); - Set_Type (Res, Get_Type (Ref)); - return Res; - end Create_Std_Type_Mark; - - procedure Create_First_Nodes - is - procedure Create_Known_Iir (Kind : Iir_Kind; Val : Iir) is - begin - if Create_Std_Iir (Kind) /= Val then - raise Internal_Error; - end if; - end Create_Known_Iir; - begin - Std_Filename := Name_Table.Get_Identifier ("*std_standard*"); - Std_Source_File := Files_Map.Create_Virtual_Source_File (Std_Filename); - Std_Location := Files_Map.File_To_Location (Std_Source_File); - - if Create_Iir_Error /= Error_Mark then - raise Internal_Error; - end if; - Set_Location (Error_Mark, Std_Location); - - Create_Known_Iir (Iir_Kind_Integer_Type_Definition, - Universal_Integer_Type_Definition); - Create_Known_Iir (Iir_Kind_Floating_Type_Definition, - Universal_Real_Type_Definition); - - Create_Known_Iir (Iir_Kind_Integer_Type_Definition, - Convertible_Integer_Type_Definition); - Create_Known_Iir (Iir_Kind_Floating_Type_Definition, - Convertible_Real_Type_Definition); - - Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, - Wildcard_Any_Type); - Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, - Wildcard_Any_Aggregate_Type); - Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, - Wildcard_Any_String_Type); - Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, - Wildcard_Any_Access_Type); - end Create_First_Nodes; - - procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration) - is - function Get_Std_Character (Char: Character) return Name_Id - renames Name_Table.Get_Identifier; - - procedure Set_Std_Identifier (Decl : Iir; Name : Name_Id) is - begin - Set_Identifier (Decl, Name); - Set_Visible_Flag (Decl, True); - end Set_Std_Identifier; - - function Create_Std_Integer (Val : Iir_Int64; Lit_Type : Iir) - return Iir_Integer_Literal - is - Res : Iir_Integer_Literal; - begin - Res := Create_Std_Iir (Iir_Kind_Integer_Literal); - Set_Value (Res, Val); - Set_Type (Res, Lit_Type); - Set_Expr_Staticness (Res, Locally); - return Res; - end Create_Std_Integer; - - function Create_Std_Fp (Val : Iir_Fp64; Lit_Type : Iir) - return Iir_Floating_Point_Literal - is - Res : Iir_Floating_Point_Literal; - begin - Res := Create_Std_Iir (Iir_Kind_Floating_Point_Literal); - Set_Fp_Value (Res, Val); - Set_Type (Res, Lit_Type); - Set_Expr_Staticness (Res, Locally); - return Res; - end Create_Std_Fp; - - function Create_Std_Range_Expr (Left, Right : Iir; Rtype : Iir) - return Iir - is - Res : Iir; - begin - Res := Create_Std_Iir (Iir_Kind_Range_Expression); - Set_Left_Limit (Res, Left); - Set_Left_Limit_Expr (Res, Left); - Set_Direction (Res, Iir_To); - Set_Right_Limit (Res, Right); - Set_Right_Limit_Expr (Res, Right); - Set_Expr_Staticness (Res, Locally); - Set_Type (Res, Rtype); - return Res; - end Create_Std_Range_Expr; - - function Create_Std_Literal (Name : Name_Id; - Pos : Natural; - Sub_Type : Iir_Enumeration_Type_Definition) - return Iir_Enumeration_Literal - is - List : constant Iir_Flist := Get_Enumeration_Literal_List (Sub_Type); - Res : Iir_Enumeration_Literal; - begin - Res := Create_Std_Decl (Iir_Kind_Enumeration_Literal); - Set_Std_Identifier (Res, Name); - Set_Type (Res, Sub_Type); - Set_Expr_Staticness (Res, Locally); - Set_Name_Staticness (Res, Locally); - Set_Enum_Pos (Res, Iir_Int32 (Pos)); - Vhdl.Sem_Utils.Compute_Subprogram_Hash (Res); - Set_Nth_Element (List, Pos, Res); - return Res; - end Create_Std_Literal; - - -- Append a declaration DECL to Standard_Package. - Last_Decl : Iir := Null_Iir; - procedure Add_Decl (Decl : Iir) is - begin - if Last_Decl = Null_Iir then - Set_Declaration_Chain (Standard_Package, Decl); - else - Set_Chain (Last_Decl, Decl); - end if; - Last_Decl := Decl; - end Add_Decl; - - procedure Add_Implicit_Operations (Decl : Iir) - is - Nxt : Iir; - begin - Vhdl.Sem_Utils.Create_Implicit_Operations (Decl, True); - - -- Update Last_Decl - loop - Nxt := Get_Chain (Last_Decl); - exit when Nxt = Null_Iir; - Last_Decl := Nxt; - end loop; - end Add_Implicit_Operations; - - -- Find implicit declaration of "**" for type declaration TYPE_DECL - -- and append it at the current end of std_package. - procedure Relocate_Exp_At_End (Type_Decl : Iir) - is - Prev_El, El : Iir; - begin - pragma Assert - (Get_Kind (Type_Decl) = Iir_Kind_Anonymous_Type_Declaration); - El := Type_Decl; - loop - Prev_El := El; - El := Get_Chain (El); - pragma Assert (Get_Kind (El) = Iir_Kind_Function_Declaration); - exit when - Get_Implicit_Definition (El) = Iir_Predefined_Integer_Exp; - exit when - Get_Implicit_Definition (El) = Iir_Predefined_Floating_Exp; - end loop; - - -- EL must not be the last element, otherwise Add_Decl will break - -- the chain. - pragma Assert (Is_Valid (Get_Chain (El))); - - -- Remove from the chain. - Set_Chain (Prev_El, Get_Chain (El)); - Set_Chain (El, Null_Iir); - - -- Append. - Add_Decl (El); - end Relocate_Exp_At_End; - - procedure Create_Std_Type (Decl : out Iir; Def : Iir; Name : Name_Id) is - begin - Decl := Create_Std_Decl (Iir_Kind_Type_Declaration); - Set_Std_Identifier (Decl, Name); - Set_Type_Definition (Decl, Def); - Add_Decl (Decl); - Set_Type_Declarator (Def, Decl); - end Create_Std_Type; - - procedure Create_Integer_Type (Type_Definition : Iir; - Type_Decl : out Iir; - Type_Name : Name_Id) - is - begin - --Integer_Type_Definition := - -- Create_Std_Iir (Iir_Kind_Integer_Type_Definition); - Set_Base_Type (Type_Definition, Type_Definition); - Set_Type_Staticness (Type_Definition, Locally); - Set_Signal_Type_Flag (Type_Definition, True); - Set_Has_Signal_Flag (Type_Definition, not Flags.Flag_Whole_Analyze); - - Type_Decl := Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); - Set_Identifier (Type_Decl, Type_Name); - Set_Type_Definition (Type_Decl, Type_Definition); - Set_Type_Declarator (Type_Definition, Type_Decl); - end Create_Integer_Type; - - procedure Create_Integer_Subtype (Type_Definition : Iir; - Type_Decl : Iir; - Subtype_Definition : out Iir; - Subtype_Decl : out Iir; - Is_64 : Boolean) - is - Constraint : Iir; - begin - Subtype_Definition := - Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition); - Set_Base_Type (Subtype_Definition, Type_Definition); - Constraint := Create_Std_Range_Expr - (Create_Std_Integer (Low_Bound (Is_64), - Universal_Integer_Type_Definition), - Create_Std_Integer (High_Bound (Is_64), - Universal_Integer_Type_Definition), - Universal_Integer_Type_Definition); - Set_Range_Constraint (Subtype_Definition, Constraint); - Set_Type_Staticness (Subtype_Definition, Locally); - Set_Signal_Type_Flag (Subtype_Definition, True); - Set_Has_Signal_Flag (Subtype_Definition, - not Flags.Flag_Whole_Analyze); - - -- subtype is - Subtype_Decl := Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Std_Identifier (Subtype_Decl, Get_Identifier (Type_Decl)); - Set_Type (Subtype_Decl, Subtype_Definition); - Set_Subtype_Indication (Subtype_Decl, Subtype_Definition); - Set_Type_Declarator (Subtype_Definition, Subtype_Decl); - Set_Subtype_Definition (Type_Decl, Subtype_Definition); - end Create_Integer_Subtype; - - -- Create an array of EL_TYPE, indexed by Natural. - procedure Create_Array_Type - (Def : out Iir; Decl : out Iir; El_Decl : Iir; Name : Name_Id) - is - Index_List : Iir_Flist; - Index : Iir; - Element : Iir; - begin - Element := Create_Std_Type_Mark (El_Decl); - Index := Create_Std_Type_Mark (Natural_Subtype_Declaration); - - Def := Create_Std_Iir (Iir_Kind_Array_Type_Definition); - Set_Base_Type (Def, Def); - - Index_List := Create_Iir_Flist (1); - Set_Index_Subtype_Definition_List (Def, Index_List); - Set_Index_Subtype_List (Def, Index_List); - Set_Nth_Element (Index_List, 0, Index); - - Set_Element_Subtype_Indication (Def, Element); - Set_Element_Subtype (Def, Get_Type (El_Decl)); - Set_Type_Staticness (Def, None); - Set_Signal_Type_Flag (Def, True); - Set_Has_Signal_Flag (Def, not Flags.Flag_Whole_Analyze); - - Create_Std_Type (Decl, Def, Name); - - Add_Implicit_Operations (Decl); - end Create_Array_Type; - - -- Create: - -- function TO_STRING (VALUE: inter_type) return STRING; - procedure Create_To_String (Inter_Type : Iir; - Imp : Iir_Predefined_Functions; - Name : Name_Id := Std_Names.Name_To_String; - Inter2_Id : Name_Id := Null_Identifier; - Inter2_Type : Iir := Null_Iir) - is - Decl : Iir_Function_Declaration; - Inter : Iir_Interface_Constant_Declaration; - Inter2 : Iir_Interface_Constant_Declaration; - begin - Decl := Create_Std_Decl (Iir_Kind_Function_Declaration); - Set_Std_Identifier (Decl, Name); - Set_Return_Type (Decl, String_Type_Definition); - Set_Pure_Flag (Decl, True); - Set_Implicit_Definition (Decl, Imp); - - Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); - Set_Identifier (Inter, Std_Names.Name_Value); - Set_Type (Inter, Inter_Type); - Set_Mode (Inter, Iir_In_Mode); - Set_Visible_Flag (Inter, True); - Set_Interface_Declaration_Chain (Decl, Inter); - - if Inter2_Id /= Null_Identifier then - Inter2 := Create_Iir (Iir_Kind_Interface_Constant_Declaration); - Set_Identifier (Inter2, Inter2_Id); - Set_Type (Inter2, Inter2_Type); - Set_Mode (Inter2, Iir_In_Mode); - Set_Visible_Flag (Inter2, True); - Set_Chain (Inter, Inter2); - end if; - - Vhdl.Sem_Utils.Compute_Subprogram_Hash (Decl); - Add_Decl (Decl); - end Create_To_String; - - -- Create: - -- function NAME (signal S : I inter_type) return BOOLEAN; - procedure Create_Edge_Function - (Name : Name_Id; Func : Iir_Predefined_Functions; Inter_Type : Iir) - is - Decl : Iir_Function_Declaration; - Inter : Iir_Interface_Constant_Declaration; - begin - Decl := Create_Std_Decl (Iir_Kind_Function_Declaration); - Set_Std_Identifier (Decl, Name); - Set_Return_Type (Decl, Boolean_Type_Definition); - Set_Pure_Flag (Decl, True); - Set_Implicit_Definition (Decl, Func); - - Inter := Create_Iir (Iir_Kind_Interface_Signal_Declaration); - Set_Identifier (Inter, Std_Names.Name_S); - Set_Type (Inter, Inter_Type); - Set_Mode (Inter, Iir_In_Mode); - Set_Visible_Flag (Inter, True); - Set_Interface_Declaration_Chain (Decl, Inter); - - Vhdl.Sem_Utils.Compute_Subprogram_Hash (Decl); - Add_Decl (Decl); - end Create_Edge_Function; - - procedure Create_Wildcard_Type (Def : Iir; Name : String) - is - Decl : Iir; - begin - Decl := Create_Std_Decl (Iir_Kind_Type_Declaration); - Set_Identifier (Decl, Name_Table.Get_Identifier (Name)); - Set_Base_Type (Def, Def); - Set_Type_Staticness (Def, None); - Set_Type_Definition (Decl, Def); - Set_Type_Declarator (Def, Decl); - - Set_Chain (Decl, Wildcard_Type_Declaration_Chain); - Wildcard_Type_Declaration_Chain := Decl; - end Create_Wildcard_Type; - - begin - -- Create design file. - Std_Standard_File := Create_Std_Iir (Iir_Kind_Design_File); - Set_Parent (Std_Standard_File, Parent); - Set_Design_File_Filename (Std_Standard_File, Std_Filename); - - declare - Std_Time_Stamp : constant Time_Stamp_String := - "20020601000000.000"; - Id : Time_Stamp_Id; - begin - Id := Time_Stamp_Id (Str_Table.Create_String8); - for I in Time_Stamp_String'Range loop - Str_Table.Append_String8_Char (Std_Time_Stamp (I)); - end loop; - Set_Analysis_Time_Stamp (Std_Standard_File, Id); - end; - - -- Create design unit. - Std_Standard_Unit := Create_Std_Iir (Iir_Kind_Design_Unit); - Set_Identifier (Std_Standard_Unit, Name_Standard); - Set_First_Design_Unit (Std_Standard_File, Std_Standard_Unit); - Set_Last_Design_Unit (Std_Standard_File, Std_Standard_Unit); - Set_Design_File (Std_Standard_Unit, Std_Standard_File); - Set_Date_State (Std_Standard_Unit, Date_Analyze); - Set_Dependence_List (Std_Standard_Unit, Create_Iir_List); - - Set_Date (Std_Standard_Unit, Date_Valid'First); - - -- Adding "package STANDARD is" - Standard_Package := Create_Std_Iir (Iir_Kind_Package_Declaration); - Set_Std_Identifier (Standard_Package, Name_Standard); - Set_Need_Body (Standard_Package, False); - - Set_Library_Unit (Std_Standard_Unit, Standard_Package); - Set_Design_Unit (Standard_Package, Std_Standard_Unit); - - -- boolean - begin - -- (false, true) - Boolean_Type_Definition := - Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); - Set_Base_Type (Boolean_Type_Definition, Boolean_Type_Definition); - Set_Enumeration_Literal_List - (Boolean_Type_Definition, Create_Iir_Flist (2)); - Boolean_False := Create_Std_Literal - (Name_False, 0, Boolean_Type_Definition); - Boolean_True := Create_Std_Literal - (Name_True, 1, Boolean_Type_Definition); - Set_Type_Staticness (Boolean_Type_Definition, Locally); - Set_Signal_Type_Flag (Boolean_Type_Definition, True); - Set_Has_Signal_Flag (Boolean_Type_Definition, - not Flags.Flag_Whole_Analyze); - - -- type boolean is - Create_Std_Type (Boolean_Type_Declaration, Boolean_Type_Definition, - Name_Boolean); - - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type - (Boolean_Type_Definition); - Add_Implicit_Operations (Boolean_Type_Declaration); - end; - - if Vhdl_Std >= Vhdl_08 then - -- Rising_Edge and Falling_Edge - Create_Edge_Function - (Std_Names.Name_Rising_Edge, Iir_Predefined_Boolean_Rising_Edge, - Boolean_Type_Definition); - Create_Edge_Function - (Std_Names.Name_Falling_Edge, Iir_Predefined_Boolean_Falling_Edge, - Boolean_Type_Definition); - end if; - - -- bit. - begin - -- ('0', '1') - Bit_Type_Definition := - Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); - Set_Enumeration_Literal_List - (Bit_Type_Definition, Create_Iir_Flist (2)); - Set_Base_Type (Bit_Type_Definition, Bit_Type_Definition); - Set_Is_Character_Type (Bit_Type_Definition, True); - Bit_0 := Create_Std_Literal - (Get_Std_Character ('0'), 0, Bit_Type_Definition); - Bit_1 := Create_Std_Literal - (Get_Std_Character ('1'), 1, Bit_Type_Definition); - Set_Type_Staticness (Bit_Type_Definition, Locally); - Set_Signal_Type_Flag (Bit_Type_Definition, True); - Set_Has_Signal_Flag (Bit_Type_Definition, - not Flags.Flag_Whole_Analyze); - Set_Only_Characters_Flag (Bit_Type_Definition, True); - - -- type bit is - Create_Std_Type (Bit_Type_Declaration, Bit_Type_Definition, Name_Bit); - - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type - (Bit_Type_Definition); - Add_Implicit_Operations (Bit_Type_Declaration); - end; - - if Vhdl_Std >= Vhdl_08 then - -- Rising_Edge and Falling_Edge - Create_Edge_Function - (Std_Names.Name_Rising_Edge, Iir_Predefined_Bit_Rising_Edge, - Bit_Type_Definition); - Create_Edge_Function - (Std_Names.Name_Falling_Edge, Iir_Predefined_Bit_Falling_Edge, - Bit_Type_Definition); - end if; - - -- characters. - declare - El: Iir; - pragma Unreferenced (El); - Len : Natural; - begin - Character_Type_Definition := - Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); - Set_Base_Type (Character_Type_Definition, Character_Type_Definition); - Set_Is_Character_Type (Character_Type_Definition, True); - if Vhdl_Std = Vhdl_87 then - Len := 128; - else - Len := 256; - end if; - Set_Enumeration_Literal_List - (Character_Type_Definition, Create_Iir_Flist (Len)); - - for I in Name_Nul .. Name_Usp loop - El := Create_Std_Literal - (I, Natural (I - Name_Nul), Character_Type_Definition); - end loop; - for I in Character'(' ') .. Character'('~') loop - El := Create_Std_Literal - (Get_Std_Character (I), Character'Pos (I), - Character_Type_Definition); - end loop; - El := Create_Std_Literal (Name_Del, 127, Character_Type_Definition); - if Vhdl_Std /= Vhdl_87 then - for I in Name_C128 .. Name_C159 loop - El := Create_Std_Literal - (I, 128 + Natural (I - Name_C128), Character_Type_Definition); - end loop; - for I in Character'Val (160) .. Character'Val (255) loop - El := Create_Std_Literal - (Get_Std_Character (I), Character'Pos (I), - Character_Type_Definition); - end loop; - end if; - Set_Type_Staticness (Character_Type_Definition, Locally); - Set_Signal_Type_Flag (Character_Type_Definition, True); - Set_Has_Signal_Flag (Character_Type_Definition, - not Flags.Flag_Whole_Analyze); - - -- type character is - Create_Std_Type - (Character_Type_Declaration, Character_Type_Definition, - Name_Character); - - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type - (Character_Type_Definition); - Add_Implicit_Operations (Character_Type_Declaration); - end; - - -- severity level. - begin - -- (note, warning, error, failure) - Severity_Level_Type_Definition := - Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); - Set_Base_Type (Severity_Level_Type_Definition, - Severity_Level_Type_Definition); - Set_Enumeration_Literal_List - (Severity_Level_Type_Definition, Create_Iir_Flist (4)); - - Severity_Level_Note := Create_Std_Literal - (Name_Note, 0, Severity_Level_Type_Definition); - Severity_Level_Warning := Create_Std_Literal - (Name_Warning, 1, Severity_Level_Type_Definition); - Severity_Level_Error := Create_Std_Literal - (Name_Error, 2, Severity_Level_Type_Definition); - Severity_Level_Failure := Create_Std_Literal - (Name_Failure, 3, Severity_Level_Type_Definition); - Set_Type_Staticness (Severity_Level_Type_Definition, Locally); - Set_Signal_Type_Flag (Severity_Level_Type_Definition, True); - Set_Has_Signal_Flag (Severity_Level_Type_Definition, - not Flags.Flag_Whole_Analyze); - - -- type severity_level is - Create_Std_Type - (Severity_Level_Type_Declaration, Severity_Level_Type_Definition, - Name_Severity_Level); - - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type - (Severity_Level_Type_Definition); - Add_Implicit_Operations (Severity_Level_Type_Declaration); - end; - - -- universal integer - begin - Create_Integer_Type (Universal_Integer_Type_Definition, - Universal_Integer_Type_Declaration, - Name_Universal_Integer); - Add_Decl (Universal_Integer_Type_Declaration); - - Create_Integer_Subtype (Universal_Integer_Type_Definition, - Universal_Integer_Type_Declaration, - Universal_Integer_Subtype_Definition, - Universal_Integer_Subtype_Declaration, - Flags.Flag_Time_64 or Flags.Flag_Integer_64); - - Add_Decl (Universal_Integer_Subtype_Declaration); - Set_Subtype_Definition (Universal_Integer_Type_Declaration, - Universal_Integer_Subtype_Definition); - - -- Do not create implicit operations yet, since "**" needs integer - -- type. - end; - - -- Universal integer constant 1. - Universal_Integer_One := - Create_Std_Integer (1, Universal_Integer_Type_Definition); - - -- Universal real. - declare - Constraint : Iir_Range_Expression; - begin - Set_Base_Type (Universal_Real_Type_Definition, - Universal_Real_Type_Definition); - Set_Type_Staticness (Universal_Real_Type_Definition, Locally); - Set_Signal_Type_Flag (Universal_Real_Type_Definition, True); - Set_Has_Signal_Flag (Universal_Real_Type_Definition, False); - - -- type universal_real is ... - Universal_Real_Type_Declaration := - Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); - Set_Identifier (Universal_Real_Type_Declaration, Name_Universal_Real); - Set_Type_Definition (Universal_Real_Type_Declaration, - Universal_Real_Type_Definition); - Set_Type_Declarator (Universal_Real_Type_Definition, - Universal_Real_Type_Declaration); - Add_Decl (Universal_Real_Type_Declaration); - - Universal_Real_Subtype_Definition := - Create_Std_Iir (Iir_Kind_Floating_Subtype_Definition); - Set_Base_Type (Universal_Real_Subtype_Definition, - Universal_Real_Type_Definition); - Constraint := Create_Std_Range_Expr - (Create_Std_Fp (Iir_Fp64'First, Universal_Real_Type_Definition), - Create_Std_Fp (Iir_Fp64'Last, Universal_Real_Type_Definition), - Universal_Real_Type_Definition); - Set_Range_Constraint (Universal_Real_Subtype_Definition, Constraint); - Set_Type_Staticness (Universal_Real_Subtype_Definition, Locally); - Set_Signal_Type_Flag (Universal_Real_Subtype_Definition, True); - Set_Has_Signal_Flag (Universal_Real_Subtype_Definition, False); - - -- subtype universal_real is ... - Universal_Real_Subtype_Declaration := - Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Identifier (Universal_Real_Subtype_Declaration, - Name_Universal_Real); - Set_Type (Universal_Real_Subtype_Declaration, - Universal_Real_Subtype_Definition); - Set_Subtype_Indication (Universal_Real_Subtype_Declaration, - Universal_Real_Subtype_Definition); - Set_Type_Declarator (Universal_Real_Subtype_Definition, - Universal_Real_Subtype_Declaration); - Set_Subtype_Definition (Universal_Real_Type_Declaration, - Universal_Real_Subtype_Definition); - - Add_Decl (Universal_Real_Subtype_Declaration); - - -- Do not create implicit operations yet, since "**" needs integer - -- type. - end; - - -- Convertible type. - begin - Create_Integer_Type (Convertible_Integer_Type_Definition, - Convertible_Integer_Type_Declaration, - Name_Convertible_Integer); - Create_Integer_Subtype (Convertible_Integer_Type_Definition, - Convertible_Integer_Type_Declaration, - Convertible_Integer_Subtype_Definition, - Convertible_Integer_Subtype_Declaration, - Flags.Flag_Time_64 or Flags.Flag_Integer_64); - - -- Not added in std.standard. - end; - - begin - Set_Base_Type (Convertible_Real_Type_Definition, - Convertible_Real_Type_Definition); - Set_Type_Staticness (Convertible_Real_Type_Definition, Locally); - Set_Signal_Type_Flag (Convertible_Real_Type_Definition, True); - Set_Has_Signal_Flag (Convertible_Real_Type_Definition, False); - - Convertible_Real_Type_Declaration := - Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); - Set_Identifier (Convertible_Real_Type_Declaration, - Name_Convertible_Real); - Set_Type_Definition (Convertible_Real_Type_Declaration, - Convertible_Real_Type_Definition); - Set_Type_Declarator (Convertible_Real_Type_Definition, - Convertible_Real_Type_Declaration); - end; - - -- integer type. - begin - Integer_Type_Definition := - Create_Std_Iir (Iir_Kind_Integer_Type_Definition); - Create_Integer_Type (Integer_Type_Definition, - Integer_Type_Declaration, - Name_Integer); - Add_Decl (Integer_Type_Declaration); - - -- Now that Integer is declared, create operations for universal - -- types. They will be inserted just after the type declaration, - -- but cannot be done before as "**" relies on Integer. - Add_Implicit_Operations (Universal_Integer_Type_Declaration); - Add_Implicit_Operations (Universal_Real_Type_Declaration); - - -- Don't define "**" for universal types before the declaration of - -- Integer, so move them. - Relocate_Exp_At_End (Universal_Integer_Type_Declaration); - Relocate_Exp_At_End (Universal_Real_Type_Declaration); - - Add_Implicit_Operations (Integer_Type_Declaration); - - Create_Integer_Subtype (Integer_Type_Definition, - Integer_Type_Declaration, - Integer_Subtype_Definition, - Integer_Subtype_Declaration, - Flags.Flag_Integer_64); - Add_Decl (Integer_Subtype_Declaration); - end; - - -- Real type. - declare - Constraint : Iir_Range_Expression; - begin - Real_Type_Definition := - Create_Std_Iir (Iir_Kind_Floating_Type_Definition); - Set_Base_Type (Real_Type_Definition, Real_Type_Definition); - Set_Type_Staticness (Real_Type_Definition, Locally); - Set_Signal_Type_Flag (Real_Type_Definition, True); - Set_Has_Signal_Flag (Real_Type_Definition, - not Flags.Flag_Whole_Analyze); - - Real_Type_Declaration := - Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); - Set_Identifier (Real_Type_Declaration, Name_Real); - Set_Type_Definition (Real_Type_Declaration, Real_Type_Definition); - Set_Type_Declarator (Real_Type_Definition, Real_Type_Declaration); - Add_Decl (Real_Type_Declaration); - - Add_Implicit_Operations (Real_Type_Declaration); - - Real_Subtype_Definition := - Create_Std_Iir (Iir_Kind_Floating_Subtype_Definition); - Set_Base_Type (Real_Subtype_Definition, Real_Type_Definition); - Constraint := Create_Std_Range_Expr - (Create_Std_Fp (Iir_Fp64'First, Universal_Real_Type_Definition), - Create_Std_Fp (Iir_Fp64'Last, Universal_Real_Type_Definition), - Universal_Real_Type_Definition); - Set_Range_Constraint (Real_Subtype_Definition, Constraint); - Set_Type_Staticness (Real_Subtype_Definition, Locally); - Set_Signal_Type_Flag (Real_Subtype_Definition, True); - Set_Has_Signal_Flag (Real_Subtype_Definition, - not Flags.Flag_Whole_Analyze); - - Real_Subtype_Declaration := - Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Std_Identifier (Real_Subtype_Declaration, Name_Real); - Set_Type (Real_Subtype_Declaration, Real_Subtype_Definition); - Set_Subtype_Indication (Real_Subtype_Declaration, - Real_Subtype_Definition); - Set_Type_Declarator - (Real_Subtype_Definition, Real_Subtype_Declaration); - Add_Decl (Real_Subtype_Declaration); - - Set_Subtype_Definition - (Real_Type_Declaration, Real_Subtype_Definition); - end; - - -- time definition - declare - Time_Staticness : Iir_Staticness; - Last_Unit : Iir_Unit_Declaration; - use Iir_Chains.Unit_Chain_Handling; - - function Create_Std_Phys_Lit_Wo_Unit (Value : Iir_Int64; Unit : Iir) - return Iir_Physical_Int_Literal - is - Lit: Iir_Physical_Int_Literal; - begin - Lit := Create_Std_Iir (Iir_Kind_Physical_Int_Literal); - Set_Value (Lit, Value); - pragma Assert (Get_Kind (Unit) = Iir_Kind_Unit_Declaration); - Set_Physical_Unit (Lit, Unit); - Set_Type (Lit, Time_Type_Definition); - Set_Expr_Staticness (Lit, Time_Staticness); - return Lit; - end Create_Std_Phys_Lit_Wo_Unit; - - function Create_Std_Phys_Lit (Value : Iir_Int64; Unit : Iir) - return Iir_Physical_Int_Literal - is - Lit: Iir_Physical_Int_Literal; - Unit_Name : Iir; - begin - Lit := Create_Std_Phys_Lit_Wo_Unit (Value, Unit); - Unit_Name := Create_Std_Iir (Iir_Kind_Simple_Name); - Set_Identifier (Unit_Name, Get_Identifier (Unit)); - Set_Unit_Name (Lit, Unit_Name); - return Lit; - end Create_Std_Phys_Lit; - - procedure Create_Unit (Unit : out Iir_Unit_Declaration; - Multiplier_Value : Iir_Int64; - Multiplier : in Iir_Unit_Declaration; - Name : Name_Id) - is - Lit, Lit1 : Iir_Physical_Int_Literal; - begin - Unit := Create_Std_Decl (Iir_Kind_Unit_Declaration); - Set_Std_Identifier (Unit, Name); - Set_Type (Unit, Time_Type_Definition); - - Lit1 := Create_Std_Phys_Lit (Multiplier_Value, Multiplier); - Lit := Create_Std_Phys_Lit - (Multiplier_Value - * Get_Value (Get_Physical_Literal (Multiplier)), - Get_Physical_Unit (Get_Physical_Literal (Multiplier))); - Set_Literal_Origin (Lit, Lit1); - Set_Physical_Literal (Unit, Lit); - - Set_Expr_Staticness (Unit, Time_Staticness); - Set_Name_Staticness (Unit, Locally); - Append (Last_Unit, Time_Type_Definition, Unit); - end Create_Unit; - - Constraint : Iir_Range_Expression; - begin - if Vhdl_Std >= Vhdl_93c then - Time_Staticness := Globally; - else - Time_Staticness := Locally; - end if; - - Time_Type_Definition := - Create_Std_Iir (Iir_Kind_Physical_Type_Definition); - Set_Base_Type (Time_Type_Definition, Time_Type_Definition); - Set_Type_Staticness (Time_Type_Definition, Locally);--Time_Staticness - Set_Signal_Type_Flag (Time_Type_Definition, True); - Set_Has_Signal_Flag (Time_Type_Definition, - not Flags.Flag_Whole_Analyze); - Set_End_Has_Reserved_Id (Time_Type_Definition, True); - - Build_Init (Last_Unit); - - Time_Fs_Unit := Create_Std_Decl (Iir_Kind_Unit_Declaration); - Set_Std_Identifier (Time_Fs_Unit, Name_Fs); - Set_Type (Time_Fs_Unit, Time_Type_Definition); - Set_Expr_Staticness (Time_Fs_Unit, Time_Staticness); - Set_Name_Staticness (Time_Fs_Unit, Locally); - Set_Physical_Literal - (Time_Fs_Unit, Create_Std_Phys_Lit (1, Time_Fs_Unit)); - Append (Last_Unit, Time_Type_Definition, Time_Fs_Unit); - - Create_Unit (Time_Ps_Unit, 1000, Time_Fs_Unit, Name_Ps); - Create_Unit (Time_Ns_Unit, 1000, Time_Ps_Unit, Name_Ns); - Create_Unit (Time_Us_Unit, 1000, Time_Ns_Unit, Name_Us); - Create_Unit (Time_Ms_Unit, 1000, Time_Us_Unit, Name_Ms); - Create_Unit (Time_Sec_Unit, 1000, Time_Ms_Unit, Name_Sec); - Create_Unit (Time_Min_Unit, 60, Time_Sec_Unit, Name_Min); - Create_Unit (Time_Hr_Unit, 60, Time_Min_Unit, Name_Hr); - - -- type is - Time_Type_Declaration := - Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); - Set_Identifier (Time_Type_Declaration, Name_Time); - Set_Type_Definition (Time_Type_Declaration, Time_Type_Definition); - Set_Type_Declarator (Time_Type_Definition, Time_Type_Declaration); - Add_Decl (Time_Type_Declaration); - - Add_Implicit_Operations (Time_Type_Declaration); - - Time_Subtype_Definition := - Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition); - Constraint := Create_Std_Range_Expr - (Create_Std_Phys_Lit_Wo_Unit (Low_Bound (Flags.Flag_Time_64), - Time_Fs_Unit), - Create_Std_Phys_Lit_Wo_Unit (High_Bound (Flags.Flag_Time_64), - Time_Fs_Unit), - Time_Type_Definition); - Set_Range_Constraint (Time_Subtype_Definition, Constraint); - Set_Base_Type (Time_Subtype_Definition, Time_Type_Definition); - --Set_Subtype_Type_Mark (Time_Subtype_Definition, - -- Time_Type_Definition); - Set_Type_Staticness (Time_Subtype_Definition, Time_Staticness); - Set_Signal_Type_Flag (Time_Subtype_Definition, True); - Set_Has_Signal_Flag (Time_Subtype_Definition, - not Flags.Flag_Whole_Analyze); - - -- subtype time is - Time_Subtype_Declaration := - Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Std_Identifier (Time_Subtype_Declaration, Name_Time); - Set_Type (Time_Subtype_Declaration, Time_Subtype_Definition); - Set_Subtype_Indication (Time_Subtype_Declaration, - Time_Subtype_Definition); - Set_Type_Declarator (Time_Subtype_Definition, - Time_Subtype_Declaration); - Add_Decl (Time_Subtype_Declaration); - Set_Subtype_Definition - (Time_Type_Declaration, Time_Subtype_Definition); - - -- VHDL93 - -- subtype DELAY_LENGTH is TIME range 0 to TIME'HIGH - if Vhdl_Std >= Vhdl_93c then - Delay_Length_Subtype_Definition := - Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition); - Set_Subtype_Type_Mark - (Delay_Length_Subtype_Definition, - Create_Std_Type_Mark (Time_Subtype_Declaration)); - Constraint := Create_Std_Range_Expr - (Create_Std_Phys_Lit (0, Time_Fs_Unit), - Create_Std_Phys_Lit (High_Bound (Flags.Flag_Time_64), - Time_Fs_Unit), - Time_Type_Definition); - Set_Range_Constraint (Delay_Length_Subtype_Definition, Constraint); - Set_Base_Type - (Delay_Length_Subtype_Definition, Time_Type_Definition); - Set_Type_Staticness - (Delay_Length_Subtype_Definition, Time_Staticness); - Set_Signal_Type_Flag (Delay_Length_Subtype_Definition, True); - Set_Has_Signal_Flag (Delay_Length_Subtype_Definition, - not Flags.Flag_Whole_Analyze); - - -- subtype delay_length is ... - Delay_Length_Subtype_Declaration := - Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Std_Identifier (Delay_Length_Subtype_Declaration, - Name_Delay_Length); - Set_Type (Delay_Length_Subtype_Declaration, - Delay_Length_Subtype_Definition); - Set_Type_Declarator (Delay_Length_Subtype_Definition, - Delay_Length_Subtype_Declaration); - Set_Subtype_Indication (Delay_Length_Subtype_Declaration, - Delay_Length_Subtype_Definition); - Add_Decl (Delay_Length_Subtype_Declaration); - else - Delay_Length_Subtype_Definition := Null_Iir; - Delay_Length_Subtype_Declaration := Null_Iir; - end if; - end; - - -- VHDL87: - -- function NOW return TIME - -- - -- impure function NOW return DELAY_LENGTH. - declare - Function_Now : Iir_Function_Declaration; - begin - Function_Now := Create_Std_Decl (Iir_Kind_Function_Declaration); - Set_Std_Identifier (Function_Now, Std_Names.Name_Now); - if Vhdl_Std = Vhdl_87 then - Set_Return_Type (Function_Now, Time_Subtype_Definition); - else - Set_Return_Type (Function_Now, Delay_Length_Subtype_Definition); - end if; - if Vhdl_Std = Vhdl_02 then - Set_Pure_Flag (Function_Now, True); - else - Set_Pure_Flag (Function_Now, False); - end if; - Set_Implicit_Definition (Function_Now, Iir_Predefined_Now_Function); - Vhdl.Sem_Utils.Compute_Subprogram_Hash (Function_Now); - Add_Decl (Function_Now); - end; - - -- natural subtype - declare - Constraint : Iir_Range_Expression; - begin - Natural_Subtype_Definition := - Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition); - Set_Base_Type (Natural_Subtype_Definition, Integer_Type_Definition); - Set_Subtype_Type_Mark - (Natural_Subtype_Definition, - Create_Std_Type_Mark (Integer_Subtype_Declaration)); - Constraint := Create_Std_Range_Expr - (Create_Std_Integer (0, Integer_Type_Definition), - Create_Std_Integer (High_Bound (Flags.Flag_Integer_64), - Integer_Type_Definition), - Integer_Type_Definition); - Set_Range_Constraint (Natural_Subtype_Definition, Constraint); - Set_Type_Staticness (Natural_Subtype_Definition, Locally); - Set_Signal_Type_Flag (Natural_Subtype_Definition, True); - Set_Has_Signal_Flag (Natural_Subtype_Definition, - not Flags.Flag_Whole_Analyze); - - Natural_Subtype_Declaration := - Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Std_Identifier (Natural_Subtype_Declaration, Name_Natural); - Set_Type (Natural_Subtype_Declaration, Natural_Subtype_Definition); - Set_Subtype_Indication (Natural_Subtype_Declaration, - Natural_Subtype_Definition); - Add_Decl (Natural_Subtype_Declaration); - Set_Type_Declarator (Natural_Subtype_Definition, - Natural_Subtype_Declaration); - end; - - -- positive subtype - declare - Constraint : Iir_Range_Expression; - begin - Positive_Subtype_Definition := - Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition); - Set_Base_Type (Positive_Subtype_Definition, - Integer_Type_Definition); - Set_Subtype_Type_Mark - (Positive_Subtype_Definition, - Create_Std_Type_Mark (Integer_Subtype_Declaration)); - Constraint := Create_Std_Range_Expr - (Create_Std_Integer (1, Integer_Type_Definition), - Create_Std_Integer (High_Bound (Flags.Flag_Integer_64), - Integer_Type_Definition), - Integer_Type_Definition); - Set_Range_Constraint (Positive_Subtype_Definition, Constraint); - Set_Type_Staticness (Positive_Subtype_Definition, Locally); - Set_Signal_Type_Flag (Positive_Subtype_Definition, True); - Set_Has_Signal_Flag (Positive_Subtype_Definition, - not Flags.Flag_Whole_Analyze); - - Positive_Subtype_Declaration := - Create_Std_Decl (Iir_Kind_Subtype_Declaration); - Set_Std_Identifier (Positive_Subtype_Declaration, Name_Positive); - Set_Type (Positive_Subtype_Declaration, Positive_Subtype_Definition); - Set_Subtype_Indication (Positive_Subtype_Declaration, - Positive_Subtype_Definition); - Add_Decl (Positive_Subtype_Declaration); - Set_Type_Declarator (Positive_Subtype_Definition, - Positive_Subtype_Declaration); - end; - - -- string type. - -- type string is array (positive range <>) of character; - declare - Element : Iir; - Index_List : Iir_Flist; - begin - Element := Create_Std_Type_Mark (Character_Type_Declaration); - - String_Type_Definition := - Create_Std_Iir (Iir_Kind_Array_Type_Definition); - Set_Base_Type (String_Type_Definition, String_Type_Definition); - Index_List := Create_Iir_Flist (1); - Set_Nth_Element (Index_List, 0, - Create_Std_Type_Mark (Positive_Subtype_Declaration)); - Set_Index_Subtype_Definition_List (String_Type_Definition, - Index_List); - Set_Index_Subtype_List (String_Type_Definition, Index_List); - Set_Element_Subtype_Indication (String_Type_Definition, Element); - Set_Element_Subtype (String_Type_Definition, - Character_Type_Definition); - Set_Type_Staticness (String_Type_Definition, None); - Set_Signal_Type_Flag (String_Type_Definition, True); - Set_Has_Signal_Flag (String_Type_Definition, - not Flags.Flag_Whole_Analyze); - - Create_Std_Type - (String_Type_Declaration, String_Type_Definition, Name_String); - - Add_Implicit_Operations (String_Type_Declaration); - end; - - if Vhdl_Std >= Vhdl_08 then - -- type Boolean_Vector is array (Natural range <>) of Boolean; - Create_Array_Type - (Boolean_Vector_Type_Definition, Boolean_Vector_Type_Declaration, - Boolean_Type_Declaration, Name_Boolean_Vector); - end if; - - -- bit_vector type. - -- type bit_vector is array (natural range <>) of bit; - Create_Array_Type - (Bit_Vector_Type_Definition, Bit_Vector_Type_Declaration, - Bit_Type_Declaration, Name_Bit_Vector); - - -- LRM08 5.3.2.4 Predefined operations on array types - -- The following operations are implicitly declared in package - -- STD.STANDARD immediately following the declaration of type - -- BIT_VECTOR: - if Vhdl_Std >= Vhdl_08 then - Create_To_String (Bit_Vector_Type_Definition, - Iir_Predefined_Bit_Vector_To_Ostring, - Name_To_Ostring); - Create_To_String (Bit_Vector_Type_Definition, - Iir_Predefined_Bit_Vector_To_Hstring, - Name_To_Hstring); - end if; - - -- VHDL 2008 - -- Vector types - if Vhdl_Std >= Vhdl_08 then - -- type integer_vector is array (natural range <>) of Integer; - Create_Array_Type - (Integer_Vector_Type_Definition, Integer_Vector_Type_Declaration, - Integer_Subtype_Declaration, Name_Integer_Vector); - - -- type Real_vector is array (natural range <>) of Real; - Create_Array_Type - (Real_Vector_Type_Definition, Real_Vector_Type_Declaration, - Real_Subtype_Declaration, Name_Real_Vector); - - -- type Time_vector is array (natural range <>) of Time; - Create_Array_Type - (Time_Vector_Type_Definition, Time_Vector_Type_Declaration, - Time_Subtype_Declaration, Name_Time_Vector); - end if; - - -- VHDL93: - -- type file_open_kind is (read_mode, write_mode, append_mode); - if Vhdl_Std >= Vhdl_93c then - File_Open_Kind_Type_Definition := - Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); - Set_Base_Type (File_Open_Kind_Type_Definition, - File_Open_Kind_Type_Definition); - Set_Enumeration_Literal_List - (File_Open_Kind_Type_Definition, Create_Iir_Flist (3)); - - File_Open_Kind_Read_Mode := Create_Std_Literal - (Name_Read_Mode, 0, File_Open_Kind_Type_Definition); - File_Open_Kind_Write_Mode := Create_Std_Literal - (Name_Write_Mode, 1, File_Open_Kind_Type_Definition); - File_Open_Kind_Append_Mode := Create_Std_Literal - (Name_Append_Mode, 2, File_Open_Kind_Type_Definition); - Set_Type_Staticness (File_Open_Kind_Type_Definition, Locally); - Set_Signal_Type_Flag (File_Open_Kind_Type_Definition, True); - Set_Has_Signal_Flag (File_Open_Kind_Type_Definition, - not Flags.Flag_Whole_Analyze); - - -- type file_open_kind is - Create_Std_Type - (File_Open_Kind_Type_Declaration, File_Open_Kind_Type_Definition, - Name_File_Open_Kind); - - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type - (File_Open_Kind_Type_Definition); - Add_Implicit_Operations (File_Open_Kind_Type_Declaration); - else - File_Open_Kind_Type_Declaration := Null_Iir; - File_Open_Kind_Type_Definition := Null_Iir; - File_Open_Kind_Read_Mode := Null_Iir; - File_Open_Kind_Write_Mode := Null_Iir; - File_Open_Kind_Append_Mode := Null_Iir; - end if; - - -- VHDL93: - -- type file_open_status is - -- (open_ok, status_error, name_error, mode_error); - if Vhdl_Std >= Vhdl_93c then - File_Open_Status_Type_Definition := - Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); - Set_Base_Type (File_Open_Status_Type_Definition, - File_Open_Status_Type_Definition); - Set_Enumeration_Literal_List - (File_Open_Status_Type_Definition, Create_Iir_Flist (4)); - - File_Open_Status_Open_Ok := Create_Std_Literal - (Name_Open_Ok, 0, File_Open_Status_Type_Definition); - File_Open_Status_Status_Error := Create_Std_Literal - (Name_Status_Error, 1, File_Open_Status_Type_Definition); - File_Open_Status_Name_Error := Create_Std_Literal - (Name_Name_Error, 2, File_Open_Status_Type_Definition); - File_Open_Status_Mode_Error := Create_Std_Literal - (Name_Mode_Error, 3, File_Open_Status_Type_Definition); - Set_Type_Staticness (File_Open_Status_Type_Definition, Locally); - Set_Signal_Type_Flag (File_Open_Status_Type_Definition, True); - Set_Has_Signal_Flag (File_Open_Status_Type_Definition, - not Flags.Flag_Whole_Analyze); - - -- type file_open_kind is - Create_Std_Type (File_Open_Status_Type_Declaration, - File_Open_Status_Type_Definition, - Name_File_Open_Status); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type - (File_Open_Status_Type_Definition); - Add_Implicit_Operations (File_Open_Status_Type_Declaration); - else - File_Open_Status_Type_Declaration := Null_Iir; - File_Open_Status_Type_Definition := Null_Iir; - File_Open_Status_Open_Ok := Null_Iir; - File_Open_Status_Status_Error := Null_Iir; - File_Open_Status_Name_Error := Null_Iir; - File_Open_Status_Mode_Error := Null_Iir; - end if; - - -- VHDL93: - -- attribute FOREIGN: string; - if Vhdl_Std >= Vhdl_93c then - Foreign_Attribute := Create_Std_Decl (Iir_Kind_Attribute_Declaration); - Set_Std_Identifier (Foreign_Attribute, Name_Foreign); - Set_Type_Mark (Foreign_Attribute, - Create_Std_Type_Mark (String_Type_Declaration)); - Set_Type (Foreign_Attribute, String_Type_Definition); - Add_Decl (Foreign_Attribute); - else - Foreign_Attribute := Null_Iir; - end if; - - if Vhdl_Std >= Vhdl_08 then - Create_To_String (Boolean_Type_Definition, - Iir_Predefined_Enum_To_String); - Create_To_String (Bit_Type_Definition, - Iir_Predefined_Enum_To_String); - Create_To_String (Character_Type_Definition, - Iir_Predefined_Enum_To_String); - Create_To_String (Severity_Level_Type_Definition, - Iir_Predefined_Enum_To_String); - Create_To_String (Universal_Integer_Type_Definition, - Iir_Predefined_Integer_To_String); - Create_To_String (Universal_Real_Type_Definition, - Iir_Predefined_Floating_To_String); - Create_To_String (Integer_Type_Definition, - Iir_Predefined_Integer_To_String); - Create_To_String (Real_Type_Definition, - Iir_Predefined_Floating_To_String); - Create_To_String (Time_Type_Definition, - Iir_Predefined_Physical_To_String); - Create_To_String (File_Open_Kind_Type_Definition, - Iir_Predefined_Enum_To_String); - Create_To_String (File_Open_Status_Type_Definition, - Iir_Predefined_Enum_To_String); - - -- Predefined overload TO_STRING operations - Create_To_String (Real_Type_Definition, - Iir_Predefined_Real_To_String_Digits, - Name_To_String, - Name_Digits, - Natural_Subtype_Definition); - Create_To_String (Real_Type_Definition, - Iir_Predefined_Real_To_String_Format, - Name_To_String, - Name_Format, - String_Type_Definition); - Create_To_String (Time_Type_Definition, - Iir_Predefined_Time_To_String_Unit, - Name_To_String, - Name_Unit, - Time_Subtype_Definition); - end if; - - -- Wilcard types. - -- Create the declaration and give them meaningful (and invalid) names - -- so that error messages are clear for the user. - Wildcard_Type_Declaration_Chain := Null_Iir; - Create_Wildcard_Type (Wildcard_Any_Type, "any type"); - Create_Wildcard_Type (Wildcard_Any_Aggregate_Type, "any aggregate type"); - Create_Wildcard_Type (Wildcard_Any_String_Type, "any string type"); - Create_Wildcard_Type (Wildcard_Any_Access_Type, "any access type"); - - Error_Type := Iirs_Utils.Create_Error_Type (Wildcard_Any_Type); - Set_Error_Origin (Error_Type, Null_Iir); - Create_Wildcard_Type (Error_Type, "unknown type"); - end Create_Std_Standard_Package; - - procedure Set_Time_Resolution (Resolution : Character) - is - Unit : Iir; - Prim : Iir; - Rng : Iir; - begin - case Resolution is - when 'f' => - Prim := Time_Fs_Unit; - when 'p' => - Prim := Time_Ps_Unit; - when 'n' => - Prim := Time_Ns_Unit; - when 'u' => - Prim := Time_Us_Unit; - when 'm' => - Prim := Time_Ms_Unit; - when 's' => - Prim := Time_Sec_Unit; - when 'M' => - Prim := Time_Min_Unit; - when 'h' => - Prim := Time_Hr_Unit; - when others => - raise Internal_Error; - end case; - - -- Adjust range of TIME subtype. - Rng := Get_Range_Constraint (Time_Subtype_Definition); - Set_Physical_Unit (Get_Left_Limit (Rng), Prim); - Set_Physical_Unit (Get_Right_Limit (Rng), Prim); - - -- Adjust range of DELAY_LENGTH. - if Vhdl_Std >= Vhdl_93c then - Rng := Get_Range_Constraint (Delay_Length_Subtype_Definition); - Set_Physical_Unit (Get_Left_Limit (Rng), Prim); - Set_Physical_Unit (Get_Right_Limit (Rng), Prim); - end if; - - Unit := Get_Unit_Chain (Time_Type_Definition); - while Unit /= Null_Iir loop - declare - Lit : constant Iir := Get_Physical_Literal (Unit); - Orig : constant Iir := Get_Literal_Origin (Lit); - Lit_Unit : Iir; - begin - if Prim = Null_Iir then - -- Primary already set, just recompute values. - Lit_Unit := Get_Physical_Literal (Get_Physical_Unit (Orig)); - Set_Value (Lit, Get_Value (Orig) * Get_Value (Lit_Unit)); - elsif Unit = Prim then - Set_Value (Lit, 1); - Prim := Null_Iir; - else - Set_Value (Lit, 0); - end if; - end; - Unit := Get_Chain (Unit); - end loop; - end Set_Time_Resolution; - - function Get_Minimal_Time_Resolution return Character is - begin - if Get_Use_Flag (Time_Fs_Unit) then - return 'f'; - end if; - if Get_Use_Flag (Time_Ps_Unit) then - return 'p'; - end if; - if Get_Use_Flag (Time_Ns_Unit) then - return 'n'; - end if; - if Get_Use_Flag (Time_Us_Unit) then - return 'u'; - end if; - if Get_Use_Flag (Time_Ms_Unit) then - return 'm'; - end if; - if Get_Use_Flag (Time_Sec_Unit) then - return 's'; - end if; - if Get_Use_Flag (Time_Min_Unit) then - return 'M'; - end if; - if Get_Use_Flag (Time_Hr_Unit) then - return 'h'; - end if; - return '?'; - end Get_Minimal_Time_Resolution; -end Std_Package; diff --git a/src/vhdl/std_package.ads b/src/vhdl/std_package.ads deleted file mode 100644 index f8830ae2e..000000000 --- a/src/vhdl/std_package.ads +++ /dev/null @@ -1,202 +0,0 @@ --- std.standard package declarations. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; - -package Std_Package is - - -- This is a special node, not really declared in the STANDARD package, - -- used to mark a node as erroneous. - -- Its kind is Iir_Kind_Error. - Error_Mark : constant Iir; - - -- Virtual file and location for the standard package. - Std_Source_File : Source_File_Entry := No_Source_File_Entry; - Std_Location: Location_Type := Location_Nil; - - -- Some well know values declared in the STANDARD package. - -- These values (except time_base) *must* not be modified, and are set by - -- create_std_standard_package. - - Std_Standard_File: Iir_Design_File := Null_Iir; - Std_Standard_Unit : Iir_Design_Unit := Null_Iir; - Standard_Package : Iir_Package_Declaration := Null_Iir; - - -- Boolean values. - Boolean_Type_Declaration : Iir_Type_Declaration := Null_Iir; - Boolean_Type_Definition : Iir_Enumeration_Type_Definition; - Boolean_False : Iir_Enumeration_Literal; - Boolean_True : Iir_Enumeration_Literal; - - -- Bit values. - Bit_Type_Declaration : Iir_Type_Declaration := Null_Iir; - Bit_Type_Definition : Iir_Enumeration_Type_Definition; - Bit_0 : Iir_Enumeration_Literal; - Bit_1 : Iir_Enumeration_Literal; - - -- Predefined character. - Character_Type_Declaration : Iir_Type_Declaration; - Character_Type_Definition : Iir_Enumeration_Type_Definition; - - -- severity level. - Severity_Level_Type_Declaration : Iir_Type_Declaration; - Severity_Level_Type_Definition : Iir_Enumeration_Type_Definition; - Severity_Level_Note : Iir_Enumeration_Literal; - Severity_Level_Warning : Iir_Enumeration_Literal; - Severity_Level_Error : Iir_Enumeration_Literal; - Severity_Level_Failure : Iir_Enumeration_Literal; - - -- Universal types. - Universal_Integer_Type_Declaration : Iir_Anonymous_Type_Declaration; - Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition; - Universal_Integer_Subtype_Declaration : Iir_Subtype_Declaration; - Universal_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition; - - Universal_Integer_One : Iir_Integer_Literal; - - Universal_Real_Type_Declaration : Iir_Anonymous_Type_Declaration; - Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition; - Universal_Real_Subtype_Declaration : Iir_Subtype_Declaration; - Universal_Real_Subtype_Definition : Iir_Floating_Subtype_Definition; - - -- Predefined integer type. - Integer_Type_Declaration : Iir_Anonymous_Type_Declaration; - Integer_Type_Definition : Iir_Integer_Type_Definition; - Integer_Subtype_Declaration : Iir_Subtype_Declaration; - Integer_Subtype_Definition : Iir_Integer_Subtype_Definition; - - -- Type used when the type of an expression is incorrect. - Error_Type : Iir; - - -- Predefined real type. - Real_Type_Declaration : Iir_Anonymous_Type_Declaration; - Real_Type_Definition : Iir_Floating_Type_Definition; - Real_Subtype_Declaration : Iir_Subtype_Declaration; - Real_Subtype_Definition : Iir_Floating_Subtype_Definition; - - -- Predefined natural subtype. - Natural_Subtype_Declaration : Iir_Subtype_Declaration; - Natural_Subtype_Definition : Iir_Integer_Subtype_Definition; - - -- Predefined positive subtype. - Positive_Subtype_Declaration : Iir_Subtype_Declaration; - Positive_Subtype_Definition : Iir_Integer_Subtype_Definition; - - -- Predefined positive subtype. - String_Type_Declaration : Iir_Type_Declaration; - String_Type_Definition : Iir_Array_Type_Definition; - - -- Predefined positive subtype. - Bit_Vector_Type_Declaration : Iir_Type_Declaration; - Bit_Vector_Type_Definition : Iir_Array_Type_Definition; - - -- predefined time subtype - Time_Type_Declaration : Iir_Anonymous_Type_Declaration; - Time_Type_Definition: Iir_Physical_Type_Definition; - Time_Subtype_Definition: Iir_Physical_Subtype_Definition; - Time_Subtype_Declaration : Iir_Subtype_Declaration; - - -- For VHDL-93 - Delay_Length_Subtype_Definition : Iir_Physical_Subtype_Definition; - Delay_Length_Subtype_Declaration : Iir_Subtype_Declaration; - - -- For VHDL-93: - -- type File_Open_Kind - File_Open_Kind_Type_Declaration : Iir_Type_Declaration; - File_Open_Kind_Type_Definition : Iir_Enumeration_Type_Definition; - File_Open_Kind_Read_Mode : Iir_Enumeration_Literal; - File_Open_Kind_Write_Mode : Iir_Enumeration_Literal; - File_Open_Kind_Append_Mode : Iir_Enumeration_Literal; - - -- For VHDL-93: - -- type File_Open_Status - File_Open_Status_Type_Declaration : Iir_Type_Declaration; - File_Open_Status_Type_Definition : Iir_Enumeration_Type_Definition; - File_Open_Status_Open_Ok : Iir_Enumeration_Literal; - File_Open_Status_Status_Error : Iir_Enumeration_Literal; - File_Open_Status_Name_Error : Iir_Enumeration_Literal; - File_Open_Status_Mode_Error : Iir_Enumeration_Literal; - - -- For VHDL-93: - -- atribute foreign : string; - Foreign_Attribute : Iir_Attribute_Declaration; - - -- For VHDL-08 - Boolean_Vector_Type_Definition : Iir_Array_Type_Definition; - Boolean_Vector_Type_Declaration : Iir_Type_Declaration; - - Integer_Vector_Type_Definition : Iir_Array_Type_Definition; - Integer_Vector_Type_Declaration : Iir_Type_Declaration; - - Real_Vector_Type_Definition : Iir_Array_Type_Definition; - Real_Vector_Type_Declaration : Iir_Type_Declaration; - - Time_Vector_Type_Definition : Iir_Array_Type_Definition; - Time_Vector_Type_Declaration : Iir_Type_Declaration; - - -- Internal use only. - -- These types should be considered like universal types, but - -- furthermore, they can be converted to any integer/real types while - -- universal cannot. - Convertible_Integer_Type_Definition : constant Iir_Integer_Type_Definition; - Convertible_Real_Type_Definition : constant Iir_Floating_Type_Definition; - Convertible_Integer_Type_Declaration : Iir_Anonymous_Type_Declaration; - Convertible_Real_Type_Declaration : Iir_Anonymous_Type_Declaration; - - Convertible_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition; - Convertible_Integer_Subtype_Declaration : Iir_Subtype_Declaration; - - -- Wilcard types. - -- Err, we break privacy for iir numbers, but this allow use of them in - -- case statements. - Wildcard_Any_Type : constant Iir := 7; - Wildcard_Any_Aggregate_Type : constant Iir := 8; - Wildcard_Any_String_Type : constant Iir := 9; - Wildcard_Any_Access_Type : constant Iir := 10; - - -- Subtype for all wildcard types, so that missing choice can be detected - -- at compilation time. - subtype Iir_Wildcard_Types is Iir range 7 .. 10; - - -- Chain of wildcard declarations, to own the nodes. - Wildcard_Type_Declaration_Chain : Iir; - - -- Create the first well-known nodes. - procedure Create_First_Nodes; - - -- Create the node for the standard package. - procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration); - - procedure Set_Time_Resolution (Resolution : Character); - - -- Return the minimal time resolution according to use of time units. - function Get_Minimal_Time_Resolution return Character; -private - -- For speed reasons, some often used nodes are hard-coded. - Error_Mark : constant Iir := 2; - Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition - := 3; - Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition - := 4; - - Convertible_Integer_Type_Definition : constant Iir_Integer_Type_Definition - := 5; - Convertible_Real_Type_Definition : constant Iir_Floating_Type_Definition - := 6; -end Std_Package; diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index 00e071010..f739edb53 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -18,7 +18,7 @@ with Vhdl.Configuration; with Errorout; use Errorout; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Iirs_Utils; use Iirs_Utils; with Libraries; with Flags; diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb index 18c574578..b8e8f71fe 100644 --- a/src/vhdl/translate/trans-chap14.adb +++ b/src/vhdl/translate/trans-chap14.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Evaluation; use Evaluation; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; with Trans_Decls; use Trans_Decls; diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 433d18443..41620bbfd 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Std_Names; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; with Vhdl.Sem_Inst; with Nodes_Meta; diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 0c44b8af6..01a198563 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -19,7 +19,7 @@ with Errorout; use Errorout; with Files_Map; with Iirs_Utils; use Iirs_Utils; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Canon; with Translation; use Translation; with Trans.Chap2; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 29707e256..a9838e769 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -21,7 +21,7 @@ with Name_Table; with Str_Table; with Iirs_Utils; use Iirs_Utils; with Iir_Chains; use Iir_Chains; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; with Flags; use Flags; with Vhdl.Canon; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 815748f35..f78a3d45a 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -22,7 +22,7 @@ with Errorout; use Errorout; with Iir_Chains; with Vhdl.Canon; with Evaluation; use Evaluation; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Iirs_Utils; use Iirs_Utils; with Trans.Chap2; with Trans.Chap3; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index c0b935fa3..0bf153ebf 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -18,7 +18,7 @@ with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Flags; with Libraries; with Vhdl.Canon; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 4c5ba5eca..c1cb1e0a4 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -25,7 +25,7 @@ with Name_Table; -- use Name_Table; with Str_Table; with Files_Map; with Iirs_Utils; use Iirs_Utils; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Sem_Specs; with Libraries; with Std_Names; diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index 8d06a3a73..0c688a083 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -18,7 +18,7 @@ with Libraries; with Errorout; use Errorout; -with Std_Package; +with Vhdl.Std_Package; with Name_Table; use Name_Table; with Flags; with Iirs_Utils; use Iirs_Utils; @@ -675,8 +675,8 @@ package body Vhdl.Configuration is end case; -- Exclude std.standard - Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); - Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Mark_Flag (Vhdl.Std_Package.Std_Standard_Unit, True); + Set_Configuration_Done_Flag (Vhdl.Std_Package.Std_Standard_Unit, True); Add_Design_Unit (Top, Null_Iir); return Top; diff --git a/src/vhdl/vhdl-disp_vhdl.adb b/src/vhdl/vhdl-disp_vhdl.adb index f905a171a..acf7f0c5f 100644 --- a/src/vhdl/vhdl-disp_vhdl.adb +++ b/src/vhdl/vhdl-disp_vhdl.adb @@ -21,7 +21,7 @@ -- input file. If parenthesis are kept by the parser, the only differences -- are comments and layout. with GNAT.OS_Lib; -with Std_Package; +with Vhdl.Std_Package; with Flags; use Flags; with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; @@ -442,10 +442,10 @@ package body Vhdl.Disp_Vhdl is Base_Type: Iir_Integer_Type_Definition; Decl: Iir; begin - if Def /= Std_Package.Universal_Integer_Subtype_Definition then + if Def /= Vhdl.Std_Package.Universal_Integer_Subtype_Definition then Base_Type := Get_Base_Type (Def); Decl := Get_Type_Declarator (Base_Type); - if Base_Type /= Std_Package.Universal_Integer_Subtype_Definition + if Base_Type /= Vhdl.Std_Package.Universal_Integer_Subtype_Definition and then Def /= Decl then Disp_Name_Of (Decl); @@ -464,10 +464,10 @@ package body Vhdl.Disp_Vhdl is Base_Type: Iir_Floating_Type_Definition; Decl: Iir; begin - if Def /= Std_Package.Universal_Real_Subtype_Definition then + if Def /= Vhdl.Std_Package.Universal_Real_Subtype_Definition then Base_Type := Get_Base_Type (Def); Decl := Get_Type_Declarator (Base_Type); - if Base_Type /= Std_Package.Universal_Real_Subtype_Definition + if Base_Type /= Vhdl.Std_Package.Universal_Real_Subtype_Definition and then Def /= Decl then Disp_Name_Of (Decl); @@ -2683,7 +2683,7 @@ package body Vhdl.Disp_Vhdl is Put (Name); Param := Get_Parameter (Expr); if Param /= Null_Iir - and then Param /= Std_Package.Universal_Integer_One + and then Param /= Vhdl.Std_Package.Universal_Integer_One then Put (" ("); Disp_Expression (Param); diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index b1875bc1e..878713ce6 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Errorout; use Errorout; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Ieee.Std_Logic_1164; with Libraries; with Std_Names; diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index 146b582bc..403f720ef 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -25,7 +25,7 @@ with Std_Names; with Vhdl.Sem_Names; use Vhdl.Sem_Names; with Vhdl.Sem_Types; with Vhdl.Sem_Decls; -with Std_Package; +with Vhdl.Std_Package; with Vhdl.Sem_Scopes; with Iir_Chains; use Iir_Chains; with Xrefs; @@ -1499,7 +1499,7 @@ package body Vhdl.Sem_Assocs is end if; -- That returns a boolean. if (Get_Base_Type (Get_Return_Type (Decl)) - /= Std_Package.Boolean_Type_Definition) + /= Vhdl.Std_Package.Boolean_Type_Definition) then return False; end if; diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index f8e380c95..f67fcd96c 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -20,7 +20,7 @@ with Types; use Types; with Std_Names; with Vhdl.Tokens; with Flags; use Flags; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Evaluation; use Evaluation; with Iirs_Utils; use Iirs_Utils; with Vhdl.Sem; use Vhdl.Sem; diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 9ac79c601..cd9f9a2d5 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Grt.Algos; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; with Flags; use Flags; with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes; diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index d72af8c28..3f49ae99a 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -20,7 +20,7 @@ with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; with Flags; use Flags; with Name_Table; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Types; use Types; with Iir_Chains; use Iir_Chains; with Std_Names; diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index 41a2e74d9..a528da0be 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -28,7 +28,7 @@ with Vhdl.Sem_Names; with Std_Names; with Iirs_Utils; use Iirs_Utils; with Evaluation; use Evaluation; -with Std_Package; +with Vhdl.Std_Package; with Ieee.Std_Logic_1164; with Errorout; use Errorout; with Xrefs; use Xrefs; @@ -46,8 +46,8 @@ package body Vhdl.Sem_Psl is return False; end if; Btype := Get_Base_Type (Atype); - return Btype = Std_Package.Boolean_Type_Definition - or else Btype = Std_Package.Bit_Type_Definition + return Btype = Vhdl.Std_Package.Boolean_Type_Definition + or else Btype = Vhdl.Std_Package.Bit_Type_Definition or else Btype = Ieee.Std_Logic_1164.Std_Ulogic_Type; end Is_Psl_Bool_Type; @@ -544,7 +544,7 @@ package body Vhdl.Sem_Psl is -- Endpoints are considered as an HDL declaration and must have a -- type. - Set_Type (Stmt, Std_Package.Boolean_Type_Definition); + Set_Type (Stmt, Vhdl.Std_Package.Boolean_Type_Definition); Set_Expr_Staticness (Stmt, None); Set_Visible_Flag (Stmt, True); @@ -600,7 +600,7 @@ package body Vhdl.Sem_Psl is if Get_Type (Cond) = Null_Iir then Cond := Sem_Expr.Sem_Condition (Cond); elsif Get_Base_Type (Get_Type (Cond)) - /= Std_Package.Boolean_Type_Definition + /= Vhdl.Std_Package.Boolean_Type_Definition then Cond := Sem_Expr.Insert_Condition_Operator (Cond); end if; diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index bd21e7e47..3ed4ec571 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -19,7 +19,7 @@ with Iirs_Utils; use Iirs_Utils; with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; with Vhdl.Sem_Names; use Vhdl.Sem_Names; with Evaluation; use Evaluation; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; with Vhdl.Sem; use Vhdl.Sem; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index 9a616896a..c79f69496 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -19,7 +19,7 @@ with Errorout; use Errorout; with Types; use Types; with Flags; use Flags; with Vhdl.Sem_Specs; use Vhdl.Sem_Specs; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Sem; use Vhdl.Sem; with Vhdl.Sem_Decls; use Vhdl.Sem_Decls; with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb index 20651c000..f56ba309b 100644 --- a/src/vhdl/vhdl-sem_types.adb +++ b/src/vhdl/vhdl-sem_types.adb @@ -29,7 +29,7 @@ with Vhdl.Sem_Inst; with Name_Table; with Std_Names; with Iirs_Utils; use Iirs_Utils; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; with Ieee.Std_Logic_1164; with Xrefs; use Xrefs; diff --git a/src/vhdl/vhdl-sem_utils.adb b/src/vhdl/vhdl-sem_utils.adb index 06dfa5a50..a82628dde 100644 --- a/src/vhdl/vhdl-sem_utils.adb +++ b/src/vhdl/vhdl-sem_utils.adb @@ -23,7 +23,7 @@ with Iirs_Utils; use Iirs_Utils; with Iir_Chains; use Iir_Chains; with Ieee.Std_Logic_1164; with Std_Names; -with Std_Package; use Std_Package; +with Vhdl.Std_Package; use Vhdl.Std_Package; package body Vhdl.Sem_Utils is procedure Compute_Subprogram_Hash (Subprg : Iir) diff --git a/src/vhdl/vhdl-std_package.adb b/src/vhdl/vhdl-std_package.adb new file mode 100644 index 000000000..78a614afd --- /dev/null +++ b/src/vhdl/vhdl-std_package.adb @@ -0,0 +1,1363 @@ +-- std.standard package declarations. +-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Files_Map; +with Name_Table; +with Str_Table; +with Std_Names; use Std_Names; +with Flags; use Flags; +with Iirs_Utils; +with Vhdl.Sem_Utils; +with Iir_Chains; + +package body Vhdl.Std_Package is + type Bound_Array is array (Boolean) of Iir_Int64; + Low_Bound : constant Bound_Array := (False => -(2 ** 31), + True => -(2 ** 63)); + High_Bound : constant Bound_Array := (False => (2 ** 31) - 1, + True => (2 ** 63) - 1); + + Std_Filename : Name_Id := Null_Identifier; + + -- Could be public. + Time_Fs_Unit: Iir_Unit_Declaration; + Time_Ps_Unit: Iir_Unit_Declaration; + Time_Ns_Unit: Iir_Unit_Declaration; + Time_Us_Unit: Iir_Unit_Declaration; + Time_Ms_Unit: Iir_Unit_Declaration; + Time_Sec_Unit: Iir_Unit_Declaration; + Time_Min_Unit: Iir_Unit_Declaration; + Time_Hr_Unit: Iir_Unit_Declaration; + + function Create_Std_Iir (Kind : Iir_Kind) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Kind); + Set_Location (Res, Std_Location); + return Res; + end Create_Std_Iir; + + function Create_Std_Decl (Kind : Iir_Kind) return Iir + is + Res : Iir; + begin + Res := Create_Std_Iir (Kind); + Set_Parent (Res, Standard_Package); + return Res; + end Create_Std_Decl; + + function Create_Std_Type_Mark (Ref : Iir) return Iir + is + Res : Iir; + begin + Res := Iirs_Utils.Build_Simple_Name (Ref, Std_Location); + Set_Type (Res, Get_Type (Ref)); + return Res; + end Create_Std_Type_Mark; + + procedure Create_First_Nodes + is + procedure Create_Known_Iir (Kind : Iir_Kind; Val : Iir) is + begin + if Create_Std_Iir (Kind) /= Val then + raise Internal_Error; + end if; + end Create_Known_Iir; + begin + Std_Filename := Name_Table.Get_Identifier ("*std_standard*"); + Std_Source_File := Files_Map.Create_Virtual_Source_File (Std_Filename); + Std_Location := Files_Map.File_To_Location (Std_Source_File); + + if Create_Iir_Error /= Error_Mark then + raise Internal_Error; + end if; + Set_Location (Error_Mark, Std_Location); + + Create_Known_Iir (Iir_Kind_Integer_Type_Definition, + Universal_Integer_Type_Definition); + Create_Known_Iir (Iir_Kind_Floating_Type_Definition, + Universal_Real_Type_Definition); + + Create_Known_Iir (Iir_Kind_Integer_Type_Definition, + Convertible_Integer_Type_Definition); + Create_Known_Iir (Iir_Kind_Floating_Type_Definition, + Convertible_Real_Type_Definition); + + Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, + Wildcard_Any_Type); + Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, + Wildcard_Any_Aggregate_Type); + Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, + Wildcard_Any_String_Type); + Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition, + Wildcard_Any_Access_Type); + end Create_First_Nodes; + + procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration) + is + function Get_Std_Character (Char: Character) return Name_Id + renames Name_Table.Get_Identifier; + + procedure Set_Std_Identifier (Decl : Iir; Name : Name_Id) is + begin + Set_Identifier (Decl, Name); + Set_Visible_Flag (Decl, True); + end Set_Std_Identifier; + + function Create_Std_Integer (Val : Iir_Int64; Lit_Type : Iir) + return Iir_Integer_Literal + is + Res : Iir_Integer_Literal; + begin + Res := Create_Std_Iir (Iir_Kind_Integer_Literal); + Set_Value (Res, Val); + Set_Type (Res, Lit_Type); + Set_Expr_Staticness (Res, Locally); + return Res; + end Create_Std_Integer; + + function Create_Std_Fp (Val : Iir_Fp64; Lit_Type : Iir) + return Iir_Floating_Point_Literal + is + Res : Iir_Floating_Point_Literal; + begin + Res := Create_Std_Iir (Iir_Kind_Floating_Point_Literal); + Set_Fp_Value (Res, Val); + Set_Type (Res, Lit_Type); + Set_Expr_Staticness (Res, Locally); + return Res; + end Create_Std_Fp; + + function Create_Std_Range_Expr (Left, Right : Iir; Rtype : Iir) + return Iir + is + Res : Iir; + begin + Res := Create_Std_Iir (Iir_Kind_Range_Expression); + Set_Left_Limit (Res, Left); + Set_Left_Limit_Expr (Res, Left); + Set_Direction (Res, Iir_To); + Set_Right_Limit (Res, Right); + Set_Right_Limit_Expr (Res, Right); + Set_Expr_Staticness (Res, Locally); + Set_Type (Res, Rtype); + return Res; + end Create_Std_Range_Expr; + + function Create_Std_Literal (Name : Name_Id; + Pos : Natural; + Sub_Type : Iir_Enumeration_Type_Definition) + return Iir_Enumeration_Literal + is + List : constant Iir_Flist := Get_Enumeration_Literal_List (Sub_Type); + Res : Iir_Enumeration_Literal; + begin + Res := Create_Std_Decl (Iir_Kind_Enumeration_Literal); + Set_Std_Identifier (Res, Name); + Set_Type (Res, Sub_Type); + Set_Expr_Staticness (Res, Locally); + Set_Name_Staticness (Res, Locally); + Set_Enum_Pos (Res, Iir_Int32 (Pos)); + Vhdl.Sem_Utils.Compute_Subprogram_Hash (Res); + Set_Nth_Element (List, Pos, Res); + return Res; + end Create_Std_Literal; + + -- Append a declaration DECL to Standard_Package. + Last_Decl : Iir := Null_Iir; + procedure Add_Decl (Decl : Iir) is + begin + if Last_Decl = Null_Iir then + Set_Declaration_Chain (Standard_Package, Decl); + else + Set_Chain (Last_Decl, Decl); + end if; + Last_Decl := Decl; + end Add_Decl; + + procedure Add_Implicit_Operations (Decl : Iir) + is + Nxt : Iir; + begin + Vhdl.Sem_Utils.Create_Implicit_Operations (Decl, True); + + -- Update Last_Decl + loop + Nxt := Get_Chain (Last_Decl); + exit when Nxt = Null_Iir; + Last_Decl := Nxt; + end loop; + end Add_Implicit_Operations; + + -- Find implicit declaration of "**" for type declaration TYPE_DECL + -- and append it at the current end of std_package. + procedure Relocate_Exp_At_End (Type_Decl : Iir) + is + Prev_El, El : Iir; + begin + pragma Assert + (Get_Kind (Type_Decl) = Iir_Kind_Anonymous_Type_Declaration); + El := Type_Decl; + loop + Prev_El := El; + El := Get_Chain (El); + pragma Assert (Get_Kind (El) = Iir_Kind_Function_Declaration); + exit when + Get_Implicit_Definition (El) = Iir_Predefined_Integer_Exp; + exit when + Get_Implicit_Definition (El) = Iir_Predefined_Floating_Exp; + end loop; + + -- EL must not be the last element, otherwise Add_Decl will break + -- the chain. + pragma Assert (Is_Valid (Get_Chain (El))); + + -- Remove from the chain. + Set_Chain (Prev_El, Get_Chain (El)); + Set_Chain (El, Null_Iir); + + -- Append. + Add_Decl (El); + end Relocate_Exp_At_End; + + procedure Create_Std_Type (Decl : out Iir; Def : Iir; Name : Name_Id) is + begin + Decl := Create_Std_Decl (Iir_Kind_Type_Declaration); + Set_Std_Identifier (Decl, Name); + Set_Type_Definition (Decl, Def); + Add_Decl (Decl); + Set_Type_Declarator (Def, Decl); + end Create_Std_Type; + + procedure Create_Integer_Type (Type_Definition : Iir; + Type_Decl : out Iir; + Type_Name : Name_Id) + is + begin + --Integer_Type_Definition := + -- Create_Std_Iir (Iir_Kind_Integer_Type_Definition); + Set_Base_Type (Type_Definition, Type_Definition); + Set_Type_Staticness (Type_Definition, Locally); + Set_Signal_Type_Flag (Type_Definition, True); + Set_Has_Signal_Flag (Type_Definition, not Flags.Flag_Whole_Analyze); + + Type_Decl := Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); + Set_Identifier (Type_Decl, Type_Name); + Set_Type_Definition (Type_Decl, Type_Definition); + Set_Type_Declarator (Type_Definition, Type_Decl); + end Create_Integer_Type; + + procedure Create_Integer_Subtype (Type_Definition : Iir; + Type_Decl : Iir; + Subtype_Definition : out Iir; + Subtype_Decl : out Iir; + Is_64 : Boolean) + is + Constraint : Iir; + begin + Subtype_Definition := + Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition); + Set_Base_Type (Subtype_Definition, Type_Definition); + Constraint := Create_Std_Range_Expr + (Create_Std_Integer (Low_Bound (Is_64), + Universal_Integer_Type_Definition), + Create_Std_Integer (High_Bound (Is_64), + Universal_Integer_Type_Definition), + Universal_Integer_Type_Definition); + Set_Range_Constraint (Subtype_Definition, Constraint); + Set_Type_Staticness (Subtype_Definition, Locally); + Set_Signal_Type_Flag (Subtype_Definition, True); + Set_Has_Signal_Flag (Subtype_Definition, + not Flags.Flag_Whole_Analyze); + + -- subtype is + Subtype_Decl := Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Std_Identifier (Subtype_Decl, Get_Identifier (Type_Decl)); + Set_Type (Subtype_Decl, Subtype_Definition); + Set_Subtype_Indication (Subtype_Decl, Subtype_Definition); + Set_Type_Declarator (Subtype_Definition, Subtype_Decl); + Set_Subtype_Definition (Type_Decl, Subtype_Definition); + end Create_Integer_Subtype; + + -- Create an array of EL_TYPE, indexed by Natural. + procedure Create_Array_Type + (Def : out Iir; Decl : out Iir; El_Decl : Iir; Name : Name_Id) + is + Index_List : Iir_Flist; + Index : Iir; + Element : Iir; + begin + Element := Create_Std_Type_Mark (El_Decl); + Index := Create_Std_Type_Mark (Natural_Subtype_Declaration); + + Def := Create_Std_Iir (Iir_Kind_Array_Type_Definition); + Set_Base_Type (Def, Def); + + Index_List := Create_Iir_Flist (1); + Set_Index_Subtype_Definition_List (Def, Index_List); + Set_Index_Subtype_List (Def, Index_List); + Set_Nth_Element (Index_List, 0, Index); + + Set_Element_Subtype_Indication (Def, Element); + Set_Element_Subtype (Def, Get_Type (El_Decl)); + Set_Type_Staticness (Def, None); + Set_Signal_Type_Flag (Def, True); + Set_Has_Signal_Flag (Def, not Flags.Flag_Whole_Analyze); + + Create_Std_Type (Decl, Def, Name); + + Add_Implicit_Operations (Decl); + end Create_Array_Type; + + -- Create: + -- function TO_STRING (VALUE: inter_type) return STRING; + procedure Create_To_String (Inter_Type : Iir; + Imp : Iir_Predefined_Functions; + Name : Name_Id := Std_Names.Name_To_String; + Inter2_Id : Name_Id := Null_Identifier; + Inter2_Type : Iir := Null_Iir) + is + Decl : Iir_Function_Declaration; + Inter : Iir_Interface_Constant_Declaration; + Inter2 : Iir_Interface_Constant_Declaration; + begin + Decl := Create_Std_Decl (Iir_Kind_Function_Declaration); + Set_Std_Identifier (Decl, Name); + Set_Return_Type (Decl, String_Type_Definition); + Set_Pure_Flag (Decl, True); + Set_Implicit_Definition (Decl, Imp); + + Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration); + Set_Identifier (Inter, Std_Names.Name_Value); + Set_Type (Inter, Inter_Type); + Set_Mode (Inter, Iir_In_Mode); + Set_Visible_Flag (Inter, True); + Set_Interface_Declaration_Chain (Decl, Inter); + + if Inter2_Id /= Null_Identifier then + Inter2 := Create_Iir (Iir_Kind_Interface_Constant_Declaration); + Set_Identifier (Inter2, Inter2_Id); + Set_Type (Inter2, Inter2_Type); + Set_Mode (Inter2, Iir_In_Mode); + Set_Visible_Flag (Inter2, True); + Set_Chain (Inter, Inter2); + end if; + + Vhdl.Sem_Utils.Compute_Subprogram_Hash (Decl); + Add_Decl (Decl); + end Create_To_String; + + -- Create: + -- function NAME (signal S : I inter_type) return BOOLEAN; + procedure Create_Edge_Function + (Name : Name_Id; Func : Iir_Predefined_Functions; Inter_Type : Iir) + is + Decl : Iir_Function_Declaration; + Inter : Iir_Interface_Constant_Declaration; + begin + Decl := Create_Std_Decl (Iir_Kind_Function_Declaration); + Set_Std_Identifier (Decl, Name); + Set_Return_Type (Decl, Boolean_Type_Definition); + Set_Pure_Flag (Decl, True); + Set_Implicit_Definition (Decl, Func); + + Inter := Create_Iir (Iir_Kind_Interface_Signal_Declaration); + Set_Identifier (Inter, Std_Names.Name_S); + Set_Type (Inter, Inter_Type); + Set_Mode (Inter, Iir_In_Mode); + Set_Visible_Flag (Inter, True); + Set_Interface_Declaration_Chain (Decl, Inter); + + Vhdl.Sem_Utils.Compute_Subprogram_Hash (Decl); + Add_Decl (Decl); + end Create_Edge_Function; + + procedure Create_Wildcard_Type (Def : Iir; Name : String) + is + Decl : Iir; + begin + Decl := Create_Std_Decl (Iir_Kind_Type_Declaration); + Set_Identifier (Decl, Name_Table.Get_Identifier (Name)); + Set_Base_Type (Def, Def); + Set_Type_Staticness (Def, None); + Set_Type_Definition (Decl, Def); + Set_Type_Declarator (Def, Decl); + + Set_Chain (Decl, Wildcard_Type_Declaration_Chain); + Wildcard_Type_Declaration_Chain := Decl; + end Create_Wildcard_Type; + + begin + -- Create design file. + Std_Standard_File := Create_Std_Iir (Iir_Kind_Design_File); + Set_Parent (Std_Standard_File, Parent); + Set_Design_File_Filename (Std_Standard_File, Std_Filename); + + declare + Std_Time_Stamp : constant Time_Stamp_String := + "20020601000000.000"; + Id : Time_Stamp_Id; + begin + Id := Time_Stamp_Id (Str_Table.Create_String8); + for I in Time_Stamp_String'Range loop + Str_Table.Append_String8_Char (Std_Time_Stamp (I)); + end loop; + Set_Analysis_Time_Stamp (Std_Standard_File, Id); + end; + + -- Create design unit. + Std_Standard_Unit := Create_Std_Iir (Iir_Kind_Design_Unit); + Set_Identifier (Std_Standard_Unit, Name_Standard); + Set_First_Design_Unit (Std_Standard_File, Std_Standard_Unit); + Set_Last_Design_Unit (Std_Standard_File, Std_Standard_Unit); + Set_Design_File (Std_Standard_Unit, Std_Standard_File); + Set_Date_State (Std_Standard_Unit, Date_Analyze); + Set_Dependence_List (Std_Standard_Unit, Create_Iir_List); + + Set_Date (Std_Standard_Unit, Date_Valid'First); + + -- Adding "package STANDARD is" + Standard_Package := Create_Std_Iir (Iir_Kind_Package_Declaration); + Set_Std_Identifier (Standard_Package, Name_Standard); + Set_Need_Body (Standard_Package, False); + + Set_Library_Unit (Std_Standard_Unit, Standard_Package); + Set_Design_Unit (Standard_Package, Std_Standard_Unit); + + -- boolean + begin + -- (false, true) + Boolean_Type_Definition := + Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Base_Type (Boolean_Type_Definition, Boolean_Type_Definition); + Set_Enumeration_Literal_List + (Boolean_Type_Definition, Create_Iir_Flist (2)); + Boolean_False := Create_Std_Literal + (Name_False, 0, Boolean_Type_Definition); + Boolean_True := Create_Std_Literal + (Name_True, 1, Boolean_Type_Definition); + Set_Type_Staticness (Boolean_Type_Definition, Locally); + Set_Signal_Type_Flag (Boolean_Type_Definition, True); + Set_Has_Signal_Flag (Boolean_Type_Definition, + not Flags.Flag_Whole_Analyze); + + -- type boolean is + Create_Std_Type (Boolean_Type_Declaration, Boolean_Type_Definition, + Name_Boolean); + + Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + (Boolean_Type_Definition); + Add_Implicit_Operations (Boolean_Type_Declaration); + end; + + if Vhdl_Std >= Vhdl_08 then + -- Rising_Edge and Falling_Edge + Create_Edge_Function + (Std_Names.Name_Rising_Edge, Iir_Predefined_Boolean_Rising_Edge, + Boolean_Type_Definition); + Create_Edge_Function + (Std_Names.Name_Falling_Edge, Iir_Predefined_Boolean_Falling_Edge, + Boolean_Type_Definition); + end if; + + -- bit. + begin + -- ('0', '1') + Bit_Type_Definition := + Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Enumeration_Literal_List + (Bit_Type_Definition, Create_Iir_Flist (2)); + Set_Base_Type (Bit_Type_Definition, Bit_Type_Definition); + Set_Is_Character_Type (Bit_Type_Definition, True); + Bit_0 := Create_Std_Literal + (Get_Std_Character ('0'), 0, Bit_Type_Definition); + Bit_1 := Create_Std_Literal + (Get_Std_Character ('1'), 1, Bit_Type_Definition); + Set_Type_Staticness (Bit_Type_Definition, Locally); + Set_Signal_Type_Flag (Bit_Type_Definition, True); + Set_Has_Signal_Flag (Bit_Type_Definition, + not Flags.Flag_Whole_Analyze); + Set_Only_Characters_Flag (Bit_Type_Definition, True); + + -- type bit is + Create_Std_Type (Bit_Type_Declaration, Bit_Type_Definition, Name_Bit); + + Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + (Bit_Type_Definition); + Add_Implicit_Operations (Bit_Type_Declaration); + end; + + if Vhdl_Std >= Vhdl_08 then + -- Rising_Edge and Falling_Edge + Create_Edge_Function + (Std_Names.Name_Rising_Edge, Iir_Predefined_Bit_Rising_Edge, + Bit_Type_Definition); + Create_Edge_Function + (Std_Names.Name_Falling_Edge, Iir_Predefined_Bit_Falling_Edge, + Bit_Type_Definition); + end if; + + -- characters. + declare + El: Iir; + pragma Unreferenced (El); + Len : Natural; + begin + Character_Type_Definition := + Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Base_Type (Character_Type_Definition, Character_Type_Definition); + Set_Is_Character_Type (Character_Type_Definition, True); + if Vhdl_Std = Vhdl_87 then + Len := 128; + else + Len := 256; + end if; + Set_Enumeration_Literal_List + (Character_Type_Definition, Create_Iir_Flist (Len)); + + for I in Name_Nul .. Name_Usp loop + El := Create_Std_Literal + (I, Natural (I - Name_Nul), Character_Type_Definition); + end loop; + for I in Character'(' ') .. Character'('~') loop + El := Create_Std_Literal + (Get_Std_Character (I), Character'Pos (I), + Character_Type_Definition); + end loop; + El := Create_Std_Literal (Name_Del, 127, Character_Type_Definition); + if Vhdl_Std /= Vhdl_87 then + for I in Name_C128 .. Name_C159 loop + El := Create_Std_Literal + (I, 128 + Natural (I - Name_C128), Character_Type_Definition); + end loop; + for I in Character'Val (160) .. Character'Val (255) loop + El := Create_Std_Literal + (Get_Std_Character (I), Character'Pos (I), + Character_Type_Definition); + end loop; + end if; + Set_Type_Staticness (Character_Type_Definition, Locally); + Set_Signal_Type_Flag (Character_Type_Definition, True); + Set_Has_Signal_Flag (Character_Type_Definition, + not Flags.Flag_Whole_Analyze); + + -- type character is + Create_Std_Type + (Character_Type_Declaration, Character_Type_Definition, + Name_Character); + + Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + (Character_Type_Definition); + Add_Implicit_Operations (Character_Type_Declaration); + end; + + -- severity level. + begin + -- (note, warning, error, failure) + Severity_Level_Type_Definition := + Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Base_Type (Severity_Level_Type_Definition, + Severity_Level_Type_Definition); + Set_Enumeration_Literal_List + (Severity_Level_Type_Definition, Create_Iir_Flist (4)); + + Severity_Level_Note := Create_Std_Literal + (Name_Note, 0, Severity_Level_Type_Definition); + Severity_Level_Warning := Create_Std_Literal + (Name_Warning, 1, Severity_Level_Type_Definition); + Severity_Level_Error := Create_Std_Literal + (Name_Error, 2, Severity_Level_Type_Definition); + Severity_Level_Failure := Create_Std_Literal + (Name_Failure, 3, Severity_Level_Type_Definition); + Set_Type_Staticness (Severity_Level_Type_Definition, Locally); + Set_Signal_Type_Flag (Severity_Level_Type_Definition, True); + Set_Has_Signal_Flag (Severity_Level_Type_Definition, + not Flags.Flag_Whole_Analyze); + + -- type severity_level is + Create_Std_Type + (Severity_Level_Type_Declaration, Severity_Level_Type_Definition, + Name_Severity_Level); + + Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + (Severity_Level_Type_Definition); + Add_Implicit_Operations (Severity_Level_Type_Declaration); + end; + + -- universal integer + begin + Create_Integer_Type (Universal_Integer_Type_Definition, + Universal_Integer_Type_Declaration, + Name_Universal_Integer); + Add_Decl (Universal_Integer_Type_Declaration); + + Create_Integer_Subtype (Universal_Integer_Type_Definition, + Universal_Integer_Type_Declaration, + Universal_Integer_Subtype_Definition, + Universal_Integer_Subtype_Declaration, + Flags.Flag_Time_64 or Flags.Flag_Integer_64); + + Add_Decl (Universal_Integer_Subtype_Declaration); + Set_Subtype_Definition (Universal_Integer_Type_Declaration, + Universal_Integer_Subtype_Definition); + + -- Do not create implicit operations yet, since "**" needs integer + -- type. + end; + + -- Universal integer constant 1. + Universal_Integer_One := + Create_Std_Integer (1, Universal_Integer_Type_Definition); + + -- Universal real. + declare + Constraint : Iir_Range_Expression; + begin + Set_Base_Type (Universal_Real_Type_Definition, + Universal_Real_Type_Definition); + Set_Type_Staticness (Universal_Real_Type_Definition, Locally); + Set_Signal_Type_Flag (Universal_Real_Type_Definition, True); + Set_Has_Signal_Flag (Universal_Real_Type_Definition, False); + + -- type universal_real is ... + Universal_Real_Type_Declaration := + Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); + Set_Identifier (Universal_Real_Type_Declaration, Name_Universal_Real); + Set_Type_Definition (Universal_Real_Type_Declaration, + Universal_Real_Type_Definition); + Set_Type_Declarator (Universal_Real_Type_Definition, + Universal_Real_Type_Declaration); + Add_Decl (Universal_Real_Type_Declaration); + + Universal_Real_Subtype_Definition := + Create_Std_Iir (Iir_Kind_Floating_Subtype_Definition); + Set_Base_Type (Universal_Real_Subtype_Definition, + Universal_Real_Type_Definition); + Constraint := Create_Std_Range_Expr + (Create_Std_Fp (Iir_Fp64'First, Universal_Real_Type_Definition), + Create_Std_Fp (Iir_Fp64'Last, Universal_Real_Type_Definition), + Universal_Real_Type_Definition); + Set_Range_Constraint (Universal_Real_Subtype_Definition, Constraint); + Set_Type_Staticness (Universal_Real_Subtype_Definition, Locally); + Set_Signal_Type_Flag (Universal_Real_Subtype_Definition, True); + Set_Has_Signal_Flag (Universal_Real_Subtype_Definition, False); + + -- subtype universal_real is ... + Universal_Real_Subtype_Declaration := + Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Identifier (Universal_Real_Subtype_Declaration, + Name_Universal_Real); + Set_Type (Universal_Real_Subtype_Declaration, + Universal_Real_Subtype_Definition); + Set_Subtype_Indication (Universal_Real_Subtype_Declaration, + Universal_Real_Subtype_Definition); + Set_Type_Declarator (Universal_Real_Subtype_Definition, + Universal_Real_Subtype_Declaration); + Set_Subtype_Definition (Universal_Real_Type_Declaration, + Universal_Real_Subtype_Definition); + + Add_Decl (Universal_Real_Subtype_Declaration); + + -- Do not create implicit operations yet, since "**" needs integer + -- type. + end; + + -- Convertible type. + begin + Create_Integer_Type (Convertible_Integer_Type_Definition, + Convertible_Integer_Type_Declaration, + Name_Convertible_Integer); + Create_Integer_Subtype (Convertible_Integer_Type_Definition, + Convertible_Integer_Type_Declaration, + Convertible_Integer_Subtype_Definition, + Convertible_Integer_Subtype_Declaration, + Flags.Flag_Time_64 or Flags.Flag_Integer_64); + + -- Not added in std.standard. + end; + + begin + Set_Base_Type (Convertible_Real_Type_Definition, + Convertible_Real_Type_Definition); + Set_Type_Staticness (Convertible_Real_Type_Definition, Locally); + Set_Signal_Type_Flag (Convertible_Real_Type_Definition, True); + Set_Has_Signal_Flag (Convertible_Real_Type_Definition, False); + + Convertible_Real_Type_Declaration := + Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); + Set_Identifier (Convertible_Real_Type_Declaration, + Name_Convertible_Real); + Set_Type_Definition (Convertible_Real_Type_Declaration, + Convertible_Real_Type_Definition); + Set_Type_Declarator (Convertible_Real_Type_Definition, + Convertible_Real_Type_Declaration); + end; + + -- integer type. + begin + Integer_Type_Definition := + Create_Std_Iir (Iir_Kind_Integer_Type_Definition); + Create_Integer_Type (Integer_Type_Definition, + Integer_Type_Declaration, + Name_Integer); + Add_Decl (Integer_Type_Declaration); + + -- Now that Integer is declared, create operations for universal + -- types. They will be inserted just after the type declaration, + -- but cannot be done before as "**" relies on Integer. + Add_Implicit_Operations (Universal_Integer_Type_Declaration); + Add_Implicit_Operations (Universal_Real_Type_Declaration); + + -- Don't define "**" for universal types before the declaration of + -- Integer, so move them. + Relocate_Exp_At_End (Universal_Integer_Type_Declaration); + Relocate_Exp_At_End (Universal_Real_Type_Declaration); + + Add_Implicit_Operations (Integer_Type_Declaration); + + Create_Integer_Subtype (Integer_Type_Definition, + Integer_Type_Declaration, + Integer_Subtype_Definition, + Integer_Subtype_Declaration, + Flags.Flag_Integer_64); + Add_Decl (Integer_Subtype_Declaration); + end; + + -- Real type. + declare + Constraint : Iir_Range_Expression; + begin + Real_Type_Definition := + Create_Std_Iir (Iir_Kind_Floating_Type_Definition); + Set_Base_Type (Real_Type_Definition, Real_Type_Definition); + Set_Type_Staticness (Real_Type_Definition, Locally); + Set_Signal_Type_Flag (Real_Type_Definition, True); + Set_Has_Signal_Flag (Real_Type_Definition, + not Flags.Flag_Whole_Analyze); + + Real_Type_Declaration := + Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); + Set_Identifier (Real_Type_Declaration, Name_Real); + Set_Type_Definition (Real_Type_Declaration, Real_Type_Definition); + Set_Type_Declarator (Real_Type_Definition, Real_Type_Declaration); + Add_Decl (Real_Type_Declaration); + + Add_Implicit_Operations (Real_Type_Declaration); + + Real_Subtype_Definition := + Create_Std_Iir (Iir_Kind_Floating_Subtype_Definition); + Set_Base_Type (Real_Subtype_Definition, Real_Type_Definition); + Constraint := Create_Std_Range_Expr + (Create_Std_Fp (Iir_Fp64'First, Universal_Real_Type_Definition), + Create_Std_Fp (Iir_Fp64'Last, Universal_Real_Type_Definition), + Universal_Real_Type_Definition); + Set_Range_Constraint (Real_Subtype_Definition, Constraint); + Set_Type_Staticness (Real_Subtype_Definition, Locally); + Set_Signal_Type_Flag (Real_Subtype_Definition, True); + Set_Has_Signal_Flag (Real_Subtype_Definition, + not Flags.Flag_Whole_Analyze); + + Real_Subtype_Declaration := + Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Std_Identifier (Real_Subtype_Declaration, Name_Real); + Set_Type (Real_Subtype_Declaration, Real_Subtype_Definition); + Set_Subtype_Indication (Real_Subtype_Declaration, + Real_Subtype_Definition); + Set_Type_Declarator + (Real_Subtype_Definition, Real_Subtype_Declaration); + Add_Decl (Real_Subtype_Declaration); + + Set_Subtype_Definition + (Real_Type_Declaration, Real_Subtype_Definition); + end; + + -- time definition + declare + Time_Staticness : Iir_Staticness; + Last_Unit : Iir_Unit_Declaration; + use Iir_Chains.Unit_Chain_Handling; + + function Create_Std_Phys_Lit_Wo_Unit (Value : Iir_Int64; Unit : Iir) + return Iir_Physical_Int_Literal + is + Lit: Iir_Physical_Int_Literal; + begin + Lit := Create_Std_Iir (Iir_Kind_Physical_Int_Literal); + Set_Value (Lit, Value); + pragma Assert (Get_Kind (Unit) = Iir_Kind_Unit_Declaration); + Set_Physical_Unit (Lit, Unit); + Set_Type (Lit, Time_Type_Definition); + Set_Expr_Staticness (Lit, Time_Staticness); + return Lit; + end Create_Std_Phys_Lit_Wo_Unit; + + function Create_Std_Phys_Lit (Value : Iir_Int64; Unit : Iir) + return Iir_Physical_Int_Literal + is + Lit: Iir_Physical_Int_Literal; + Unit_Name : Iir; + begin + Lit := Create_Std_Phys_Lit_Wo_Unit (Value, Unit); + Unit_Name := Create_Std_Iir (Iir_Kind_Simple_Name); + Set_Identifier (Unit_Name, Get_Identifier (Unit)); + Set_Unit_Name (Lit, Unit_Name); + return Lit; + end Create_Std_Phys_Lit; + + procedure Create_Unit (Unit : out Iir_Unit_Declaration; + Multiplier_Value : Iir_Int64; + Multiplier : in Iir_Unit_Declaration; + Name : Name_Id) + is + Lit, Lit1 : Iir_Physical_Int_Literal; + begin + Unit := Create_Std_Decl (Iir_Kind_Unit_Declaration); + Set_Std_Identifier (Unit, Name); + Set_Type (Unit, Time_Type_Definition); + + Lit1 := Create_Std_Phys_Lit (Multiplier_Value, Multiplier); + Lit := Create_Std_Phys_Lit + (Multiplier_Value + * Get_Value (Get_Physical_Literal (Multiplier)), + Get_Physical_Unit (Get_Physical_Literal (Multiplier))); + Set_Literal_Origin (Lit, Lit1); + Set_Physical_Literal (Unit, Lit); + + Set_Expr_Staticness (Unit, Time_Staticness); + Set_Name_Staticness (Unit, Locally); + Append (Last_Unit, Time_Type_Definition, Unit); + end Create_Unit; + + Constraint : Iir_Range_Expression; + begin + if Vhdl_Std >= Vhdl_93c then + Time_Staticness := Globally; + else + Time_Staticness := Locally; + end if; + + Time_Type_Definition := + Create_Std_Iir (Iir_Kind_Physical_Type_Definition); + Set_Base_Type (Time_Type_Definition, Time_Type_Definition); + Set_Type_Staticness (Time_Type_Definition, Locally);--Time_Staticness + Set_Signal_Type_Flag (Time_Type_Definition, True); + Set_Has_Signal_Flag (Time_Type_Definition, + not Flags.Flag_Whole_Analyze); + Set_End_Has_Reserved_Id (Time_Type_Definition, True); + + Build_Init (Last_Unit); + + Time_Fs_Unit := Create_Std_Decl (Iir_Kind_Unit_Declaration); + Set_Std_Identifier (Time_Fs_Unit, Name_Fs); + Set_Type (Time_Fs_Unit, Time_Type_Definition); + Set_Expr_Staticness (Time_Fs_Unit, Time_Staticness); + Set_Name_Staticness (Time_Fs_Unit, Locally); + Set_Physical_Literal + (Time_Fs_Unit, Create_Std_Phys_Lit (1, Time_Fs_Unit)); + Append (Last_Unit, Time_Type_Definition, Time_Fs_Unit); + + Create_Unit (Time_Ps_Unit, 1000, Time_Fs_Unit, Name_Ps); + Create_Unit (Time_Ns_Unit, 1000, Time_Ps_Unit, Name_Ns); + Create_Unit (Time_Us_Unit, 1000, Time_Ns_Unit, Name_Us); + Create_Unit (Time_Ms_Unit, 1000, Time_Us_Unit, Name_Ms); + Create_Unit (Time_Sec_Unit, 1000, Time_Ms_Unit, Name_Sec); + Create_Unit (Time_Min_Unit, 60, Time_Sec_Unit, Name_Min); + Create_Unit (Time_Hr_Unit, 60, Time_Min_Unit, Name_Hr); + + -- type is + Time_Type_Declaration := + Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); + Set_Identifier (Time_Type_Declaration, Name_Time); + Set_Type_Definition (Time_Type_Declaration, Time_Type_Definition); + Set_Type_Declarator (Time_Type_Definition, Time_Type_Declaration); + Add_Decl (Time_Type_Declaration); + + Add_Implicit_Operations (Time_Type_Declaration); + + Time_Subtype_Definition := + Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition); + Constraint := Create_Std_Range_Expr + (Create_Std_Phys_Lit_Wo_Unit (Low_Bound (Flags.Flag_Time_64), + Time_Fs_Unit), + Create_Std_Phys_Lit_Wo_Unit (High_Bound (Flags.Flag_Time_64), + Time_Fs_Unit), + Time_Type_Definition); + Set_Range_Constraint (Time_Subtype_Definition, Constraint); + Set_Base_Type (Time_Subtype_Definition, Time_Type_Definition); + --Set_Subtype_Type_Mark (Time_Subtype_Definition, + -- Time_Type_Definition); + Set_Type_Staticness (Time_Subtype_Definition, Time_Staticness); + Set_Signal_Type_Flag (Time_Subtype_Definition, True); + Set_Has_Signal_Flag (Time_Subtype_Definition, + not Flags.Flag_Whole_Analyze); + + -- subtype time is + Time_Subtype_Declaration := + Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Std_Identifier (Time_Subtype_Declaration, Name_Time); + Set_Type (Time_Subtype_Declaration, Time_Subtype_Definition); + Set_Subtype_Indication (Time_Subtype_Declaration, + Time_Subtype_Definition); + Set_Type_Declarator (Time_Subtype_Definition, + Time_Subtype_Declaration); + Add_Decl (Time_Subtype_Declaration); + Set_Subtype_Definition + (Time_Type_Declaration, Time_Subtype_Definition); + + -- VHDL93 + -- subtype DELAY_LENGTH is TIME range 0 to TIME'HIGH + if Vhdl_Std >= Vhdl_93c then + Delay_Length_Subtype_Definition := + Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition); + Set_Subtype_Type_Mark + (Delay_Length_Subtype_Definition, + Create_Std_Type_Mark (Time_Subtype_Declaration)); + Constraint := Create_Std_Range_Expr + (Create_Std_Phys_Lit (0, Time_Fs_Unit), + Create_Std_Phys_Lit (High_Bound (Flags.Flag_Time_64), + Time_Fs_Unit), + Time_Type_Definition); + Set_Range_Constraint (Delay_Length_Subtype_Definition, Constraint); + Set_Base_Type + (Delay_Length_Subtype_Definition, Time_Type_Definition); + Set_Type_Staticness + (Delay_Length_Subtype_Definition, Time_Staticness); + Set_Signal_Type_Flag (Delay_Length_Subtype_Definition, True); + Set_Has_Signal_Flag (Delay_Length_Subtype_Definition, + not Flags.Flag_Whole_Analyze); + + -- subtype delay_length is ... + Delay_Length_Subtype_Declaration := + Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Std_Identifier (Delay_Length_Subtype_Declaration, + Name_Delay_Length); + Set_Type (Delay_Length_Subtype_Declaration, + Delay_Length_Subtype_Definition); + Set_Type_Declarator (Delay_Length_Subtype_Definition, + Delay_Length_Subtype_Declaration); + Set_Subtype_Indication (Delay_Length_Subtype_Declaration, + Delay_Length_Subtype_Definition); + Add_Decl (Delay_Length_Subtype_Declaration); + else + Delay_Length_Subtype_Definition := Null_Iir; + Delay_Length_Subtype_Declaration := Null_Iir; + end if; + end; + + -- VHDL87: + -- function NOW return TIME + -- + -- impure function NOW return DELAY_LENGTH. + declare + Function_Now : Iir_Function_Declaration; + begin + Function_Now := Create_Std_Decl (Iir_Kind_Function_Declaration); + Set_Std_Identifier (Function_Now, Std_Names.Name_Now); + if Vhdl_Std = Vhdl_87 then + Set_Return_Type (Function_Now, Time_Subtype_Definition); + else + Set_Return_Type (Function_Now, Delay_Length_Subtype_Definition); + end if; + if Vhdl_Std = Vhdl_02 then + Set_Pure_Flag (Function_Now, True); + else + Set_Pure_Flag (Function_Now, False); + end if; + Set_Implicit_Definition (Function_Now, Iir_Predefined_Now_Function); + Vhdl.Sem_Utils.Compute_Subprogram_Hash (Function_Now); + Add_Decl (Function_Now); + end; + + -- natural subtype + declare + Constraint : Iir_Range_Expression; + begin + Natural_Subtype_Definition := + Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition); + Set_Base_Type (Natural_Subtype_Definition, Integer_Type_Definition); + Set_Subtype_Type_Mark + (Natural_Subtype_Definition, + Create_Std_Type_Mark (Integer_Subtype_Declaration)); + Constraint := Create_Std_Range_Expr + (Create_Std_Integer (0, Integer_Type_Definition), + Create_Std_Integer (High_Bound (Flags.Flag_Integer_64), + Integer_Type_Definition), + Integer_Type_Definition); + Set_Range_Constraint (Natural_Subtype_Definition, Constraint); + Set_Type_Staticness (Natural_Subtype_Definition, Locally); + Set_Signal_Type_Flag (Natural_Subtype_Definition, True); + Set_Has_Signal_Flag (Natural_Subtype_Definition, + not Flags.Flag_Whole_Analyze); + + Natural_Subtype_Declaration := + Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Std_Identifier (Natural_Subtype_Declaration, Name_Natural); + Set_Type (Natural_Subtype_Declaration, Natural_Subtype_Definition); + Set_Subtype_Indication (Natural_Subtype_Declaration, + Natural_Subtype_Definition); + Add_Decl (Natural_Subtype_Declaration); + Set_Type_Declarator (Natural_Subtype_Definition, + Natural_Subtype_Declaration); + end; + + -- positive subtype + declare + Constraint : Iir_Range_Expression; + begin + Positive_Subtype_Definition := + Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition); + Set_Base_Type (Positive_Subtype_Definition, + Integer_Type_Definition); + Set_Subtype_Type_Mark + (Positive_Subtype_Definition, + Create_Std_Type_Mark (Integer_Subtype_Declaration)); + Constraint := Create_Std_Range_Expr + (Create_Std_Integer (1, Integer_Type_Definition), + Create_Std_Integer (High_Bound (Flags.Flag_Integer_64), + Integer_Type_Definition), + Integer_Type_Definition); + Set_Range_Constraint (Positive_Subtype_Definition, Constraint); + Set_Type_Staticness (Positive_Subtype_Definition, Locally); + Set_Signal_Type_Flag (Positive_Subtype_Definition, True); + Set_Has_Signal_Flag (Positive_Subtype_Definition, + not Flags.Flag_Whole_Analyze); + + Positive_Subtype_Declaration := + Create_Std_Decl (Iir_Kind_Subtype_Declaration); + Set_Std_Identifier (Positive_Subtype_Declaration, Name_Positive); + Set_Type (Positive_Subtype_Declaration, Positive_Subtype_Definition); + Set_Subtype_Indication (Positive_Subtype_Declaration, + Positive_Subtype_Definition); + Add_Decl (Positive_Subtype_Declaration); + Set_Type_Declarator (Positive_Subtype_Definition, + Positive_Subtype_Declaration); + end; + + -- string type. + -- type string is array (positive range <>) of character; + declare + Element : Iir; + Index_List : Iir_Flist; + begin + Element := Create_Std_Type_Mark (Character_Type_Declaration); + + String_Type_Definition := + Create_Std_Iir (Iir_Kind_Array_Type_Definition); + Set_Base_Type (String_Type_Definition, String_Type_Definition); + Index_List := Create_Iir_Flist (1); + Set_Nth_Element (Index_List, 0, + Create_Std_Type_Mark (Positive_Subtype_Declaration)); + Set_Index_Subtype_Definition_List (String_Type_Definition, + Index_List); + Set_Index_Subtype_List (String_Type_Definition, Index_List); + Set_Element_Subtype_Indication (String_Type_Definition, Element); + Set_Element_Subtype (String_Type_Definition, + Character_Type_Definition); + Set_Type_Staticness (String_Type_Definition, None); + Set_Signal_Type_Flag (String_Type_Definition, True); + Set_Has_Signal_Flag (String_Type_Definition, + not Flags.Flag_Whole_Analyze); + + Create_Std_Type + (String_Type_Declaration, String_Type_Definition, Name_String); + + Add_Implicit_Operations (String_Type_Declaration); + end; + + if Vhdl_Std >= Vhdl_08 then + -- type Boolean_Vector is array (Natural range <>) of Boolean; + Create_Array_Type + (Boolean_Vector_Type_Definition, Boolean_Vector_Type_Declaration, + Boolean_Type_Declaration, Name_Boolean_Vector); + end if; + + -- bit_vector type. + -- type bit_vector is array (natural range <>) of bit; + Create_Array_Type + (Bit_Vector_Type_Definition, Bit_Vector_Type_Declaration, + Bit_Type_Declaration, Name_Bit_Vector); + + -- LRM08 5.3.2.4 Predefined operations on array types + -- The following operations are implicitly declared in package + -- STD.STANDARD immediately following the declaration of type + -- BIT_VECTOR: + if Vhdl_Std >= Vhdl_08 then + Create_To_String (Bit_Vector_Type_Definition, + Iir_Predefined_Bit_Vector_To_Ostring, + Name_To_Ostring); + Create_To_String (Bit_Vector_Type_Definition, + Iir_Predefined_Bit_Vector_To_Hstring, + Name_To_Hstring); + end if; + + -- VHDL 2008 + -- Vector types + if Vhdl_Std >= Vhdl_08 then + -- type integer_vector is array (natural range <>) of Integer; + Create_Array_Type + (Integer_Vector_Type_Definition, Integer_Vector_Type_Declaration, + Integer_Subtype_Declaration, Name_Integer_Vector); + + -- type Real_vector is array (natural range <>) of Real; + Create_Array_Type + (Real_Vector_Type_Definition, Real_Vector_Type_Declaration, + Real_Subtype_Declaration, Name_Real_Vector); + + -- type Time_vector is array (natural range <>) of Time; + Create_Array_Type + (Time_Vector_Type_Definition, Time_Vector_Type_Declaration, + Time_Subtype_Declaration, Name_Time_Vector); + end if; + + -- VHDL93: + -- type file_open_kind is (read_mode, write_mode, append_mode); + if Vhdl_Std >= Vhdl_93c then + File_Open_Kind_Type_Definition := + Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Base_Type (File_Open_Kind_Type_Definition, + File_Open_Kind_Type_Definition); + Set_Enumeration_Literal_List + (File_Open_Kind_Type_Definition, Create_Iir_Flist (3)); + + File_Open_Kind_Read_Mode := Create_Std_Literal + (Name_Read_Mode, 0, File_Open_Kind_Type_Definition); + File_Open_Kind_Write_Mode := Create_Std_Literal + (Name_Write_Mode, 1, File_Open_Kind_Type_Definition); + File_Open_Kind_Append_Mode := Create_Std_Literal + (Name_Append_Mode, 2, File_Open_Kind_Type_Definition); + Set_Type_Staticness (File_Open_Kind_Type_Definition, Locally); + Set_Signal_Type_Flag (File_Open_Kind_Type_Definition, True); + Set_Has_Signal_Flag (File_Open_Kind_Type_Definition, + not Flags.Flag_Whole_Analyze); + + -- type file_open_kind is + Create_Std_Type + (File_Open_Kind_Type_Declaration, File_Open_Kind_Type_Definition, + Name_File_Open_Kind); + + Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + (File_Open_Kind_Type_Definition); + Add_Implicit_Operations (File_Open_Kind_Type_Declaration); + else + File_Open_Kind_Type_Declaration := Null_Iir; + File_Open_Kind_Type_Definition := Null_Iir; + File_Open_Kind_Read_Mode := Null_Iir; + File_Open_Kind_Write_Mode := Null_Iir; + File_Open_Kind_Append_Mode := Null_Iir; + end if; + + -- VHDL93: + -- type file_open_status is + -- (open_ok, status_error, name_error, mode_error); + if Vhdl_Std >= Vhdl_93c then + File_Open_Status_Type_Definition := + Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition); + Set_Base_Type (File_Open_Status_Type_Definition, + File_Open_Status_Type_Definition); + Set_Enumeration_Literal_List + (File_Open_Status_Type_Definition, Create_Iir_Flist (4)); + + File_Open_Status_Open_Ok := Create_Std_Literal + (Name_Open_Ok, 0, File_Open_Status_Type_Definition); + File_Open_Status_Status_Error := Create_Std_Literal + (Name_Status_Error, 1, File_Open_Status_Type_Definition); + File_Open_Status_Name_Error := Create_Std_Literal + (Name_Name_Error, 2, File_Open_Status_Type_Definition); + File_Open_Status_Mode_Error := Create_Std_Literal + (Name_Mode_Error, 3, File_Open_Status_Type_Definition); + Set_Type_Staticness (File_Open_Status_Type_Definition, Locally); + Set_Signal_Type_Flag (File_Open_Status_Type_Definition, True); + Set_Has_Signal_Flag (File_Open_Status_Type_Definition, + not Flags.Flag_Whole_Analyze); + + -- type file_open_kind is + Create_Std_Type (File_Open_Status_Type_Declaration, + File_Open_Status_Type_Definition, + Name_File_Open_Status); + Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + (File_Open_Status_Type_Definition); + Add_Implicit_Operations (File_Open_Status_Type_Declaration); + else + File_Open_Status_Type_Declaration := Null_Iir; + File_Open_Status_Type_Definition := Null_Iir; + File_Open_Status_Open_Ok := Null_Iir; + File_Open_Status_Status_Error := Null_Iir; + File_Open_Status_Name_Error := Null_Iir; + File_Open_Status_Mode_Error := Null_Iir; + end if; + + -- VHDL93: + -- attribute FOREIGN: string; + if Vhdl_Std >= Vhdl_93c then + Foreign_Attribute := Create_Std_Decl (Iir_Kind_Attribute_Declaration); + Set_Std_Identifier (Foreign_Attribute, Name_Foreign); + Set_Type_Mark (Foreign_Attribute, + Create_Std_Type_Mark (String_Type_Declaration)); + Set_Type (Foreign_Attribute, String_Type_Definition); + Add_Decl (Foreign_Attribute); + else + Foreign_Attribute := Null_Iir; + end if; + + if Vhdl_Std >= Vhdl_08 then + Create_To_String (Boolean_Type_Definition, + Iir_Predefined_Enum_To_String); + Create_To_String (Bit_Type_Definition, + Iir_Predefined_Enum_To_String); + Create_To_String (Character_Type_Definition, + Iir_Predefined_Enum_To_String); + Create_To_String (Severity_Level_Type_Definition, + Iir_Predefined_Enum_To_String); + Create_To_String (Universal_Integer_Type_Definition, + Iir_Predefined_Integer_To_String); + Create_To_String (Universal_Real_Type_Definition, + Iir_Predefined_Floating_To_String); + Create_To_String (Integer_Type_Definition, + Iir_Predefined_Integer_To_String); + Create_To_String (Real_Type_Definition, + Iir_Predefined_Floating_To_String); + Create_To_String (Time_Type_Definition, + Iir_Predefined_Physical_To_String); + Create_To_String (File_Open_Kind_Type_Definition, + Iir_Predefined_Enum_To_String); + Create_To_String (File_Open_Status_Type_Definition, + Iir_Predefined_Enum_To_String); + + -- Predefined overload TO_STRING operations + Create_To_String (Real_Type_Definition, + Iir_Predefined_Real_To_String_Digits, + Name_To_String, + Name_Digits, + Natural_Subtype_Definition); + Create_To_String (Real_Type_Definition, + Iir_Predefined_Real_To_String_Format, + Name_To_String, + Name_Format, + String_Type_Definition); + Create_To_String (Time_Type_Definition, + Iir_Predefined_Time_To_String_Unit, + Name_To_String, + Name_Unit, + Time_Subtype_Definition); + end if; + + -- Wilcard types. + -- Create the declaration and give them meaningful (and invalid) names + -- so that error messages are clear for the user. + Wildcard_Type_Declaration_Chain := Null_Iir; + Create_Wildcard_Type (Wildcard_Any_Type, "any type"); + Create_Wildcard_Type (Wildcard_Any_Aggregate_Type, "any aggregate type"); + Create_Wildcard_Type (Wildcard_Any_String_Type, "any string type"); + Create_Wildcard_Type (Wildcard_Any_Access_Type, "any access type"); + + Error_Type := Iirs_Utils.Create_Error_Type (Wildcard_Any_Type); + Set_Error_Origin (Error_Type, Null_Iir); + Create_Wildcard_Type (Error_Type, "unknown type"); + end Create_Std_Standard_Package; + + procedure Set_Time_Resolution (Resolution : Character) + is + Unit : Iir; + Prim : Iir; + Rng : Iir; + begin + case Resolution is + when 'f' => + Prim := Time_Fs_Unit; + when 'p' => + Prim := Time_Ps_Unit; + when 'n' => + Prim := Time_Ns_Unit; + when 'u' => + Prim := Time_Us_Unit; + when 'm' => + Prim := Time_Ms_Unit; + when 's' => + Prim := Time_Sec_Unit; + when 'M' => + Prim := Time_Min_Unit; + when 'h' => + Prim := Time_Hr_Unit; + when others => + raise Internal_Error; + end case; + + -- Adjust range of TIME subtype. + Rng := Get_Range_Constraint (Time_Subtype_Definition); + Set_Physical_Unit (Get_Left_Limit (Rng), Prim); + Set_Physical_Unit (Get_Right_Limit (Rng), Prim); + + -- Adjust range of DELAY_LENGTH. + if Vhdl_Std >= Vhdl_93c then + Rng := Get_Range_Constraint (Delay_Length_Subtype_Definition); + Set_Physical_Unit (Get_Left_Limit (Rng), Prim); + Set_Physical_Unit (Get_Right_Limit (Rng), Prim); + end if; + + Unit := Get_Unit_Chain (Time_Type_Definition); + while Unit /= Null_Iir loop + declare + Lit : constant Iir := Get_Physical_Literal (Unit); + Orig : constant Iir := Get_Literal_Origin (Lit); + Lit_Unit : Iir; + begin + if Prim = Null_Iir then + -- Primary already set, just recompute values. + Lit_Unit := Get_Physical_Literal (Get_Physical_Unit (Orig)); + Set_Value (Lit, Get_Value (Orig) * Get_Value (Lit_Unit)); + elsif Unit = Prim then + Set_Value (Lit, 1); + Prim := Null_Iir; + else + Set_Value (Lit, 0); + end if; + end; + Unit := Get_Chain (Unit); + end loop; + end Set_Time_Resolution; + + function Get_Minimal_Time_Resolution return Character is + begin + if Get_Use_Flag (Time_Fs_Unit) then + return 'f'; + end if; + if Get_Use_Flag (Time_Ps_Unit) then + return 'p'; + end if; + if Get_Use_Flag (Time_Ns_Unit) then + return 'n'; + end if; + if Get_Use_Flag (Time_Us_Unit) then + return 'u'; + end if; + if Get_Use_Flag (Time_Ms_Unit) then + return 'm'; + end if; + if Get_Use_Flag (Time_Sec_Unit) then + return 's'; + end if; + if Get_Use_Flag (Time_Min_Unit) then + return 'M'; + end if; + if Get_Use_Flag (Time_Hr_Unit) then + return 'h'; + end if; + return '?'; + end Get_Minimal_Time_Resolution; +end Vhdl.Std_Package; diff --git a/src/vhdl/vhdl-std_package.ads b/src/vhdl/vhdl-std_package.ads new file mode 100644 index 000000000..f20364e10 --- /dev/null +++ b/src/vhdl/vhdl-std_package.ads @@ -0,0 +1,202 @@ +-- std.standard package declarations. +-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Iirs; use Iirs; + +package Vhdl.Std_Package is + + -- This is a special node, not really declared in the STANDARD package, + -- used to mark a node as erroneous. + -- Its kind is Iir_Kind_Error. + Error_Mark : constant Iir; + + -- Virtual file and location for the standard package. + Std_Source_File : Source_File_Entry := No_Source_File_Entry; + Std_Location: Location_Type := Location_Nil; + + -- Some well know values declared in the STANDARD package. + -- These values (except time_base) *must* not be modified, and are set by + -- create_std_standard_package. + + Std_Standard_File: Iir_Design_File := Null_Iir; + Std_Standard_Unit : Iir_Design_Unit := Null_Iir; + Standard_Package : Iir_Package_Declaration := Null_Iir; + + -- Boolean values. + Boolean_Type_Declaration : Iir_Type_Declaration := Null_Iir; + Boolean_Type_Definition : Iir_Enumeration_Type_Definition; + Boolean_False : Iir_Enumeration_Literal; + Boolean_True : Iir_Enumeration_Literal; + + -- Bit values. + Bit_Type_Declaration : Iir_Type_Declaration := Null_Iir; + Bit_Type_Definition : Iir_Enumeration_Type_Definition; + Bit_0 : Iir_Enumeration_Literal; + Bit_1 : Iir_Enumeration_Literal; + + -- Predefined character. + Character_Type_Declaration : Iir_Type_Declaration; + Character_Type_Definition : Iir_Enumeration_Type_Definition; + + -- severity level. + Severity_Level_Type_Declaration : Iir_Type_Declaration; + Severity_Level_Type_Definition : Iir_Enumeration_Type_Definition; + Severity_Level_Note : Iir_Enumeration_Literal; + Severity_Level_Warning : Iir_Enumeration_Literal; + Severity_Level_Error : Iir_Enumeration_Literal; + Severity_Level_Failure : Iir_Enumeration_Literal; + + -- Universal types. + Universal_Integer_Type_Declaration : Iir_Anonymous_Type_Declaration; + Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition; + Universal_Integer_Subtype_Declaration : Iir_Subtype_Declaration; + Universal_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition; + + Universal_Integer_One : Iir_Integer_Literal; + + Universal_Real_Type_Declaration : Iir_Anonymous_Type_Declaration; + Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition; + Universal_Real_Subtype_Declaration : Iir_Subtype_Declaration; + Universal_Real_Subtype_Definition : Iir_Floating_Subtype_Definition; + + -- Predefined integer type. + Integer_Type_Declaration : Iir_Anonymous_Type_Declaration; + Integer_Type_Definition : Iir_Integer_Type_Definition; + Integer_Subtype_Declaration : Iir_Subtype_Declaration; + Integer_Subtype_Definition : Iir_Integer_Subtype_Definition; + + -- Type used when the type of an expression is incorrect. + Error_Type : Iir; + + -- Predefined real type. + Real_Type_Declaration : Iir_Anonymous_Type_Declaration; + Real_Type_Definition : Iir_Floating_Type_Definition; + Real_Subtype_Declaration : Iir_Subtype_Declaration; + Real_Subtype_Definition : Iir_Floating_Subtype_Definition; + + -- Predefined natural subtype. + Natural_Subtype_Declaration : Iir_Subtype_Declaration; + Natural_Subtype_Definition : Iir_Integer_Subtype_Definition; + + -- Predefined positive subtype. + Positive_Subtype_Declaration : Iir_Subtype_Declaration; + Positive_Subtype_Definition : Iir_Integer_Subtype_Definition; + + -- Predefined positive subtype. + String_Type_Declaration : Iir_Type_Declaration; + String_Type_Definition : Iir_Array_Type_Definition; + + -- Predefined positive subtype. + Bit_Vector_Type_Declaration : Iir_Type_Declaration; + Bit_Vector_Type_Definition : Iir_Array_Type_Definition; + + -- predefined time subtype + Time_Type_Declaration : Iir_Anonymous_Type_Declaration; + Time_Type_Definition: Iir_Physical_Type_Definition; + Time_Subtype_Definition: Iir_Physical_Subtype_Definition; + Time_Subtype_Declaration : Iir_Subtype_Declaration; + + -- For VHDL-93 + Delay_Length_Subtype_Definition : Iir_Physical_Subtype_Definition; + Delay_Length_Subtype_Declaration : Iir_Subtype_Declaration; + + -- For VHDL-93: + -- type File_Open_Kind + File_Open_Kind_Type_Declaration : Iir_Type_Declaration; + File_Open_Kind_Type_Definition : Iir_Enumeration_Type_Definition; + File_Open_Kind_Read_Mode : Iir_Enumeration_Literal; + File_Open_Kind_Write_Mode : Iir_Enumeration_Literal; + File_Open_Kind_Append_Mode : Iir_Enumeration_Literal; + + -- For VHDL-93: + -- type File_Open_Status + File_Open_Status_Type_Declaration : Iir_Type_Declaration; + File_Open_Status_Type_Definition : Iir_Enumeration_Type_Definition; + File_Open_Status_Open_Ok : Iir_Enumeration_Literal; + File_Open_Status_Status_Error : Iir_Enumeration_Literal; + File_Open_Status_Name_Error : Iir_Enumeration_Literal; + File_Open_Status_Mode_Error : Iir_Enumeration_Literal; + + -- For VHDL-93: + -- atribute foreign : string; + Foreign_Attribute : Iir_Attribute_Declaration; + + -- For VHDL-08 + Boolean_Vector_Type_Definition : Iir_Array_Type_Definition; + Boolean_Vector_Type_Declaration : Iir_Type_Declaration; + + Integer_Vector_Type_Definition : Iir_Array_Type_Definition; + Integer_Vector_Type_Declaration : Iir_Type_Declaration; + + Real_Vector_Type_Definition : Iir_Array_Type_Definition; + Real_Vector_Type_Declaration : Iir_Type_Declaration; + + Time_Vector_Type_Definition : Iir_Array_Type_Definition; + Time_Vector_Type_Declaration : Iir_Type_Declaration; + + -- Internal use only. + -- These types should be considered like universal types, but + -- furthermore, they can be converted to any integer/real types while + -- universal cannot. + Convertible_Integer_Type_Definition : constant Iir_Integer_Type_Definition; + Convertible_Real_Type_Definition : constant Iir_Floating_Type_Definition; + Convertible_Integer_Type_Declaration : Iir_Anonymous_Type_Declaration; + Convertible_Real_Type_Declaration : Iir_Anonymous_Type_Declaration; + + Convertible_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition; + Convertible_Integer_Subtype_Declaration : Iir_Subtype_Declaration; + + -- Wilcard types. + -- Err, we break privacy for iir numbers, but this allow use of them in + -- case statements. + Wildcard_Any_Type : constant Iir := 7; + Wildcard_Any_Aggregate_Type : constant Iir := 8; + Wildcard_Any_String_Type : constant Iir := 9; + Wildcard_Any_Access_Type : constant Iir := 10; + + -- Subtype for all wildcard types, so that missing choice can be detected + -- at compilation time. + subtype Iir_Wildcard_Types is Iir range 7 .. 10; + + -- Chain of wildcard declarations, to own the nodes. + Wildcard_Type_Declaration_Chain : Iir; + + -- Create the first well-known nodes. + procedure Create_First_Nodes; + + -- Create the node for the standard package. + procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration); + + procedure Set_Time_Resolution (Resolution : Character); + + -- Return the minimal time resolution according to use of time units. + function Get_Minimal_Time_Resolution return Character; +private + -- For speed reasons, some often used nodes are hard-coded. + Error_Mark : constant Iir := 2; + Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition + := 3; + Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition + := 4; + + Convertible_Integer_Type_Definition : constant Iir_Integer_Type_Definition + := 5; + Convertible_Real_Type_Definition : constant Iir_Floating_Type_Definition + := 6; +end Vhdl.Std_Package; diff --git a/src/vhdl/xrefs.adb b/src/vhdl/xrefs.adb index d04a7d135..8b66339e2 100644 --- a/src/vhdl/xrefs.adb +++ b/src/vhdl/xrefs.adb @@ -18,7 +18,7 @@ with Tables; with GNAT.Heap_Sort_A; with Flags; -with Std_Package; +with Vhdl.Std_Package; with Errorout; use Errorout; with Nodes; @@ -127,7 +127,7 @@ package body Xrefs is declare Res : constant Iir := Get_Named_Entity (Name); begin - if Res = Std_Package.Error_Mark then + if Res = Vhdl.Std_Package.Error_Mark then return; end if; Add_Xref (Get_Location (Name), Res, Xref_Ref); -- cgit v1.2.3