aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2013-12-17 06:25:53 +0100
committerTristan Gingold <tgingold@free.fr>2013-12-17 06:25:53 +0100
commit48448a12ef628218db298d8b7c6879e28cdd019a (patch)
tree7e612d41dc01c435cf32e3cee029b429c9362bb9
parent04ad1cd54d99fc3ac3d82c69ee5f7c2db7e2275a (diff)
downloadghdl-48448a12ef628218db298d8b7c6879e28cdd019a.tar.gz
ghdl-48448a12ef628218db298d8b7c6879e28cdd019a.tar.bz2
ghdl-48448a12ef628218db298d8b7c6879e28cdd019a.zip
Sync tree: add parsing of AMS-VHDL, add Darwin syntax in asm files.
-rw-r--r--canon.adb39
-rw-r--r--configuration.adb3
-rw-r--r--disp_tree.adb92
-rw-r--r--disp_vhdl.adb126
-rw-r--r--disp_vhdl.ads4
-rw-r--r--errorout.adb24
-rw-r--r--files_map.adb1
-rw-r--r--flags.ads5
-rw-r--r--iirs.adb304
-rw-r--r--iirs.ads240
-rw-r--r--options.adb2
-rw-r--r--ortho/debug/ortho_debug.adb14
-rw-r--r--ortho/gcc/ortho-lang.c15
-rw-r--r--ortho/gcc/ortho_gcc.ads4
-rw-r--r--parse.adb509
-rw-r--r--scan.adb74
-rw-r--r--sem.adb5
-rw-r--r--sem_decls.adb155
-rw-r--r--sem_expr.adb5
-rw-r--r--sem_names.adb56
-rw-r--r--sem_names.ads3
-rw-r--r--sem_scopes.adb5
-rw-r--r--sem_stmts.adb27
-rw-r--r--sem_types.adb53
-rw-r--r--sem_types.ads2
-rw-r--r--std_names.adb701
-rw-r--r--std_names.ads61
-rw-r--r--tokens.adb32
-rw-r--r--tokens.ads17
-rw-r--r--translate/gcc/Make-lang.in2
-rw-r--r--translate/ghdldrv/Makefile4
-rw-r--r--translate/ghdldrv/ghdlprint.adb15
-rw-r--r--translate/grt/Makefile.inc2
-rw-r--r--translate/grt/config/amd64.S51
-rwxr-xr-x[-rw-r--r--]translate/grt/config/clock.c0
-rw-r--r--translate/grt/config/i386.S30
-rw-r--r--translate/grt/grt-values.adb4
-rw-r--r--translate/grt/grt-vcd.adb4
-rw-r--r--translate/translation.adb24
39 files changed, 2161 insertions, 553 deletions
diff --git a/canon.adb b/canon.adb
index b5ab047a2..58136a5ec 100644
--- a/canon.adb
+++ b/canon.adb
@@ -1635,6 +1635,12 @@ package body Canon is
end case;
end;
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ if Canon_Flag_Expressions then
+ Canon_Expression (Get_Simultaneous_Left (El));
+ Canon_Expression (Get_Simultaneous_Right (El));
+ end if;
+
when others =>
Error_Kind ("canon_concurrent_stmts", El);
end case;
@@ -2201,6 +2207,13 @@ package body Canon is
when Iir_Kinds_Signal_Attribute =>
null;
+
+ when Iir_Kind_Nature_Declaration =>
+ null;
+ when Iir_Kind_Terminal_Declaration =>
+ null;
+ when Iir_Kinds_Quantity_Declaration =>
+ null;
when others =>
Error_Kind ("canon_declaration", Decl);
end case;
@@ -2394,12 +2407,15 @@ package body Canon is
end if;
end if;
end;
+
when Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Process_Statement
| Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Default_Clock
- | Iir_Kind_Psl_Declaration =>
+ | Iir_Kind_Psl_Declaration
+ | Iir_Kind_Simple_Simultaneous_Statement =>
null;
+
when others =>
Error_Kind ("canon_block_configuration(3)", El);
end case;
@@ -2430,16 +2446,17 @@ package body Canon is
-- This code is not executed since context clauses are already
-- canonicalized.
El := Get_Context_Items (Unit);
--- while El /= Null_Iir loop
--- case Get_Kind (El) is
--- when Iir_Kind_Use_Clause =>
--- null;
--- when Iir_Kind_Library_Clause =>
--- null;
--- when others =>
--- Error_Kind ("canonicalize1", El);
--- end case;
--- end loop;
+ while El /= Null_Iir loop
+ case Get_Kind (El) is
+ when Iir_Kind_Use_Clause =>
+ null;
+ when Iir_Kind_Library_Clause =>
+ null;
+ when others =>
+ Error_Kind ("canonicalize1", El);
+ end case;
+ El := Get_Chain (El);
+ end loop;
end if;
El := Get_Library_Unit (Unit);
diff --git a/configuration.adb b/configuration.adb
index 678f8a47d..7fdcfb0b0 100644
--- a/configuration.adb
+++ b/configuration.adb
@@ -220,7 +220,8 @@ package body Configuration is
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Default_Clock
- | Iir_Kind_Psl_Declaration =>
+ | Iir_Kind_Psl_Declaration
+ | Iir_Kind_Simple_Simultaneous_Statement =>
null;
when others =>
Error_Kind ("add_design_concurrent_stmts(2)", Stmt);
diff --git a/disp_tree.adb b/disp_tree.adb
index 12c91d3b3..0656aa9da 100644
--- a/disp_tree.adb
+++ b/disp_tree.adb
@@ -270,6 +270,23 @@ package body Disp_Tree is
when Iir_Kind_Subtype_Declaration =>
Put ("subtype_declaration");
Disp_Identifier (Tree);
+
+ when Iir_Kind_Nature_Declaration =>
+ Put ("nature_declaration");
+ Disp_Identifier (Tree);
+ when Iir_Kind_Subnature_Declaration =>
+ Put ("subnature_declaration");
+ Disp_Identifier (Tree);
+ when Iir_Kind_Terminal_Declaration =>
+ Put ("terminal_declaration");
+ Disp_Identifier (Tree);
+ when Iir_Kind_Through_Quantity_Declaration =>
+ Put ("through_quantity_declaration");
+ Disp_Identifier (Tree);
+ when Iir_Kind_Across_Quantity_Declaration =>
+ Put ("across_quantity_declaration");
+ Disp_Identifier (Tree);
+
when Iir_Kind_Component_Declaration =>
Put ("component_declaration");
Disp_Identifier (Tree);
@@ -335,6 +352,10 @@ package body Disp_Tree is
when Iir_Kind_Physical_Subtype_Definition =>
Put_Line ("physical_subtype_definition");
+ when Iir_Kind_Scalar_Nature_Definition =>
+ Put ("scalar_nature_definition");
+ Disp_Identifier (Get_Nature_Declarator (Tree));
+
when Iir_Kind_Simple_Name =>
Put ("simple_name ");
Disp_Identifier (Tree);
@@ -989,6 +1010,15 @@ package body Disp_Tree is
end if;
Header ("type (definition):");
Disp_Tree (Get_Type (Tree), Ntab);
+ when Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration =>
+ if Flat_Decl then
+ return;
+ end if;
+ Header ("nature (definition):");
+ Disp_Tree (Get_Nature (Tree), Ntab);
+ Header ("attribute_value_chain:");
+ Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
when Iir_Kind_Component_Declaration =>
if Flat_Decl then
return;
@@ -1013,6 +1043,39 @@ package body Disp_Tree is
end if;
Header ("type:");
Disp_Tree (Get_Type (Tree), Ntab, True);
+ when Iir_Kind_Terminal_Declaration =>
+ if Flat_Decl then
+ return;
+ end if;
+ Header ("nature:");
+ Disp_Tree (Get_Nature (Tree), Ntab, True);
+ when Iir_Kind_Free_Quantity_Declaration =>
+ if Flat_Decl then
+ return;
+ end if;
+ Header ("type:");
+ Disp_Tree (Get_Type (Tree), Ntab, True);
+ Header ("default value:");
+ Disp_Tree (Get_Default_Value (Tree), Ntab, True);
+ Header ("attribute_value_chain:");
+ Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+ when Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration =>
+ if Flat_Decl then
+ return;
+ end if;
+ Header ("type:");
+ Disp_Tree (Get_Type (Tree), Ntab, True);
+ Header ("default value:");
+ Disp_Tree (Get_Default_Value (Tree), Ntab, True);
+ Header ("plus terminal:");
+ Disp_Tree (Get_Plus_Terminal (Tree), Ntab, True);
+ Header ("minus terminal:");
+ Disp_Tree (Get_Minus_Terminal (Tree), Ntab, True);
+ Header ("tolerance:");
+ Disp_Tree (Get_Tolerance (Tree), Ntab, True);
+ Header ("attribute_value_chain:");
+ Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
when Iir_Kind_Psl_Declaration =>
if Flat_Decl then
return;
@@ -1151,6 +1214,12 @@ package body Disp_Tree is
Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab);
Header ("range constraint:");
Disp_Tree (Get_Range_Constraint (Tree), Ntab);
+ if Kind = Iir_Kind_Floating_Subtype_Definition
+ or else Kind = Iir_Kind_Subtype_Definition
+ then
+ Header ("tolerance");
+ Disp_Tree (Get_Tolerance (Tree), Ntab);
+ end if;
when Iir_Kind_Range_Expression =>
Header ("staticness:", false);
Disp_Expr_Staticness (Tree);
@@ -1340,6 +1409,19 @@ package body Disp_Tree is
Header ("declarative_part:");
Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+ when Iir_Kind_Scalar_Nature_Definition =>
+ if Flat_Decl then
+ return;
+ end if;
+ Header ("across_type:");
+ Disp_Tree_Flat (Get_Across_Type (Tree), Ntab);
+ Header ("through_type:");
+ Disp_Tree_Flat (Get_Through_Type (Tree), Ntab);
+ Header ("reference: ", False);
+ Disp_Tree_Flat (Get_Reference (Tree), Ntab);
+ Header ("nature_declarator:");
+ Disp_Tree_Flat (Get_Nature_Declarator (Tree), Ntab);
+
when Iir_Kind_Block_Statement =>
if Flat_Decl then
return;
@@ -1429,6 +1511,16 @@ package body Disp_Tree is
when Iir_Kind_Psl_Default_Clock =>
null;
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ Header ("left:");
+ Disp_Tree (Get_Simultaneous_Left (Tree), Ntab);
+ Header ("right:");
+ Disp_Tree (Get_Simultaneous_Right (Tree), Ntab);
+ Header ("tolerance:");
+ Disp_Tree (Get_Tolerance (Tree), Ntab, True);
+ Header ("attribute_value_chain:");
+ Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
when Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Process_Statement =>
Disp_Label (Tree);
diff --git a/disp_vhdl.adb b/disp_vhdl.adb
index 98851aefa..0bfb4b01d 100644
--- a/disp_vhdl.adb
+++ b/disp_vhdl.adb
@@ -52,8 +52,8 @@ package body Disp_Vhdl is
-- end Disp_Tab;
procedure Disp_Type (A_Type: Iir);
+ procedure Disp_Nature (Nature : Iir);
- procedure Disp_Expression (Expr: Iir);
procedure Disp_Concurrent_Statement (Stmt: Iir);
procedure Disp_Concurrent_Statement_Chain (Parent: Iir; Indent : Count);
procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count);
@@ -145,7 +145,10 @@ package body Disp_Vhdl is
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Iterator_Declaration
| Iir_Kind_Library_Declaration
- | Iir_Kind_Unit_Declaration =>
+ | Iir_Kind_Unit_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Terminal_Declaration
+ | Iir_Kinds_Quantity_Declaration =>
Disp_Identifier (Decl);
when Iir_Kind_Anonymous_Type_Declaration =>
Put ('<');
@@ -212,7 +215,8 @@ package body Disp_Vhdl is
| Iir_Kind_Implicit_Procedure_Declaration
| Iir_Kind_Variable_Declaration
| Iir_Kind_Function_Declaration
- | Iir_Kind_Procedure_Declaration =>
+ | Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Terminal_Declaration =>
Disp_Name_Of (Name);
when others =>
Error_Kind ("disp_name", Name);
@@ -383,6 +387,15 @@ package body Disp_Vhdl is
end case;
end Disp_Element_Constraint;
+ procedure Disp_Tolerance_Opt (N : Iir) is
+ Tol : constant Iir := Get_Tolerance (N);
+ begin
+ if Tol /= Null_Iir then
+ Put ("tolerance ");
+ Disp_Expression (Tol);
+ end if;
+ end Disp_Tolerance_Opt;
+
procedure Disp_Subtype_Indication (Def : Iir; Full_Decl : Boolean := False)
is
Type_Mark : Iir;
@@ -420,6 +433,9 @@ package body Disp_Vhdl is
end if;
Disp_Expression (Get_Range_Constraint (Def));
end if;
+ if Get_Kind (Base_Type) = Iir_Kind_Floating_Type_Definition then
+ Disp_Tolerance_Opt (Def);
+ end if;
when Iir_Kind_Array_Type_Definition =>
Disp_Array_Element_Constraint (Def, Type_Mark);
when Iir_Kind_Record_Type_Definition =>
@@ -729,6 +745,42 @@ package body Disp_Vhdl is
end if;
end Disp_Type;
+ procedure Disp_Nature_Definition (Def : Iir) is
+ begin
+ case Get_Kind (Def) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ Disp_Subtype_Indication (Get_Across_Type (Def));
+ Put (" across ");
+ Disp_Subtype_Indication (Get_Through_Type (Def));
+ Put (" through ");
+ Disp_Name_Of (Get_Reference (Def));
+ Put (" reference");
+ when others =>
+ Error_Kind ("disp_nature_definition", Def);
+ end case;
+ end Disp_Nature_Definition;
+
+ procedure Disp_Nature_Declaration (Decl : Iir) is
+ begin
+ Put ("nature ");
+ Disp_Name_Of (Decl);
+ Put (" is ");
+ Disp_Nature_Definition (Get_Nature (Decl));
+ Put_Line (";");
+ end Disp_Nature_Declaration;
+
+ procedure Disp_Nature (Nature : Iir)
+ is
+ Decl: Iir;
+ begin
+ Decl := Get_Nature_Declarator (Nature);
+ if Decl /= Null_Iir then
+ Disp_Name_Of (Decl);
+ else
+ Error_Kind ("disp_nature", Nature);
+ end if;
+ end Disp_Nature;
+
procedure Disp_Mode (Mode: Iir_Mode) is
begin
case Mode is
@@ -948,6 +1000,56 @@ package body Disp_Vhdl is
Put (';');
end Disp_File_Declaration;
+ procedure Disp_Quantity_Declaration (Decl: Iir)
+ is
+ Expr : Iir;
+ Term : Iir;
+ begin
+ Put ("quantity ");
+ Disp_Name_Of (Decl);
+
+ case Get_Kind (Decl) is
+ when Iir_Kinds_Branch_Quantity_Declaration =>
+ Disp_Tolerance_Opt (Decl);
+ Expr := Get_Default_Value (Decl);
+ if Expr /= Null_Iir then
+ Put (":= ");
+ Disp_Expression (Expr);
+ end if;
+ if Get_Kind (Decl) = Iir_Kind_Across_Quantity_Declaration then
+ Put (" across ");
+ else
+ Put (" through ");
+ end if;
+ Disp_Name_Of (Get_Plus_Terminal (Decl));
+ Term := Get_Minus_Terminal (Decl);
+ if Term /= Null_Iir then
+ Put (" to ");
+ Disp_Name_Of (Term);
+ end if;
+ when Iir_Kind_Free_Quantity_Declaration =>
+ Put (": ");
+ Disp_Type (Get_Type (Decl));
+ Expr := Get_Default_Value (Decl);
+ if Expr /= Null_Iir then
+ Put (":= ");
+ Disp_Expression (Expr);
+ end if;
+ when others =>
+ raise Program_Error;
+ end case;
+ Put (';');
+ end Disp_Quantity_Declaration;
+
+ procedure Disp_Terminal_Declaration (Decl: Iir) is
+ begin
+ Put ("terminal ");
+ Disp_Name_Of (Decl);
+ Put (": ");
+ Disp_Nature (Get_Nature (Decl));
+ Put (';');
+ end Disp_Terminal_Declaration;
+
procedure Disp_Object_Declaration (Decl: Iir) is
begin
case Get_Kind (Decl) is
@@ -1159,6 +1261,12 @@ package body Disp_Vhdl is
Disp_Component_Declaration (Decl);
when Iir_Kinds_Object_Declaration =>
Disp_Object_Declaration (Decl);
+ when Iir_Kind_Terminal_Declaration =>
+ Disp_Terminal_Declaration (Decl);
+ when Iir_Kinds_Quantity_Declaration =>
+ Disp_Quantity_Declaration (Decl);
+ when Iir_Kind_Nature_Declaration =>
+ Disp_Nature_Declaration (Decl);
when Iir_Kind_Non_Object_Alias_Declaration =>
Disp_Non_Object_Alias_Declaration (Decl);
when Iir_Kind_Implicit_Function_Declaration
@@ -2201,6 +2309,16 @@ package body Disp_Vhdl is
end if;
end Disp_Psl_Assert_Statement;
+ procedure Disp_Simple_Simultaneous_Statement (Stmt : Iir)
+ is
+ begin
+ Disp_Label (Get_Label (Stmt));
+ Disp_Expression (Get_Simultaneous_Left (Stmt));
+ Put (" == ");
+ Disp_Expression (Get_Simultaneous_Right (Stmt));
+ Put_Line (";");
+ end Disp_Simple_Simultaneous_Statement;
+
procedure Disp_Concurrent_Statement (Stmt: Iir) is
begin
case Get_Kind (Stmt) is
@@ -2225,6 +2343,8 @@ package body Disp_Vhdl is
Disp_Psl_Default_Clock (Stmt);
when Iir_Kind_Psl_Assert_Statement =>
Disp_Psl_Assert_Statement (Stmt);
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ Disp_Simple_Simultaneous_Statement (Stmt);
when others =>
Error_Kind ("disp_concurrent_statement", Stmt);
end case;
diff --git a/disp_vhdl.ads b/disp_vhdl.ads
index 6bac04e70..880290efd 100644
--- a/disp_vhdl.ads
+++ b/disp_vhdl.ads
@@ -24,6 +24,9 @@ package Disp_Vhdl is
-- the node.
procedure Disp_Vhdl (An_Iir: Iir);
+ procedure Disp_Expression (Expr: Iir);
+ -- Display an expression.
+
-- Disp an iir_int64, without the leading blank.
procedure Disp_Int64 (Val: Iir_Int64);
@@ -33,4 +36,3 @@ package Disp_Vhdl is
-- Disp an iir_Fp64, without the leading blank.
procedure Disp_Fp64 (Val: Iir_Fp64);
end Disp_Vhdl;
-
diff --git a/errorout.adb b/errorout.adb
index 9b2e4a687..15309f853 100644
--- a/errorout.adb
+++ b/errorout.adb
@@ -463,6 +463,9 @@ package body Errorout is
when Iir_Kind_Overload_List =>
return "overloaded name or expression";
+ when Iir_Kind_Integer_Type_Definition
+ | Iir_Kind_Enumeration_Type_Definition =>
+ return Iirs_Utils.Image_Identifier (Get_Type_Declarator (Node));
when Iir_Kind_Array_Type_Definition =>
return Disp_Type (Node, "array type");
when Iir_Kind_Array_Subtype_Definition =>
@@ -497,6 +500,9 @@ package body Errorout is
when Iir_Kind_Subtype_Definition =>
return "subtype definition";
+ when Iir_Kind_Scalar_Nature_Definition =>
+ return Iirs_Utils.Image_Identifier (Get_Nature_Declarator (Node));
+
when Iir_Kind_Choice_By_Expression =>
return "choice by expression";
when Iir_Kind_Choice_By_Range =>
@@ -508,9 +514,6 @@ package body Errorout is
when Iir_Kind_Choice_By_None =>
return "positionnal choice";
- when Iir_Kind_Integer_Type_Definition
- | Iir_Kind_Enumeration_Type_Definition =>
- return Iirs_Utils.Image_Identifier (Get_Type_Declarator (Node));
when Iir_Kind_Function_Call =>
return "function call";
when Iir_Kind_Procedure_Call_Statement =>
@@ -667,6 +670,11 @@ package body Errorout is
when Iir_Kind_Subtype_Declaration =>
return Disp_Identifier (Node, "subtype");
+ when Iir_Kind_Nature_Declaration =>
+ return Disp_Identifier (Node, "nature");
+ when Iir_Kind_Subnature_Declaration =>
+ return Disp_Identifier (Node, "subnature");
+
when Iir_Kind_Component_Instantiation_Statement =>
return Disp_Identifier (Node, "component instance");
when Iir_Kind_Configuration_Specification =>
@@ -689,9 +697,19 @@ package body Errorout is
when Iir_Kind_Generate_Statement =>
return "generate statement";
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ return "simple simultaneous statement";
+
when Iir_Kind_Psl_Declaration =>
return Disp_Identifier (Node, "PSL declaration");
+ when Iir_Kind_Terminal_Declaration =>
+ return Disp_Identifier (Node, "terminal declaration");
+ when Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration =>
+ return Disp_Identifier (Node, "quantity declaration");
+
when Iir_Kind_Attribute_Declaration =>
return Disp_Identifier (Node, "attribute");
when Iir_Kind_Attribute_Specification =>
diff --git a/files_map.adb b/files_map.adb
index 4aff442b3..ed2b3f208 100644
--- a/files_map.adb
+++ b/files_map.adb
@@ -754,6 +754,7 @@ package body Files_Map is
return Res;
end if;
+ -- Open the file (punt on non regular files).
declare
Filename : String := Get_Pathname (Directory, Name, True);
begin
diff --git a/flags.ads b/flags.ads
index 804643b2a..c79936d54 100644
--- a/flags.ads
+++ b/flags.ads
@@ -28,9 +28,12 @@ package Flags is
type Vhdl_Std_Type is
(Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02, Vhdl_08);
- -- Standard accepted.
+ -- Standard accepted.
Vhdl_Std: Vhdl_Std_Type := Vhdl_93c;
+ -- Enable AMS-VHDL extensions.
+ AMS_Vhdl : Boolean := False;
+
-- Some flags (such as vhdl version) must be the same for every design
-- units of a hierarchy.
-- The Flag_String is a signature of all these flags.
diff --git a/iirs.adb b/iirs.adb
index 4cc9a59ba..3bb39dc43 100644
--- a/iirs.adb
+++ b/iirs.adb
@@ -152,7 +152,7 @@ package body Iirs is
raise Internal_Error;
else
Error_Msg_Sem ("Aborting compilation due to previous errors.",
- An_Iir);
+ An_Iir);
raise Compilation_Error;
end if;
end if;
@@ -375,10 +375,8 @@ package body Iirs is
| Iir_Kind_File_Type_Definition
| Iir_Kind_Protected_Type_Declaration
| Iir_Kind_Record_Type_Definition
- | Iir_Kind_Record_Subtype_Definition
| Iir_Kind_Access_Subtype_Definition
| Iir_Kind_Physical_Subtype_Definition
- | Iir_Kind_Floating_Subtype_Definition
| Iir_Kind_Integer_Subtype_Definition
| Iir_Kind_Enumeration_Subtype_Definition
| Iir_Kind_Enumeration_Type_Definition
@@ -387,11 +385,12 @@ package body Iirs is
| Iir_Kind_Physical_Type_Definition
| Iir_Kind_Range_Expression
| Iir_Kind_Protected_Type_Body
- | Iir_Kind_Subtype_Definition
| Iir_Kind_Overload_List
| Iir_Kind_Type_Declaration
| Iir_Kind_Anonymous_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Configuration_Declaration
| Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body
@@ -400,6 +399,7 @@ package body Iirs is
| Iir_Kind_Group_Declaration
| Iir_Kind_Element_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
+ | Iir_Kind_Terminal_Declaration
| Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body
| Iir_Kind_Object_Alias_Declaration
@@ -508,12 +508,19 @@ package body Iirs is
| Iir_Kind_Attribute_Specification
| Iir_Kind_Array_Type_Definition
| Iir_Kind_Array_Subtype_Definition
+ | Iir_Kind_Record_Subtype_Definition
+ | Iir_Kind_Floating_Subtype_Definition
+ | Iir_Kind_Subtype_Definition
+ | Iir_Kind_Scalar_Nature_Definition
| Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Declaration
| Iir_Kind_Unit_Declaration
| Iir_Kind_Library_Declaration
| Iir_Kind_Component_Declaration
| Iir_Kind_Psl_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
| Iir_Kind_Implicit_Procedure_Declaration
@@ -538,6 +545,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Assertion_Statement
| Iir_Kind_Report_Statement
@@ -1846,9 +1854,14 @@ package body Iirs is
when Iir_Kind_Design_Unit
| Iir_Kind_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Unit_Declaration
| Iir_Kind_Component_Declaration
| Iir_Kind_Group_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
| Iir_Kind_Implicit_Procedure_Declaration
@@ -1874,6 +1887,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -2117,6 +2131,8 @@ package body Iirs is
| Iir_Kind_Type_Declaration
| Iir_Kind_Anonymous_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Unit_Declaration
| Iir_Kind_Library_Declaration
| Iir_Kind_Component_Declaration
@@ -2125,6 +2141,10 @@ package body Iirs is
| Iir_Kind_Group_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Psl_Declaration
+ | Iir_Kind_Terminal_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Body
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
@@ -2152,6 +2172,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -2259,6 +2280,9 @@ package body Iirs is
| Iir_Kind_Unit_Declaration
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Element_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
| Iir_Kind_Enumeration_Literal
@@ -2397,6 +2421,30 @@ package body Iirs is
Set_Field4 (Target, Def);
end Set_Subtype_Definition;
+ procedure Check_Kind_For_Nature (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
+ | Iir_Kind_Terminal_Declaration =>
+ null;
+ when others =>
+ Failed ("Nature", Target);
+ end case;
+ end Check_Kind_For_Nature;
+
+ function Get_Nature (Target : Iir) return Iir is
+ begin
+ Check_Kind_For_Nature (Target);
+ return Get_Field1 (Target);
+ end Get_Nature;
+
+ procedure Set_Nature (Target : Iir; Nature : Iir) is
+ begin
+ Check_Kind_For_Nature (Target);
+ Set_Field1 (Target, Nature);
+ end Set_Nature;
+
procedure Check_Kind_For_Mode (Target : Iir) is
begin
case Get_Kind (Target) is
@@ -2452,6 +2500,9 @@ package body Iirs is
case Get_Kind (Target) is
when Iir_Kind_Attribute_Value
| Iir_Kind_Operator_Symbol
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Enumeration_Literal
| Iir_Kind_Object_Alias_Declaration
| Iir_Kind_File_Declaration
@@ -2797,7 +2848,10 @@ package body Iirs is
procedure Check_Kind_For_Default_Value (Target : Iir) is
begin
case Get_Kind (Target) is
- when Iir_Kind_Signal_Declaration
+ when Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
+ | Iir_Kind_Signal_Declaration
| Iir_Kind_Variable_Declaration
| Iir_Kind_Constant_Declaration
| Iir_Kind_Constant_Interface_Declaration
@@ -3351,6 +3405,8 @@ package body Iirs is
| Iir_Kind_Type_Declaration
| Iir_Kind_Anonymous_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Configuration_Declaration
| Iir_Kind_Entity_Declaration
| Iir_Kind_Package_Declaration
@@ -3365,6 +3421,10 @@ package body Iirs is
| Iir_Kind_Element_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Psl_Declaration
+ | Iir_Kind_Terminal_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
| Iir_Kind_Implicit_Procedure_Declaration
@@ -3392,6 +3452,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -3439,6 +3500,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -3478,6 +3540,8 @@ package body Iirs is
| Iir_Kind_Record_Element_Constraint
| Iir_Kind_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Unit_Declaration
| Iir_Kind_Library_Declaration
| Iir_Kind_Component_Declaration
@@ -3487,6 +3551,10 @@ package body Iirs is
| Iir_Kind_Element_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Psl_Declaration
+ | Iir_Kind_Terminal_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
| Iir_Kind_Implicit_Procedure_Declaration
@@ -3513,6 +3581,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -3705,6 +3774,124 @@ package body Iirs is
Set_Field5 (Decl, Func);
end Set_Resolution_Function;
+ procedure Check_Kind_For_Tolerance (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Array_Subtype_Definition
+ | Iir_Kind_Record_Subtype_Definition
+ | Iir_Kind_Floating_Subtype_Definition
+ | Iir_Kind_Subtype_Definition
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
+ | Iir_Kind_Simple_Simultaneous_Statement =>
+ null;
+ when others =>
+ Failed ("Tolerance", Target);
+ end case;
+ end Check_Kind_For_Tolerance;
+
+ function Get_Tolerance (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Tolerance (Def);
+ return Get_Field7 (Def);
+ end Get_Tolerance;
+
+ procedure Set_Tolerance (Def : Iir; Tol : Iir) is
+ begin
+ Check_Kind_For_Tolerance (Def);
+ Set_Field7 (Def, Tol);
+ end Set_Tolerance;
+
+ procedure Check_Kind_For_Plus_Terminal (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration =>
+ null;
+ when others =>
+ Failed ("Plus_Terminal", Target);
+ end case;
+ end Check_Kind_For_Plus_Terminal;
+
+ function Get_Plus_Terminal (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Plus_Terminal (Def);
+ return Get_Field8 (Def);
+ end Get_Plus_Terminal;
+
+ procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir) is
+ begin
+ Check_Kind_For_Plus_Terminal (Def);
+ Set_Field8 (Def, Terminal);
+ end Set_Plus_Terminal;
+
+ procedure Check_Kind_For_Minus_Terminal (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration =>
+ null;
+ when others =>
+ Failed ("Minus_Terminal", Target);
+ end case;
+ end Check_Kind_For_Minus_Terminal;
+
+ function Get_Minus_Terminal (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Minus_Terminal (Def);
+ return Get_Field9 (Def);
+ end Get_Minus_Terminal;
+
+ procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir) is
+ begin
+ Check_Kind_For_Minus_Terminal (Def);
+ Set_Field9 (Def, Terminal);
+ end Set_Minus_Terminal;
+
+ procedure Check_Kind_For_Simultaneous_Left (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ null;
+ when others =>
+ Failed ("Simultaneous_Left", Target);
+ end case;
+ end Check_Kind_For_Simultaneous_Left;
+
+ function Get_Simultaneous_Left (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Simultaneous_Left (Def);
+ return Get_Field5 (Def);
+ end Get_Simultaneous_Left;
+
+ procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir) is
+ begin
+ Check_Kind_For_Simultaneous_Left (Def);
+ Set_Field5 (Def, Expr);
+ end Set_Simultaneous_Left;
+
+ procedure Check_Kind_For_Simultaneous_Right (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ null;
+ when others =>
+ Failed ("Simultaneous_Right", Target);
+ end case;
+ end Check_Kind_For_Simultaneous_Right;
+
+ function Get_Simultaneous_Right (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Simultaneous_Right (Def);
+ return Get_Field6 (Def);
+ end Get_Simultaneous_Right;
+
+ procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir) is
+ begin
+ Check_Kind_For_Simultaneous_Right (Def);
+ Set_Field6 (Def, Expr);
+ end Set_Simultaneous_Right;
+
procedure Check_Kind_For_Text_File_Flag (Target : Iir) is
begin
case Get_Kind (Target) is
@@ -3926,6 +4113,94 @@ package body Iirs is
Set_Field2 (Target, Dtype);
end Set_Designated_Type;
+ procedure Check_Kind_For_Reference (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ null;
+ when others =>
+ Failed ("Reference", Target);
+ end case;
+ end Check_Kind_For_Reference;
+
+ function Get_Reference (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Reference (Def);
+ return Get_Field2 (Def);
+ end Get_Reference;
+
+ procedure Set_Reference (Def : Iir; Ref : Iir) is
+ begin
+ Check_Kind_For_Reference (Def);
+ Set_Field2 (Def, Ref);
+ end Set_Reference;
+
+ procedure Check_Kind_For_Nature_Declarator (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ null;
+ when others =>
+ Failed ("Nature_Declarator", Target);
+ end case;
+ end Check_Kind_For_Nature_Declarator;
+
+ function Get_Nature_Declarator (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Nature_Declarator (Def);
+ return Get_Field3 (Def);
+ end Get_Nature_Declarator;
+
+ procedure Set_Nature_Declarator (Def : Iir; Decl : Iir) is
+ begin
+ Check_Kind_For_Nature_Declarator (Def);
+ Set_Field3 (Def, Decl);
+ end Set_Nature_Declarator;
+
+ procedure Check_Kind_For_Across_Type (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ null;
+ when others =>
+ Failed ("Across_Type", Target);
+ end case;
+ end Check_Kind_For_Across_Type;
+
+ function Get_Across_Type (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Across_Type (Def);
+ return Get_Field7 (Def);
+ end Get_Across_Type;
+
+ procedure Set_Across_Type (Def : Iir; Atype : Iir) is
+ begin
+ Check_Kind_For_Across_Type (Def);
+ Set_Field7 (Def, Atype);
+ end Set_Across_Type;
+
+ procedure Check_Kind_For_Through_Type (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ null;
+ when others =>
+ Failed ("Through_Type", Target);
+ end case;
+ end Check_Kind_For_Through_Type;
+
+ function Get_Through_Type (Def : Iir) return Iir is
+ begin
+ Check_Kind_For_Through_Type (Def);
+ return Get_Field8 (Def);
+ end Get_Through_Type;
+
+ procedure Set_Through_Type (Def : Iir; Atype : Iir) is
+ begin
+ Check_Kind_For_Through_Type (Def);
+ Set_Field8 (Def, Atype);
+ end Set_Through_Type;
+
procedure Check_Kind_For_Target (Target : Iir) is
begin
case Get_Kind (Target) is
@@ -5100,6 +5375,8 @@ package body Iirs is
| Iir_Kind_Type_Declaration
| Iir_Kind_Anonymous_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Configuration_Declaration
| Iir_Kind_Entity_Declaration
| Iir_Kind_Package_Declaration
@@ -5111,6 +5388,10 @@ package body Iirs is
| Iir_Kind_Group_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Psl_Declaration
+ | Iir_Kind_Terminal_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Body
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
@@ -5140,6 +5421,7 @@ package body Iirs is
| Iir_Kind_Block_Statement
| Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
+ | Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -5397,6 +5679,9 @@ package body Iirs is
| Iir_Kind_Attribute_Value
| Iir_Kind_Range_Expression
| Iir_Kind_Unit_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Enumeration_Literal
| Iir_Kind_Object_Alias_Declaration
| Iir_Kind_File_Declaration
@@ -5722,6 +6007,9 @@ package body Iirs is
begin
case Get_Kind (Target) is
when Iir_Kind_Attribute_Value
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Enumeration_Literal
| Iir_Kind_Object_Alias_Declaration
| Iir_Kind_File_Declaration
@@ -6757,12 +7045,18 @@ package body Iirs is
case Get_Kind (Target) is
when Iir_Kind_Type_Declaration
| Iir_Kind_Subtype_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration
| Iir_Kind_Component_Declaration
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Group_Template_Declaration
| Iir_Kind_Group_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Psl_Declaration
+ | Iir_Kind_Terminal_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration
| Iir_Kind_Implicit_Procedure_Declaration
diff --git a/iirs.ads b/iirs.ads
index 03538dc5b..e7f06aca0 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -809,6 +809,38 @@ package Iirs is
--
-- Get/Set_Use_Flag (Flag6)
+ -- Iir_Kind_Nature_Declaration (Short)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Get/Set_Nature (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Identifier (Field3)
+ --
+ -- Get/Set_Attribute_Value_Chain (Field4)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+ --
+ -- Get/Set_Use_Flag (Flag6)
+
+ -- Iir_Kind_Subnature_Declaration (Short)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Get/Set_Nature (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Identifier (Field3)
+ --
+ -- Get/Set_Attribute_Value_Chain (Field4)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+ --
+ -- Get/Set_Use_Flag (Flag6)
+
-- Iir_Kind_Signal_Interface_Declaration (Medium)
-- Iir_Kind_Constant_Interface_Declaration (Medium)
-- Iir_Kind_Variable_Interface_Declaration (Medium)
@@ -1262,6 +1294,75 @@ package Iirs is
--
-- Get/Set_Use_Flag (Flag6)
+ -- Iir_Kind_Terminal_Declaration (Short)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Get/Set_Nature (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Identifier (Field3)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+ --
+ -- Get/Set_Use_Flag (Flag6)
+
+ -- Iir_Kind_Free_Quantity_Declaration (Medium)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Get/Set_Type (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Identifier (Field3)
+ --
+ -- Get/Set_Attribute_Value_Chain (Field4)
+ --
+ -- Get/Set_Base_Name (Field5)
+ --
+ -- Get/Set_Default_Value (Field6)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+ --
+ -- Get/Set_Use_Flag (Flag6)
+ --
+ -- Get/Set_Expr_Staticness (State1)
+ --
+ -- Get/Set_Name_Staticness (State2)
+
+ -- Iir_Kind_Across_Quantity_Declaration (Medium)
+ -- Iir_Kind_Through_Quantity_Declaration (Medium)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Get/Set_Type (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Identifier (Field3)
+ --
+ -- Get/Set_Attribute_Value_Chain (Field4)
+ --
+ -- Get/Set_Base_Name (Field5)
+ --
+ -- Get/Set_Default_Value (Field6)
+ --
+ -- Get/Set_Tolerance (Field7)
+ --
+ -- Get/Set_Plus_Terminal (Field8)
+ --
+ -- Get/Set_Minus_Terminal (Field9)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+ --
+ -- Get/Set_Use_Flag (Flag6)
+ --
+ -- Get/Set_Expr_Staticness (State1)
+ --
+ -- Get/Set_Name_Staticness (State2)
+
-- Iir_Kind_Use_Clause (Short)
--
-- Get/Set_Parent (Field0)
@@ -1550,7 +1651,6 @@ package Iirs is
-- Iir_Kind_Enumeration_Subtype_Definition (Short)
-- Iir_Kind_Integer_Subtype_Definition (Short)
- -- Iir_Kind_Floating_Subtype_Definition (Short)
-- Iir_Kind_Physical_Subtype_Definition (Short)
--
-- Get/Set_Range_Constraint (Field1)
@@ -1571,6 +1671,28 @@ package Iirs is
--
-- Get/Set_Type_Staticness (State1)
+ -- Iir_Kind_Floating_Subtype_Definition (Medium)
+ --
+ -- Get/Set_Range_Constraint (Field1)
+ --
+ -- Get/Set_Type_Mark (Field2)
+ --
+ -- Get/Set_Type_Declarator (Field3)
+ --
+ -- Get/Set_Base_Type (Field4)
+ --
+ -- Get/Set_Resolution_Function (Field5)
+ --
+ -- Get/Set_Tolerance (Field7)
+ --
+ -- Get/Set_Resolved_Flag (Flag1)
+ --
+ -- Get/Set_Signal_Type_Flag (Flag2)
+ --
+ -- Get/Set_Has_Signal_Flag (Flag3)
+ --
+ -- Get/Set_Type_Staticness (State1)
+
-- Iir_Kind_Access_Subtype_Definition (Short)
--
-- Get/Set_Type_Staticness (State1)
@@ -1587,7 +1709,7 @@ package Iirs is
--
-- Get/Set_Signal_Type_Flag (Flag2)
- -- Iir_Kind_Record_Subtype_Definition (Short)
+ -- Iir_Kind_Record_Subtype_Definition (Medium)
--
-- Get/Set_Elements_Declaration_List (Field1)
--
@@ -1599,6 +1721,8 @@ package Iirs is
--
-- Get/Set_Resolution_Function (Field5)
--
+ -- Get/Set_Tolerance (Field7)
+ --
-- Get/Set_Resolved_Flag (Flag1)
--
-- Get/Set_Signal_Type_Flag (Flag2)
@@ -1623,6 +1747,8 @@ package Iirs is
--
-- Get/Set_Index_Subtype_List (Field6)
--
+ -- Get/Set_Tolerance (Field7)
+ --
-- Get/Set_Type_Staticness (State1)
--
-- Get/Set_Constraint_State (State2)
@@ -1647,7 +1773,7 @@ package Iirs is
--
-- Get/Set_Direction (State2)
- -- Iir_Kind_Subtype_Definition (Short)
+ -- Iir_Kind_Subtype_Definition (Medium)
-- Such a node is only created by parse and transformed into the correct
-- kind (enumeration_subtype, integer_subtype...) by sem.
--
@@ -1656,6 +1782,28 @@ package Iirs is
-- Get/Set_Type_Mark (Field2)
--
-- Get/Set_Resolution_Function (Field5)
+ --
+ -- Get/Set_Tolerance (Field7)
+
+ ------------------------
+ -- Nature definitions --
+ ------------------------
+
+ -- Iir_Kind_Scalar_Nature_Definition (Medium)
+ --
+ -- Get/Set_Reference (Field2)
+ --
+ -- Get/Set the declarator that has created this nature type.
+ -- Get/Set_Nature_Declarator (Field3)
+ --
+ -- C-- Get/Set_Base_Type (Field4)
+ --
+ -- Type staticness is always locally.
+ -- C-- Get/Set_Type_Staticness (State1)
+ --
+ -- Get/Set_Across_Type (Field7)
+ --
+ -- Get/Set_Through_Type (Field8)
---------------------------
-- concurrent statements --
@@ -1880,6 +2028,25 @@ package Iirs is
--
-- Get/Set_Visible_Flag (Flag4)
+ -- Iir_Kind_Simple_Simultaneous_Statement (Medium)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Label (Field3)
+ -- Get/Set_Identifier (Alias Field3)
+ --
+ -- Get/Set_Attribute_Value_Chain (Field4)
+ --
+ -- Get/Set_Simultaneous_Left (Field5)
+ --
+ -- Get/Set_Simultaneous_Right (Field6)
+ --
+ -- Get/Set_Tolerance (Field7)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+
---------------------------
-- sequential statements --
---------------------------
@@ -2599,6 +2766,9 @@ package Iirs is
Iir_Kind_Protected_Type_Body,
Iir_Kind_Subtype_Definition, -- temporary (must not appear after sem).
+ -- Nature definition
+ Iir_Kind_Scalar_Nature_Definition,
+
-- Lists.
Iir_Kind_Overload_List, -- used internally by sem_expr.
@@ -2606,6 +2776,8 @@ package Iirs is
Iir_Kind_Type_Declaration,
Iir_Kind_Anonymous_Type_Declaration,
Iir_Kind_Subtype_Declaration,
+ Iir_Kind_Nature_Declaration,
+ Iir_Kind_Subnature_Declaration,
Iir_Kind_Configuration_Declaration,
Iir_Kind_Entity_Declaration,
Iir_Kind_Package_Declaration,
@@ -2621,6 +2793,10 @@ package Iirs is
Iir_Kind_Non_Object_Alias_Declaration,
Iir_Kind_Psl_Declaration,
+ Iir_Kind_Terminal_Declaration,
+ Iir_Kind_Free_Quantity_Declaration,
+ Iir_Kind_Across_Quantity_Declaration,
+ Iir_Kind_Through_Quantity_Declaration,
Iir_Kind_Function_Body,
Iir_Kind_Function_Declaration,
@@ -2697,6 +2873,8 @@ package Iirs is
Iir_Kind_Generate_Statement,
Iir_Kind_Component_Instantiation_Statement,
+ Iir_Kind_Simple_Simultaneous_Statement,
+
-- Iir_Kind_Sequential_Statement
Iir_Kind_Signal_Assignment_Statement,
Iir_Kind_Null_Statement,
@@ -3266,6 +3444,15 @@ package Iirs is
--Iir_Kind_Signal_Interface_Declaration
Iir_Kind_File_Interface_Declaration;
+ subtype Iir_Kinds_Branch_Quantity_Declaration is Iir_Kind range
+ Iir_Kind_Across_Quantity_Declaration ..
+ Iir_Kind_Through_Quantity_Declaration;
+
+ subtype Iir_Kinds_Quantity_Declaration is Iir_Kind range
+ Iir_Kind_Free_Quantity_Declaration ..
+ --Iir_Kind_Across_Quantity_Declaration
+ Iir_Kind_Through_Quantity_Declaration;
+
subtype Iir_Kinds_Non_Alias_Object_Declaration is Iir_Kind range
Iir_Kind_File_Declaration ..
--Iir_Kind_Guard_Signal_Declaration
@@ -3440,6 +3627,8 @@ package Iirs is
Iir_Kind_Type_Declaration ..
--Iir_Kind_Anonymous_Type_Declaration
--Iir_Kind_Subtype_Declaration
+ --Iir_Kind_Nature_Declaration
+ --Iir_Kind_Subnature_Declaration
--Iir_Kind_Configuration_Declaration
--Iir_Kind_Entity_Declaration
--Iir_Kind_Package_Declaration
@@ -3454,6 +3643,10 @@ package Iirs is
--Iir_Kind_Element_Declaration
--Iir_Kind_Non_Object_Alias_Declaration
--Iir_Kind_Psl_Declaration
+ --Iir_Kind_Terminal_Declaration
+ --Iir_Kind_Free_Quantity_Declaration
+ --Iir_Kind_Across_Quantity_Declaration
+ --Iir_Kind_Through_Quantity_Declaration
--Iir_Kind_Function_Body
--Iir_Kind_Function_Declaration
--Iir_Kind_Implicit_Function_Declaration
@@ -4257,6 +4450,10 @@ package Iirs is
function Get_Subtype_Definition (Target : Iir) return Iir;
procedure Set_Subtype_Definition (Target : Iir; Def : Iir);
+ -- Field: Field1
+ function Get_Nature (Target : Iir) return Iir;
+ procedure Set_Nature (Target : Iir; Nature : Iir);
+
-- Mode of interfaces or file (v87).
-- Field: Odigit1 (pos)
function Get_Mode (Target : Iir) return Iir_Mode;
@@ -4506,6 +4703,26 @@ package Iirs is
function Get_Resolution_Function (Decl : Iir) return Iir;
procedure Set_Resolution_Function (Decl : Iir; Func : Iir);
+ -- Field: Field7
+ function Get_Tolerance (Def : Iir) return Iir;
+ procedure Set_Tolerance (Def : Iir; Tol : Iir);
+
+ -- Field: Field8
+ function Get_Plus_Terminal (Def : Iir) return Iir;
+ procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir);
+
+ -- Field: Field9
+ function Get_Minus_Terminal (Def : Iir) return Iir;
+ procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir);
+
+ -- Field: Field5
+ function Get_Simultaneous_Left (Def : Iir) return Iir;
+ procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir);
+
+ -- Field: Field6
+ function Get_Simultaneous_Right (Def : Iir) return Iir;
+ procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir);
+
-- True if ATYPE defines std.textio.text file type.
-- Field: Flag4
function Get_Text_File_Flag (Atype : Iir) return Boolean;
@@ -4545,6 +4762,23 @@ package Iirs is
function Get_Designated_Type (Target : Iir) return Iir;
procedure Set_Designated_Type (Target : Iir; Dtype : Iir);
+ -- The terminal declaration for the reference (ground) of a nature
+ -- Field: Field2
+ function Get_Reference (Def : Iir) return Iir;
+ procedure Set_Reference (Def : Iir; Ref : Iir);
+
+ -- Field: Field3
+ function Get_Nature_Declarator (Def : Iir) return Iir;
+ procedure Set_Nature_Declarator (Def : Iir; Decl : Iir);
+
+ -- Field: Field7
+ function Get_Across_Type (Def : Iir) return Iir;
+ procedure Set_Across_Type (Def : Iir; Atype : Iir);
+
+ -- Field: Field8
+ function Get_Through_Type (Def : Iir) return Iir;
+ procedure Set_Through_Type (Def : Iir; Atype : Iir);
+
-- Field: Field1
function Get_Target (Target : Iir) return Iir;
procedure Set_Target (Target : Iir; Atarget : Iir);
diff --git a/options.adb b/options.adb
index e95456f9c..a62b76da1 100644
--- a/options.adb
+++ b/options.adb
@@ -89,6 +89,8 @@ package body Options is
else
return False;
end if;
+ elsif Opt'Length = 5 and then Opt (Beg .. Beg + 4) = "--ams" then
+ AMS_Vhdl := True;
elsif Opt'Length > 2 and then Opt (Beg .. Beg + 1) = "-P" then
Libraries.Add_Library_Path (Opt (Beg + 2 .. Opt'Last));
elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--workdir=" then
diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
index 633fe7012..e2307b9e4 100644
--- a/ortho/debug/ortho_debug.adb
+++ b/ortho/debug/ortho_debug.adb
@@ -1307,11 +1307,13 @@ package body Ortho_Debug is
Add_Decl (Res);
end New_Const_Decl;
+ -- Const is not modified
+ pragma Warnings (Off, "*is not modified");
+
procedure Start_Const_Value (Const : in out O_Dnode)
is
subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value);
N : O_Dnode;
- Temp : constant O_Dnode := Const;
begin
if Const.Const_Value /= O_Dnode_Null then
-- Constant already has a value.
@@ -1334,16 +1336,13 @@ package body Ortho_Debug is
Lineno => 0,
Const_Decl => Const,
Value => O_Cnode_Null);
- Temp.Const_Value := N;
- Const := Temp;
+ Const.Const_Value := N;
Add_Decl (N, False);
end Start_Const_Value;
procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
is
- Temp : constant O_Dnode := Const;
begin
-
if Const.Const_Value = O_Dnode_Null then
-- Start_Const_Value not called.
raise Syntax_Error;
@@ -1357,10 +1356,11 @@ package body Ortho_Debug is
raise Type_Error;
end if;
Check_Type (Val.Ctype, Const.Dtype);
- Temp.Const_Value.Value := Val;
- Const := Temp;
+ Const.Const_Value.Value := Val;
end Finish_Const_Value;
+ pragma Warnings (On, "*is not modified");
+
procedure New_Var_Decl
(Res : out O_Dnode;
Ident : O_Ident;
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index f5cb2bd15..370bdd633 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -643,20 +643,21 @@ type_for_size (unsigned int precision, int unsignedp)
&& signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
return signed_and_unsigned_types[precision][unsignedp];
- if (unsignedp)
+ if (unsignedp)
t = make_unsigned_type (precision);
else
t = make_signed_type (precision);
if (precision <= MAX_BITS_PER_WORD)
signed_and_unsigned_types[precision][unsignedp] = t;
- else
- // Handle larger requests by returning a NULL tree and letting
+ else
+ // Handle larger requests by returning a NULL tree and letting
// the back end default to another approach.
- // the exact test is unknown : distinguishing between 32 and 64 bits may be enough
- // for all likely platforms
- if (MAX_BITS_PER_WORD >= 64) t = NULL_TREE;
-
+ // the exact test is unknown : distinguishing between 32 and 64 bits
+ // may be enough for all likely platforms
+ if (MAX_BITS_PER_WORD >= 64)
+ t = NULL_TREE;
+
return t;
}
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
index 9ec38cdd4..9b5356863 100644
--- a/ortho/gcc/ortho_gcc.ads
+++ b/ortho/gcc/ortho_gcc.ads
@@ -422,7 +422,6 @@ package Ortho_Gcc is
procedure New_Default_Choice (Block : in out O_Case_Block);
procedure Finish_Choice (Block : in out O_Case_Block);
procedure Finish_Case_Stmt (Block : in out O_Case_Block);
- procedure Debug_Tree_C(Expr : O_Cnode);
private
subtype Tree is System.Address;
@@ -658,7 +657,4 @@ private
pragma Import (C, New_Default_Choice);
pragma Import (C, Finish_Choice);
pragma Import (C, Finish_Case_Stmt);
-
- pragma Import (C, Debug_Tree_C);
-
end Ortho_Gcc;
diff --git a/parse.adb b/parse.adb
index dc1fad6f5..6410edd3b 100644
--- a/parse.adb
+++ b/parse.adb
@@ -51,7 +51,8 @@ package body Parse is
-- current_token must be valid.
-- Leaves a token.
- function Parse_Simple_Expression return Iir_Expression;
+ function Parse_Simple_Expression (Primary : Iir := Null_Iir)
+ return Iir_Expression;
function Parse_Primary return Iir_Expression;
function Parse_Use_Clause return Iir_Use_Clause;
@@ -1939,6 +1940,24 @@ package body Parse is
return Def;
end Parse_Element_Constraint;
+ -- precond : tolerance
+ -- postcond: next token
+ --
+ -- [ LRM93 4.2 ]
+ -- tolerance_aspect ::= TOLERANCE string_expression
+ function Parse_Tolerance_Aspect_Opt return Iir
+ is
+ begin
+ if AMS_Vhdl
+ and then Current_Token = Tok_Tolerance
+ then
+ Scan.Scan;
+ return Parse_Expression;
+ else
+ return Null_Iir;
+ end if;
+ end Parse_Tolerance_Aspect_Opt;
+
-- precond : identifier or '('
-- postcond: next token
--
@@ -1960,6 +1979,7 @@ package body Parse is
Type_Mark : Iir;
Def: Iir;
Resolution_Function: Iir;
+ Tolerance : Iir;
begin
-- FIXME: location.
Resolution_Function := Null_Iir;
@@ -1996,6 +2016,7 @@ package body Parse is
Def := Parse_Element_Constraint;
Set_Type_Mark (Def, Type_Mark);
Set_Resolution_Function (Def, Resolution_Function);
+ Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt);
when Tok_Range =>
-- range_constraint.
@@ -2004,13 +2025,18 @@ package body Parse is
Set_Type_Mark (Def, Type_Mark);
Set_Range_Constraint (Def, Parse_Range_Constraint);
Set_Resolution_Function (Def, Resolution_Function);
+ Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt);
when others =>
- if Resolution_Function /= Null_Iir then
+ Tolerance := Parse_Tolerance_Aspect_Opt;
+ if Resolution_Function /= Null_Iir
+ or else Tolerance /= Null_Iir
+ then
Def := Create_Iir (Iir_Kind_Subtype_Definition);
Location_Copy (Def, Type_Mark);
Set_Type_Mark (Def, Type_Mark);
Set_Resolution_Function (Def, Resolution_Function);
+ Set_Tolerance (Def, Tolerance);
else
Def := Type_Mark;
end if;
@@ -2042,6 +2068,417 @@ package body Parse is
return Decl;
end Parse_Subtype_Declaration;
+ -- precond : NATURE
+ -- postcond: a token
+ --
+ -- [ §4.8 ]
+ -- nature_definition ::= scalar_nature_definition
+ -- | composite_nature_definition
+ --
+ -- [ §3.5.1 ]
+ -- scalar_nature_definition ::= type_mark ACROSS
+ -- type_mark THROUGH
+ -- identifier REFERENCE
+ --
+ -- [ §3.5.2 ]
+ -- composite_nature_definition ::= array_nature_definition
+ -- | record_nature_definition
+ function Parse_Nature_Declaration return Iir
+ is
+ Def : Iir;
+ Ref : Iir;
+ Loc : Location_Type;
+ Ident : Name_Id;
+ Decl : Iir;
+ begin
+ -- The current token must be type.
+ if Current_Token /= Tok_Nature then
+ raise Program_Error;
+ end if;
+
+ -- Get the identifier
+ Scan_Expect (Tok_Identifier,
+ "an identifier is expected after 'nature'");
+ Loc := Get_Token_Location;
+ Ident := Current_Identifier;
+
+ Scan.Scan;
+
+ if Current_Token /= Tok_Is then
+ Error_Msg_Parse ("'is' expected here");
+ -- Act as if IS token was forgotten.
+ else
+ -- Eat IS token.
+ Scan.Scan;
+ end if;
+
+ case Current_Token is
+ when Tok_Array =>
+ -- TODO
+ Error_Msg_Parse ("array nature definition not supported");
+ Def := Null_Iir;
+ Eat_Tokens_Until_Semi_Colon;
+ when Tok_Record =>
+ -- TODO
+ Error_Msg_Parse ("record nature definition not supported");
+ Def := Null_Iir;
+ Eat_Tokens_Until_Semi_Colon;
+ when Tok_Identifier =>
+ Def := Create_Iir (Iir_Kind_Scalar_Nature_Definition);
+ Set_Location (Def, Loc);
+ Set_Across_Type (Def, Parse_Type_Mark);
+ if Current_Token = Tok_Across then
+ Scan.Scan;
+ else
+ Expect (Tok_Across, "'across' expected after type mark");
+ end if;
+ Set_Through_Type (Def, Parse_Type_Mark);
+ if Current_Token = Tok_Through then
+ Scan.Scan;
+ else
+ Expect (Tok_Across, "'through' expected after type mark");
+ end if;
+ if Current_Token = Tok_Identifier then
+ Ref := Create_Iir (Iir_Kind_Terminal_Declaration);
+ Set_Identifier (Ref, Current_Identifier);
+ Set_Location (Ref);
+ Set_Reference (Def, Ref);
+ Scan.Scan;
+ if Current_Token = Tok_Reference then
+ Scan.Scan;
+ else
+ Expect (Tok_Reference, "'reference' expected");
+ Eat_Tokens_Until_Semi_Colon;
+ end if;
+ else
+ Error_Msg_Parse ("reference identifier expected");
+ Eat_Tokens_Until_Semi_Colon;
+ end if;
+ when others =>
+ Error_Msg_Parse ("nature definition expected here");
+ Eat_Tokens_Until_Semi_Colon;
+ end case;
+
+ Decl := Create_Iir (Iir_Kind_Nature_Declaration);
+ Set_Nature (Decl, Def);
+ Set_Identifier (Decl, Ident);
+ Set_Location (Decl, Loc);
+
+ -- ';' is expected after end of type declaration
+ Expect (Tok_Semi_Colon);
+ Invalidate_Current_Token;
+ return Decl;
+ end Parse_Nature_Declaration;
+
+ -- precond : identifier
+ -- postcond: next token
+ --
+ -- LRM 4.8 Nature declaration
+ --
+ -- subnature_indication ::=
+ -- nature_mark [ index_constraint ]
+ -- [ TOLERANCE string_expression ACROSS string_expression THROUGH ]
+ --
+ -- nature_mark ::=
+ -- nature_name | subnature_name
+ function Parse_Subnature_Indication return Iir is
+ Nature_Mark : Iir;
+ begin
+ if Current_Token /= Tok_Identifier then
+ Error_Msg_Parse ("nature mark expected in a subnature indication");
+ raise Parse_Error;
+ end if;
+ Nature_Mark := Parse_Name (Allow_Indexes => False);
+
+ if Current_Token = Tok_Left_Paren then
+ -- TODO
+ Error_Msg_Parse
+ ("index constraint not supported for subnature indication");
+ raise Parse_Error;
+ end if;
+
+ if Current_Token = Tok_Tolerance then
+ Error_Msg_Parse
+ ("tolerance not supported for subnature indication");
+ raise Parse_Error;
+ end if;
+ return Nature_Mark;
+ end Parse_Subnature_Indication;
+
+ -- precond : TERMINAL
+ -- postcond: ;
+ --
+ -- [ 4.3.1.5 Terminal declarations ]
+ -- terminal_declaration ::=
+ -- TERMINAL identifier_list : subnature_indication
+ function Parse_Terminal_Declaration (Parent : Iir) return Iir
+ is
+ -- First and last element of the chain to be returned.
+ First, Last : Iir;
+ Terminal : Iir;
+ Subnature : Iir;
+ Proxy : Iir_Proxy;
+ begin
+ Sub_Chain_Init (First, Last);
+
+ loop
+ -- 'terminal' or "," was just scanned.
+ Terminal := Create_Iir (Iir_Kind_Terminal_Declaration);
+ Scan_Expect (Tok_Identifier);
+ Set_Identifier (Terminal, Current_Identifier);
+ Set_Location (Terminal);
+ Set_Parent (Terminal, Parent);
+
+ Sub_Chain_Append (First, Last, Terminal);
+
+ Scan.Scan;
+ exit when Current_Token = Tok_Colon;
+ if Current_Token /= Tok_Comma then
+ Error_Msg_Parse
+ ("',' or ':' is expected after "
+ & "identifier in terminal declaration");
+ raise Expect_Error;
+ end if;
+ end loop;
+
+ -- The colon was parsed.
+ Scan.Scan;
+ Subnature := Parse_Subnature_Indication;
+
+ Proxy := Null_Iir;
+ Terminal := First;
+ while Terminal /= Null_Iir loop
+ -- Type definitions are factorized. This is OK, but not done by
+ -- sem.
+ if Terminal = First then
+ Set_Nature (Terminal, Subnature);
+ else
+ -- FIXME: could avoid to create many proxies, by adding
+ -- a reference counter.
+ Proxy := Create_Iir (Iir_Kind_Proxy);
+ Set_Proxy (Proxy, First);
+ Set_Nature (Terminal, Proxy);
+ end if;
+ Terminal := Get_Chain (Terminal);
+ end loop;
+ Expect (Tok_Semi_Colon);
+ return First;
+ end Parse_Terminal_Declaration;
+
+ -- precond : QUANTITY
+ -- postcond: ;
+ --
+ -- [ 4.3.1.6 Quantity declarations ]
+ -- quantity_declaration ::=
+ -- free_quantity_declaration
+ -- | branch_quantity_declaration
+ -- | source_quantity_declaration
+ --
+ -- free_quantity_declaration ::=
+ -- QUANTITY identifier_list : subtype_indication [ := expression ] ;
+ --
+ -- branch_quantity_declaration ::=
+ -- QUANTITY [ across_aspect ] [ through_aspect ] terminal_aspect ;
+ --
+ -- source_quantity_declaration ::=
+ -- QUANTITY identifier_list : subtype_indication source_aspect ;
+ --
+ -- across_aspect ::=
+ -- identifier_list [ tolerance_aspect ] [ := expression ] ACROSS
+ --
+ -- through_aspect ::=
+ -- identifier_list [ tolerance_aspect ] [ := expression ] THROUGH
+ --
+ -- terminal_aspect ::=
+ -- plus_terminal_name [ TO minus_terminal_name ]
+ function Parse_Quantity_Declaration (Parent : Iir) return Iir
+ is
+ -- First and last element of the chain to be returned.
+ First, Last : Iir;
+ Object : Iir;
+ New_Object : Iir;
+ Tolerance : Iir;
+ Default_Value : Iir;
+ Kind : Iir_Kind;
+ Plus_Terminal : Iir;
+ Proxy : Iir;
+ First_Through : Iir;
+ begin
+ Sub_Chain_Init (First, Last);
+
+ -- Eat 'quantity'
+ Scan.Scan;
+
+ loop
+ -- Quantity or "," was just scanned. We assume a free quantity
+ -- declaration and will change to branch or source quantity if
+ -- necessary.
+ Object := Create_Iir (Iir_Kind_Free_Quantity_Declaration);
+ Expect (Tok_Identifier);
+ Set_Identifier (Object, Current_Identifier);
+ Set_Location (Object);
+ Set_Parent (Object, Parent);
+
+ Sub_Chain_Append (First, Last, Object);
+
+ -- Eat identifier
+ Scan.Scan;
+ exit when Current_Token /= Tok_Comma;
+
+ -- Eat ','
+ Scan.Scan;
+ end loop;
+
+ case Current_Token is
+ when Tok_Colon =>
+ -- Either a free quantity (or a source quantity)
+ -- TODO
+ raise Program_Error;
+ when Tok_Tolerance
+ | Tok_Assign
+ | Tok_Across
+ | Tok_Through =>
+ -- A branch quantity
+
+ -- Parse tolerance aspect
+ Tolerance := Parse_Tolerance_Aspect_Opt;
+
+ -- Parse default value
+ if Current_Token = Tok_Assign then
+ Scan.Scan;
+ Default_Value := Parse_Expression;
+ else
+ Default_Value := Null_Iir;
+ end if;
+
+ case Current_Token is
+ when Tok_Across =>
+ Kind := Iir_Kind_Across_Quantity_Declaration;
+ when Tok_Through =>
+ Kind := Iir_Kind_Through_Quantity_Declaration;
+ when others =>
+ Error_Msg_Parse ("'across' or 'through' expected here");
+ Eat_Tokens_Until_Semi_Colon;
+ raise Expect_Error;
+ end case;
+
+ -- Eat across/through
+ Scan.Scan;
+
+ -- Change declarations
+ Object := First;
+ Sub_Chain_Init (First, Last);
+ while Object /= Null_Iir loop
+ New_Object := Create_Iir (Kind);
+ Location_Copy (New_Object, Object);
+ Set_Identifier (New_Object, Get_Identifier (Object));
+ Set_Parent (New_Object, Parent);
+ Set_Tolerance (New_Object, Tolerance);
+ Set_Default_Value (New_Object, Default_Value);
+
+ Sub_Chain_Append (First, Last, New_Object);
+
+ if Object /= First then
+ Proxy := Create_Iir (Iir_Kind_Proxy);
+ Set_Proxy (Proxy, First);
+ Set_Plus_Terminal (New_Object, Proxy);
+ end if;
+ New_Object := Get_Chain (Object);
+ Free_Iir (Object);
+ Object := New_Object;
+ end loop;
+
+ -- Parse terminal (or first identifier of through declarations)
+ Plus_Terminal := Parse_Name;
+
+ case Current_Token is
+ when Tok_Comma
+ | Tok_Tolerance
+ | Tok_Assign
+ | Tok_Through
+ | Tok_Across =>
+ -- Through quantity declaration. Convert the Plus_Terminal
+ -- to a declaration.
+ Object := Create_Iir (Iir_Kind_Through_Quantity_Declaration);
+ New_Object := Object;
+ Location_Copy (Object, Plus_Terminal);
+ if Get_Kind (Plus_Terminal) /= Iir_Kind_Simple_Name then
+ Error_Msg_Parse
+ ("identifier for quantity declaration expected");
+ else
+ Set_Identifier (Object, Get_Identifier (Plus_Terminal));
+ end if;
+ Proxy := Create_Iir (Iir_Kind_Proxy);
+ Set_Proxy (Proxy, First);
+ Set_Plus_Terminal (Object, Proxy);
+ First_Through := Object;
+ Free_Iir (Plus_Terminal);
+
+ loop
+ Set_Parent (Object, Parent);
+ Sub_Chain_Append (First, Last, Object);
+ exit when Current_Token /= Tok_Comma;
+ Scan.Scan;
+
+ Object := Create_Iir
+ (Iir_Kind_Through_Quantity_Declaration);
+ Set_Location (Object);
+ if Current_Token /= Tok_Identifier then
+ Error_Msg_Parse
+ ("identifier for quantity declaration expected");
+ else
+ Set_Identifier (Object, Current_Identifier);
+ Scan.Scan;
+ end if;
+ Proxy := Create_Iir (Iir_Kind_Proxy);
+ Set_Proxy (Proxy, First_Through);
+ Set_Plus_Terminal (Object, Proxy);
+
+ end loop;
+
+ -- Parse tolerance aspect
+ Set_Tolerance (Object, Parse_Tolerance_Aspect_Opt);
+
+ -- Parse default value
+ if Current_Token = Tok_Assign then
+ Scan.Scan;
+ Set_Default_Value (Object, Parse_Expression);
+ end if;
+
+ -- Scan 'through'
+ if Current_Token = Tok_Through then
+ Scan.Scan;
+ elsif Current_Token = Tok_Across then
+ Error_Msg_Parse ("across quantity declaration must appear"
+ & " before though declaration");
+ Scan.Scan;
+ else
+ Error_Msg_Parse ("'through' expected");
+ end if;
+
+ -- Parse plus terminal
+ Plus_Terminal := Parse_Name;
+ when others =>
+ null;
+ end case;
+
+ Set_Plus_Terminal (First, Plus_Terminal);
+
+ -- Parse minus terminal (if present)
+ if Current_Token = Tok_To then
+ Scan.Scan;
+ Set_Minus_Terminal (First, Parse_Name);
+ end if;
+ when others =>
+ Error_Msg_Parse ("missign type or across/throught aspect "
+ & "in quantity declaration");
+ Eat_Tokens_Until_Semi_Colon;
+ raise Expect_Error;
+ end case;
+ Expect (Tok_Semi_Colon);
+ return First;
+ end Parse_Quantity_Declaration;
+
-- precond : token (CONSTANT, SIGNAL, VARIABLE, FILE)
-- postcond: ;
--
@@ -2762,6 +3199,12 @@ package body Parse is
end if;
when Tok_Subtype =>
Decl := Parse_Subtype_Declaration;
+ when Tok_Nature =>
+ Decl := Parse_Nature_Declaration;
+ when Tok_Terminal =>
+ Decl := Parse_Terminal_Declaration (Parent);
+ when Tok_Quantity =>
+ Decl := Parse_Quantity_Declaration (Parent);
when Tok_Signal =>
case Get_Kind (Parent) is
when Iir_Kind_Function_Body
@@ -3254,24 +3697,34 @@ package body Parse is
-- factor ::= primary [ ** primary ]
-- | ABS primary
-- | NOT primary
- function Parse_Factor return Iir_Expression is
+ function Parse_Factor (Primary : Iir := Null_Iir) return Iir_Expression is
Res, Tmp: Iir_Expression;
begin
case Current_Token is
when Tok_Abs =>
+ if Primary /= Null_Iir then
+ return Primary;
+ end if;
Scan.Scan;
Res := Create_Iir (Iir_Kind_Absolute_Operator);
Set_Location (Res);
Set_Operand (Res, Parse_Primary);
return Res;
when Tok_Not =>
+ if Primary /= Null_Iir then
+ return Primary;
+ end if;
Res := Create_Iir (Iir_Kind_Not_Operator);
Set_Location (Res);
Scan.Scan;
Set_Operand (Res, Parse_Primary);
return Res;
when others =>
- Tmp := Parse_Primary;
+ if Primary /= Null_Iir then
+ Tmp := Primary;
+ else
+ Tmp := Parse_Primary;
+ end if;
if Current_Token = Tok_Double_Star then
Res := Create_Iir (Iir_Kind_Exponentiation_Operator);
Set_Location (Res);
@@ -3293,10 +3746,10 @@ package body Parse is
--
-- [ §7.2 ]
-- multiplying_operator ::= * | / | MOD | REM
- function Parse_Term return Iir_Expression is
+ function Parse_Term (Primary : Iir) return Iir_Expression is
Res, Tmp: Iir_Expression;
begin
- Res := Parse_Factor;
+ Res := Parse_Factor (Primary);
while Current_Token in Token_Multiplying_Operator_Type loop
case Current_Token is
when Tok_Star =>
@@ -3330,10 +3783,14 @@ package body Parse is
--
-- [ §7.2 ]
-- adding_operator ::= + | - | &
- function Parse_Simple_Expression return Iir_Expression is
+ function Parse_Simple_Expression (Primary : Iir := Null_Iir)
+ return Iir_Expression
+ is
Res, Tmp: Iir_Expression;
begin
- if Current_Token in Token_Sign_Type then
+ if Current_Token in Token_Sign_Type
+ and then Primary = Null_Iir
+ then
case Current_Token is
when Tok_Plus =>
Res := Create_Iir (Iir_Kind_Identity_Operator);
@@ -3344,9 +3801,9 @@ package body Parse is
end case;
Set_Location (Res);
Scan.Scan;
- Set_Operand (Res, Parse_Term);
+ Set_Operand (Res, Parse_Term (Null_Iir));
else
- Res := Parse_Term;
+ Res := Parse_Term (Primary);
end if;
while Current_Token in Token_Adding_Operator_Type loop
case Current_Token is
@@ -3362,7 +3819,7 @@ package body Parse is
Set_Location (Tmp);
Scan.Scan;
Set_Left (Tmp, Res);
- Set_Right (Tmp, Parse_Term);
+ Set_Right (Tmp, Parse_Term (Null_Iir));
Res := Tmp;
end loop;
return Res;
@@ -3984,12 +4441,10 @@ package body Parse is
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
Set_Implementation (Call, Name);
- when Iir_Kind_Attribute_Name => -- Support issue 3060
- Error_Msg_Parse ("Attribute cannot be applied to procedure call");
+ when Iir_Kind_Attribute_Name =>
+ Error_Msg_Parse ("attribute cannot be used as procedure call");
when others =>
- -- Support issue 2686 : no testcase, but improve the error message
- Error_Kind("parenthesis_name_to_procedure_call", Name);
- -- raise Internal_Error;
+ Error_Kind ("parenthesis_name_to_procedure_call", Name);
end case;
return Res;
end Parenthesis_Name_To_Procedure_Call;
@@ -5024,6 +5479,7 @@ package body Parse is
-- | [ label : ] [ POSTPONED ] selected_signal_assignment
function Parse_Concurrent_Assignment (Target : Iir) return Iir
is
+ Res : Iir;
begin
case Current_Token is
when Tok_Less_Equal
@@ -5038,9 +5494,28 @@ package body Parse is
Expect (Tok_Semi_Colon);
return Parenthesis_Name_To_Procedure_Call
(Target, Iir_Kind_Concurrent_Procedure_Call_Statement);
- when others =>
+ when Tok_Generic | Tok_Port =>
-- or a component instantiation.
return Parse_Component_Instantiation (Target);
+ when others =>
+ -- or a simple simultaneous statement
+ if AMS_Vhdl then
+ Res := Create_Iir (Iir_Kind_Simple_Simultaneous_Statement);
+ Set_Simultaneous_Left (Res, Parse_Simple_Expression (Target));
+ if Current_Token /= Tok_Equal_Equal then
+ Error_Msg_Parse ("'==' expected after expression");
+ else
+ Set_Location (Res);
+ Scan.Scan;
+ end if;
+ Set_Simultaneous_Right (Res, Parse_Simple_Expression);
+ Set_Tolerance (Res, Parse_Tolerance_Aspect_Opt);
+ Expect (Tok_Semi_Colon);
+ return Res;
+ else
+ return Parse_Conditional_Signal_Assignment
+ (Parse_Simple_Expression (Target));
+ end if;
end case;
end Parse_Concurrent_Assignment;
diff --git a/scan.adb b/scan.adb
index 211383e1e..1e5f1985b 100644
--- a/scan.adb
+++ b/scan.adb
@@ -642,31 +642,44 @@ package body Scan is
-- The identifiers listed below are called reserved words and are
-- reserved for signifiances in the language.
-- IN: this is also achieved in packages std_names and tokens.
- if Current_Identifier > Std_Names.Name_Last_Vhdl87
- and then Vhdl_Std = Vhdl_87
- then
- if Flags.Warn_Reserved_Word then
- Warning_Msg_Scan
- ("using """ & Name_Buffer (1 .. Name_Length)
- & """ vhdl93 reserved word as a vhdl87 identifier");
- Warning_Msg_Scan
- ("(use option --std=93 to compile as vhdl93)");
- end if;
- Current_Token := Tok_Identifier;
- elsif Current_Identifier > Std_Names.Name_Last_Vhdl93
- and then Vhdl_Std < Vhdl_00
- then
- if Flags.Warn_Reserved_Word then
- Warning_Msg_Scan
- ("using """ & Name_Buffer (1 .. Name_Length)
- & """ vhdl00 reserved word as an identifier");
- end if;
- Current_Token := Tok_Identifier;
- else
- Current_Token := Token_Type'Val
- (Token_Type'Pos (Tok_First_Keyword)
- + Current_Identifier - Std_Names.Name_First_Keyword);
- end if;
+ Current_Token := Token_Type'Val
+ (Token_Type'Pos (Tok_First_Keyword)
+ + Current_Identifier - Std_Names.Name_First_Keyword);
+ case Current_Identifier is
+ when Std_Names.Name_Id_AMS_Reserved_Words =>
+ if not AMS_Vhdl then
+ if Flags.Warn_Reserved_Word then
+ Warning_Msg_Scan
+ ("using """ & Name_Buffer (1 .. Name_Length)
+ & """ AMS-VHDL reserved word as an identifier");
+ end if;
+ Current_Token := Tok_Identifier;
+ end if;
+ when Std_Names.Name_Id_Vhdl00_Reserved_Words =>
+ if Vhdl_Std < Vhdl_00 then
+ if Flags.Warn_Reserved_Word then
+ Warning_Msg_Scan
+ ("using """ & Name_Buffer (1 .. Name_Length)
+ & """ vhdl00 reserved word as an identifier");
+ end if;
+ Current_Token := Tok_Identifier;
+ end if;
+ when Std_Names.Name_Id_Vhdl93_Reserved_Words =>
+ if Vhdl_Std = Vhdl_87 then
+ if Flags.Warn_Reserved_Word then
+ Warning_Msg_Scan
+ ("using """ & Name_Buffer (1 .. Name_Length)
+ & """ vhdl93 reserved word as a vhdl87 identifier");
+ Warning_Msg_Scan
+ ("(use option --std=93 to compile as vhdl93)");
+ end if;
+ Current_Token := Tok_Identifier;
+ end if;
+ when Std_Names.Name_Id_Vhdl87_Reserved_Words =>
+ null;
+ when others =>
+ raise Program_Error;
+ end case;
elsif Flag_Psl then
case Current_Identifier is
when Std_Names.Name_Clock =>
@@ -1217,7 +1230,16 @@ package body Scan is
end if;
return;
when '=' =>
- if Source (Pos + 1) = '>' then
+ if Source (Pos + 1) = '=' then
+ if AMS_Vhdl then
+ Current_Token := Tok_Equal_Equal;
+ else
+ Error_Msg_Scan
+ ("'==' is not the vhdl equality, replaced by '='");
+ Current_Token := Tok_Equal;
+ end if;
+ Pos := Pos + 2;
+ elsif Source (Pos + 1) = '>' then
Current_Token := Tok_Double_Arrow;
Pos := Pos + 2;
else
diff --git a/sem.adb b/sem.adb
index 588d4e4bb..b4c1a144b 100644
--- a/sem.adb
+++ b/sem.adb
@@ -2150,6 +2150,11 @@ package body Sem is
null;
when Iir_Kind_Protected_Type_Body =>
null;
+ when Iir_Kind_Nature_Declaration
+ | Iir_Kind_Subnature_Declaration =>
+ null;
+ when Iir_Kind_Terminal_Declaration =>
+ null;
when others =>
Error_Kind ("package_need_body_p", El);
end case;
diff --git a/sem_decls.adb b/sem_decls.adb
index cb3a0c418..1209960e4 100644
--- a/sem_decls.adb
+++ b/sem_decls.adb
@@ -2001,6 +2001,8 @@ package body Sem_Decls is
when Iir_Kind_Subtype_Declaration
| Iir_Kind_Attribute_Declaration =>
null;
+ when Iir_Kind_Terminal_Declaration =>
+ null;
when others =>
Error_Kind ("sem_non_object_alias_declaration", N_Entity);
end case;
@@ -2128,6 +2130,152 @@ package body Sem_Decls is
Set_Visible_Flag (Group, True);
end Sem_Group_Declaration;
+ function Sem_Scalar_Nature_Definition (Def : Iir; Decl : Iir) return Iir
+ is
+ function Sem_Scalar_Nature_Typemark (T : Iir; Name : String) return Iir
+ is
+ Res : Iir;
+ begin
+ Res := Find_Declaration (T, Decl_Type);
+ if Res = Null_Iir then
+ return Real_Type_Definition;
+ end if;
+ -- LRM93 3.5.1
+ -- The type marks must denote floating point types
+ case Get_Kind (Res) is
+ when Iir_Kind_Floating_Subtype_Definition
+ | Iir_Kind_Floating_Type_Definition =>
+ return Res;
+ when others =>
+ Error_Msg_Sem (Name & "type must be a floating point type", T);
+ return Real_Type_Definition;
+ end case;
+ end Sem_Scalar_Nature_Typemark;
+
+ Tm : Iir;
+ Ref : Iir;
+ begin
+ Tm := Get_Across_Type (Def);
+ Tm := Sem_Scalar_Nature_Typemark (Tm, "across");
+ Set_Across_Type (Def, Tm);
+
+ Tm := Get_Through_Type (Def);
+ Tm := Sem_Scalar_Nature_Typemark (Tm, "through");
+ Set_Through_Type (Def, Tm);
+
+ -- Declare the reference
+ Ref := Get_Reference (Def);
+ Set_Nature (Ref, Def);
+ Set_Chain (Ref, Get_Chain (Decl));
+ Set_Chain (Decl, Ref);
+
+ return Def;
+ end Sem_Scalar_Nature_Definition;
+
+ function Sem_Nature_Definition (Def : Iir; Decl : Iir) return Iir
+ is
+ begin
+ case Get_Kind (Def) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ return Sem_Scalar_Nature_Definition (Def, Decl);
+ when others =>
+ Error_Kind ("sem_nature_definition", Def);
+ return Null_Iir;
+ end case;
+ end Sem_Nature_Definition;
+
+ procedure Sem_Nature_Declaration (Decl : Iir)
+ is
+ Def : Iir;
+ begin
+ Def := Get_Nature (Decl);
+ if Def /= Null_Iir then
+ Sem_Scopes.Add_Name (Decl);
+ Xref_Decl (Decl);
+
+ Def := Sem_Nature_Definition (Def, Decl);
+ if Def /= Null_Iir then
+ Set_Nature_Declarator (Def, Decl);
+ Sem_Scopes.Name_Visible (Decl);
+ end if;
+ end if;
+ end Sem_Nature_Declaration;
+
+ procedure Sem_Terminal_Declaration (Decl : Iir)
+ is
+ Def, Nature : Iir;
+ begin
+ Def := Get_Nature (Decl);
+ if Def /= Null_Iir then
+ Sem_Scopes.Add_Name (Decl);
+ Xref_Decl (Decl);
+
+ if Get_Kind (Def) = Iir_Kind_Proxy then
+ Nature := Get_Nature (Get_Proxy (Def));
+ Free_Iir (Def);
+ else
+ Nature := Sem_Subnature_Indication (Def);
+ end if;
+ if Nature /= Null_Iir then
+ Set_Nature (Decl, Nature);
+ Sem_Scopes.Name_Visible (Decl);
+ end if;
+ end if;
+ end Sem_Terminal_Declaration;
+
+ procedure Sem_Branch_Quantity_Declaration (Decl : Iir)
+ is
+ Plus : Iir;
+ Minus : Iir;
+ Branch_Type : Iir;
+ Value : Iir;
+ Proxy : Iir;
+ begin
+ Plus := Get_Plus_Terminal (Decl);
+ if Get_Kind (Plus) = Iir_Kind_Proxy then
+ Proxy := Get_Proxy (Plus);
+ Free_Iir (Plus);
+ Plus := Get_Plus_Terminal (Proxy);
+ Minus := Get_Minus_Terminal (Proxy);
+ Value := Get_Default_Value (Proxy);
+ else
+ Plus := Find_Declaration (Plus, Decl_Terminal);
+ Minus := Get_Minus_Terminal (Decl);
+ if Minus /= Null_Iir then
+ Minus := Find_Declaration (Minus, Decl_Terminal);
+ end if;
+ Proxy := Null_Iir;
+ end if;
+ Set_Plus_Terminal (Decl, Plus);
+ Set_Minus_Terminal (Decl, Minus);
+ case Get_Kind (Decl) is
+ when Iir_Kind_Across_Quantity_Declaration =>
+ Branch_Type := Get_Across_Type (Get_Nature (Plus));
+ when Iir_Kind_Through_Quantity_Declaration =>
+ Branch_Type := Get_Through_Type (Get_Nature (Plus));
+ when others =>
+ raise Program_Error;
+ end case;
+ Set_Type (Decl, Branch_Type);
+ Set_Base_Name (Decl, Decl);
+
+ if Proxy = Null_Iir then
+ Value := Get_Default_Value (Decl);
+ if Value /= Null_Iir then
+ Value := Sem_Expression (Value, Branch_Type);
+ end if;
+ else
+ Value := Get_Default_Value (Proxy);
+ end if;
+ Set_Default_Value (Decl, Value);
+
+ -- TODO: tolerance
+
+ Sem_Scopes.Add_Name (Decl);
+ Xref_Decl (Decl);
+ Sem_Scopes.Name_Visible (Decl);
+ end Sem_Branch_Quantity_Declaration;
+
-- Semantize every declaration of DECLS_PARENT.
-- STMTS is the concurrent statement list associated with DECLS_PARENT
-- if any, or null_iir. This is used for specification.
@@ -2231,6 +2379,13 @@ package body Sem_Decls is
null;
when Iir_Kind_Protected_Type_Body =>
Sem_Protected_Type_Body (Decl);
+ when Iir_Kind_Nature_Declaration =>
+ Sem_Nature_Declaration (Decl);
+ when Iir_Kind_Terminal_Declaration =>
+ Sem_Terminal_Declaration (Decl);
+ when Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration =>
+ Sem_Branch_Quantity_Declaration (Decl);
when others =>
Error_Kind ("sem_declaration_chain", Decl);
end case;
diff --git a/sem_expr.adb b/sem_expr.adb
index 2293e0a38..f008a7bbc 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -189,6 +189,8 @@ package body Sem_Expr is
| Iir_Kind_Allocator_By_Subtype
| Iir_Kind_Qualified_Expression =>
return Expr;
+ when Iir_Kinds_Quantity_Declaration =>
+ return Expr;
when Iir_Kinds_Dyadic_Operator
| Iir_Kinds_Monadic_Operator =>
return Expr;
@@ -683,7 +685,6 @@ package body Sem_Expr is
end if;
end Get_Discrete_Range_Staticness;
-
procedure Set_Function_Call_Staticness (Expr : Iir; Imp : Iir)
is
Staticness : Iir_Staticness;
@@ -3479,6 +3480,8 @@ package body Sem_Expr is
| Iir_Kind_Iterator_Declaration
| Iir_Kind_Guard_Signal_Declaration =>
return;
+ when Iir_Kinds_Quantity_Declaration =>
+ return;
when Iir_Kind_File_Declaration
| Iir_Kind_File_Interface_Declaration =>
-- LRM 4.3.2 Interface declarations
diff --git a/sem_names.adb b/sem_names.adb
index 65624a709..da6c749eb 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -1453,29 +1453,16 @@ package body Sem_Names is
begin
Prot_Type := Get_Type (Sub_Name);
--- bld 26 apr 2013 : the following returned the FIRST method matching name
--- rather than the full overload list.
--- Method := Find_Name_In_Chain
--- (Get_Declaration_Chain (Prot_Type), Suffix);
--- if Method = Null_Iir then
--- Error_Msg_Sem
--- ("no method " & Name_Table.Image (Suffix) & " in "
--- & Disp_Node (Prot_Type), Name);
--- return;
--- else
--- Add_Result (Res, Method);
--- end if;
-
- -- build overload list from all declarations in chain, matching name,
+ -- Build overload list from all declarations in chain, matching name,
-- which are actually functions or procedures.
-- TODO: error here if there's a variable with matching name?
-- currently we warn...
- -- rather than add a "Find_nth_name_in chain" to iirs_utils I have
+ -- Rather than add a "Find_nth_name_in chain" to iirs_utils I have
-- expanded the chain walk here.
Method := Get_Declaration_Chain (Prot_Type);
while Method /= Null_Iir loop
if Get_Identifier (Method) = Suffix then -- found the name
- -- check it's a method!
+ -- Check it's a method.
case Get_Kind (Method) is
when Iir_Kind_Function_Declaration |
Iir_Kind_Procedure_Declaration =>
@@ -1493,22 +1480,6 @@ package body Sem_Names is
& Disp_Node (Prot_Type), Name);
return;
end if;
-
--- following is handled by later stages
--- case Get_Kind (Method) is
--- when Iir_Kind_Function_Declaration =>
--- Call := Create_Iir (Iir_Kind_Function_Call);
--- Set_Type (Call, Get_Return_Type (Method));
--- Set_Base_Name (Call, Call);
--- when Iir_Kind_Procedure_Declaration =>
--- Call := Create_Iir (Iir_Kind_Procedure_Call);
--- when others =>
--- Error_Kind ("sem_as_method_call", Method);
--- end case;
--- Location_Copy (Call, Sub_Name);
--- Set_Implementation (Call, Method);
--- --Set_Parameter_Association_Chain (Call, Xx);
--- Add_Result (Res, Call);
end Sem_As_Method_Call;
begin
@@ -1992,7 +1963,7 @@ package body Sem_Names is
if Res = Null_Iir then
Error_Msg_Sem
("No overloaded subprogram found matching "
- & Disp_Node(Prefix_Name), Name);
+ & Disp_Node (Prefix_Name), Name);
end if;
when Iir_Kinds_Function_Declaration =>
Add_Result (Res, Sem_As_Function_Call (Prefix_Name,
@@ -2119,14 +2090,9 @@ package body Sem_Names is
| Iir_Kind_Selected_Element
| Iir_Kind_Dereference
| Iir_Kind_Indexed_Name
- -- Iir_Kind_Function_Call added to resolve testcase 2 in
- -- https://gna.org/bugs/?18351
| Iir_Kind_Function_Call =>
Sem_As_Selected_By_All_Name (Prefix);
- -- when clause added to resolve testcases 3-6 in
- -- https://gna.org/bugs/?18351
when Iir_Kinds_Function_Declaration =>
- -- or Iir_Kind_Function_Declaration to exclude implicit functions
Prefix := Sem_As_Function_Call (Name => Prefix_Name,
Spec => Prefix,
Assoc_Chain => Null_Iir);
@@ -3005,7 +2971,8 @@ package body Sem_Names is
case Get_Kind (Expr) is
when Iir_Kind_Error =>
null;
- when Iir_Kinds_Object_Declaration =>
+ when Iir_Kinds_Object_Declaration
+ | Iir_Kinds_Quantity_Declaration =>
Set_Base_Name (Name, Expr);
Sem_Check_Pure (Name, Expr);
Sem_Check_All_Sensitized (Expr);
@@ -3438,6 +3405,17 @@ package body Sem_Names is
("type expected, found " & Disp_Node (Res), Name);
return Null_Iir;
end case;
+ when Decl_Nature =>
+ case Get_Kind (Res) is
+ when Iir_Kind_Nature_Declaration =>
+ Res := Get_Nature (Res);
+ when others =>
+ Error_Msg_Sem
+ ("nature expected, found " & Disp_Node (Res), Name);
+ return Null_Iir;
+ end case;
+ when Decl_Terminal =>
+ Res := Check_Kind (Res, Iir_Kind_Terminal_Declaration, "terminal");
when Decl_Component =>
Res := Check_Kind (Res, Iir_Kind_Component_Declaration,
"component");
diff --git a/sem_names.ads b/sem_names.ads
index ce7573d45..b48cd7b6a 100644
--- a/sem_names.ads
+++ b/sem_names.ads
@@ -98,7 +98,8 @@ package Sem_Names is
type Decl_Kind_Type is
(Decl_Type, Decl_Incomplete_Type,
Decl_Component, Decl_Unit, Decl_Label,
- Decl_Group_Template, Decl_Entity, Decl_Configuration, Decl_Attribute);
+ Decl_Group_Template, Decl_Entity, Decl_Configuration, Decl_Attribute,
+ Decl_Nature, Decl_Terminal);
-- Find a uniq declaration for name NAME, which can be a simple_name,
-- an identifier or a selected_name.
diff --git a/sem_scopes.adb b/sem_scopes.adb
index b3d345ce2..7737ed881 100644
--- a/sem_scopes.adb
+++ b/sem_scopes.adb
@@ -878,6 +878,11 @@ package body Sem_Scopes is
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Group_Template_Declaration
| Iir_Kind_Group_Declaration
+ | Iir_Kind_Nature_Declaration
+ | Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Terminal_Declaration
| Iir_Kind_Entity_Declaration
| Iir_Kind_Package_Declaration
| Iir_Kinds_Concurrent_Statement
diff --git a/sem_stmts.adb b/sem_stmts.adb
index b5a8f17e6..373ea7d68 100644
--- a/sem_stmts.adb
+++ b/sem_stmts.adb
@@ -1702,6 +1702,31 @@ package body Sem_Stmts is
Sem_Guard (Stmt);
end Sem_Concurrent_Selected_Signal_Assignment;
+ procedure Simple_Simultaneous_Statement (Stmt : Iir) is
+ Left, Right : Iir;
+ Res_Type : Iir;
+ begin
+ Left := Get_Simultaneous_Left (Stmt);
+ Right := Get_Simultaneous_Right (Stmt);
+
+ Left := Sem_Expression_Ov (Left, Null_Iir);
+ Right := Sem_Expression_Ov (Right, Null_Iir);
+
+ -- Give up in case of error
+ if Left = Null_Iir or else Right = Null_Iir then
+ return;
+ end if;
+
+ Res_Type := Search_Compatible_Type (Get_Type (Left), Get_Type (Right));
+ if Res_Type = Null_Iir then
+ Error_Msg_Sem ("types of left and right expressions are incompatible",
+ Stmt);
+ return;
+ end if;
+
+ -- FIXME: check for nature type...
+ end Simple_Simultaneous_Statement;
+
procedure Sem_Concurrent_Statement_Chain
(Parent : Iir; Is_Passive : Boolean)
is
@@ -1776,6 +1801,8 @@ package body Sem_Stmts is
Sem_Psl.Sem_Psl_Assert_Statement (El);
when Iir_Kind_Psl_Default_Clock =>
Sem_Psl.Sem_Psl_Default_Clock (El);
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ Simple_Simultaneous_Statement (El);
when others =>
Error_Kind ("sem_concurrent_statement_chain", El);
end case;
diff --git a/sem_types.adb b/sem_types.adb
index cef8234c8..c57c151c5 100644
--- a/sem_types.adb
+++ b/sem_types.adb
@@ -1731,6 +1731,7 @@ package body Sem_Types is
is
Res : Iir;
A_Range : Iir;
+ Tolerance : Iir;
begin
if Def = Null_Iir then
Res := Copy_Subtype_Indication (Type_Mark);
@@ -1747,8 +1748,11 @@ package body Sem_Types is
return Type_Mark;
end if;
+ Tolerance := Get_Tolerance (Def);
+
if Get_Range_Constraint (Def) = Null_Iir
and then Resolution = Null_Iir
+ and then Tolerance = Null_Iir
then
-- This defines an alias, and must have been handled just
-- before the case statment.
@@ -1780,6 +1784,29 @@ package body Sem_Types is
Set_Type_Staticness (Res, Get_Expr_Staticness (A_Range));
Free_Name (Def);
Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+ if Tolerance /= Null_Iir then
+ -- LRM93 4.2 Subtype declarations
+ -- It is an error in this case the subtype is not a nature
+ -- type
+ --
+ -- FIXME: should be moved into sem_subtype_indication
+ if Get_Kind (Res) /= Iir_Kind_Floating_Subtype_Definition then
+ Error_Msg_Sem ("tolerance allowed only for floating subtype",
+ Tolerance);
+ else
+ -- LRM93 4.2 Subtype declarations
+ -- If the subtype indication includes a tolerance aspect, then
+ -- the string expression must be a static expression
+ Tolerance := Sem_Expression (Tolerance, String_Type_Definition);
+ if Tolerance /= Null_Iir
+ and then Get_Expr_Staticness (Tolerance) /= Locally
+ then
+ Error_Msg_Sem ("tolerance must be a static string",
+ Tolerance);
+ end if;
+ Set_Tolerance (Res, Tolerance);
+ end if;
+ end if;
end if;
if Resolution /= Null_Iir then
@@ -2005,4 +2032,30 @@ package body Sem_Types is
Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Def));
return Res;
end Copy_Subtype_Indication;
+
+ function Sem_Subnature_Indication (Def: Iir) return Iir
+ is
+ Nature_Mark: Iir;
+ begin
+ -- LRM 4.8 Nature declatation
+ --
+ -- If the subnature indication does not include a constraint, the
+ -- subnature is the same as that denoted by the type mark.
+ case Get_Kind (Def) is
+ when Iir_Kind_Scalar_Nature_Definition =>
+ -- Used for reference declared by a nature
+ return Def;
+ when Iir_Kinds_Name =>
+ Nature_Mark := Find_Declaration (Def, Decl_Nature);
+ if Nature_Mark = Null_Iir then
+ -- return Create_Error_Type (Def);
+ raise Program_Error; -- TODO
+ else
+ return Nature_Mark;
+ end if;
+ when others =>
+ raise Program_Error; -- TODO
+ end case;
+ end Sem_Subnature_Indication;
+
end Sem_Types;
diff --git a/sem_types.ads b/sem_types.ads
index dc36640ad..16548b007 100644
--- a/sem_types.ads
+++ b/sem_types.ads
@@ -54,4 +54,6 @@ package Sem_Types is
-- This is used when an alias of DEF is required (eg: subtype a is b).
function Copy_Subtype_Indication (Def : Iir) return Iir;
+ function Sem_Subnature_Indication (Def: Iir) return Iir;
+ -- Also a nature is not a type, it is patterned like a type.
end Sem_Types;
diff --git a/std_names.adb b/std_names.adb
index 8ad854b53..82f883530 100644
--- a/std_names.adb
+++ b/std_names.adb
@@ -17,394 +17,371 @@
-- 02111-1307, USA.
with Name_Table;
with Tokens; use Tokens;
+with Ada.Exceptions;
package body Std_Names is
procedure Std_Names_Initialize is
- function GI (S : String) return Name_Id
- renames Name_Table.Get_Identifier;
-
--- function GI (S : String) return Name_Id is
--- begin
--- Ada.Text_IO.Put_Line ("add " & S);
--- return Name_Table.Get_Identifier (S);
--- end GI;
-
+ procedure Def (S : String; Id : Name_Id) is
+ begin
+ if Name_Table.Get_Identifier (S) /= Id then
+ Ada.Exceptions.Raise_Exception
+ (Program_Error'Identity, "wrong name_id for " & S);
+ end if;
+ end Def;
begin
Name_Table.Initialize;
- -- Create keywords.
- for I in Tok_Mod .. Tok_Protected loop
- if GI (Image (I)) /=
- Name_First_Keyword +
- Token_Type'Pos (I) - Token_Type'Pos (Tok_First_Keyword)
- then
- raise Program_Error;
- end if;
+ -- Create reserved words.
+ for I in Tok_Mod .. Tok_Tolerance loop
+ Def (Image (I),
+ Name_First_Keyword +
+ Token_Type'Pos (I) - Token_Type'Pos (Tok_First_Keyword));
end loop;
-- Create operators.
- if GI ("=") /= Name_Op_Equality
- or GI ("/=") /= Name_Op_Inequality
- or GI ("<") /= Name_Op_Less
- or GI ("<=") /= Name_Op_Less_Equal
- or GI (">") /= Name_Op_Greater
- or GI (">=") /= Name_Op_Greater_Equal
- or GI ("+") /= Name_Op_Plus
- or GI ("-") /= Name_Op_Minus
- or GI ("*") /= Name_Op_Mul
- or GI ("/") /= Name_Op_Div
- or GI ("**") /= Name_Op_Exp
- or GI ("&") /= Name_Op_Concatenation
- or GI ("??") /= Name_Op_Condition
- then
- raise Program_Error;
- end if;
+ Def ("=", Name_Op_Equality);
+ Def ("/=", Name_Op_Inequality);
+ Def ("<", Name_Op_Less);
+ Def ("<=", Name_Op_Less_Equal);
+ Def (">", Name_Op_Greater);
+ Def (">=", Name_Op_Greater_Equal);
+ Def ("+", Name_Op_Plus);
+ Def ("-", Name_Op_Minus);
+ Def ("*", Name_Op_Mul);
+ Def ("/", Name_Op_Div);
+ Def ("**", Name_Op_Exp);
+ Def ("&", Name_Op_Concatenation);
+ Def ("??", Name_Op_Condition);
-- Create Attributes.
- if GI ("base") /= Name_Base
- or GI ("left") /= Name_Left
- or GI ("right") /= Name_Right
- or GI ("high") /= Name_High
- or GI ("low") /= Name_Low
- or GI ("pos") /= Name_Pos
- or GI ("val") /= Name_Val
- or GI ("succ") /= Name_Succ
- or GI ("pred") /= Name_Pred
- or GI ("leftof") /= Name_Leftof
- or GI ("rightof") /= Name_Rightof
- or GI ("reverse_range") /= Name_Reverse_Range
- or GI ("length") /= Name_Length
- or GI ("delayed") /= Name_Delayed
- or GI ("stable") /= Name_Stable
- or GI ("quiet") /= Name_Quiet
- or GI ("transaction") /= Name_Transaction
- or GI ("event") /= Name_Event
- or GI ("active") /= Name_Active
- or GI ("last_event") /= Name_Last_Event
- or GI ("last_active") /= Name_Last_Active
- or GI ("last_value") /= Name_Last_Value
+ Def ("base", Name_Base);
+ Def ("left", Name_Left);
+ Def ("right", Name_Right);
+ Def ("high", Name_High);
+ Def ("low", Name_Low);
+ Def ("pos", Name_Pos);
+ Def ("val", Name_Val);
+ Def ("succ", Name_Succ);
+ Def ("pred", Name_Pred);
+ Def ("leftof", Name_Leftof);
+ Def ("rightof", Name_Rightof);
+ Def ("reverse_range", Name_Reverse_Range);
+ Def ("length", Name_Length);
+ Def ("delayed", Name_Delayed);
+ Def ("stable", Name_Stable);
+ Def ("quiet", Name_Quiet);
+ Def ("transaction", Name_Transaction);
+ Def ("event", Name_Event);
+ Def ("active", Name_Active);
+ Def ("last_event", Name_Last_Event);
+ Def ("last_active", Name_Last_Active);
+ Def ("last_value", Name_Last_Value);
+
+ Def ("behavior", Name_Behavior);
+ Def ("structure", Name_Structure);
- or GI ("behavior") /= Name_Behavior
- or GI ("structure") /= Name_Structure
+ Def ("ascending", Name_Ascending);
+ Def ("image", Name_Image);
+ Def ("value", Name_Value);
+ Def ("driving", Name_Driving);
+ Def ("driving_value", Name_Driving_Value);
+ Def ("simple_name", Name_Simple_Name);
+ Def ("instance_name", Name_Instance_Name);
+ Def ("path_name", Name_Path_Name);
- or GI ("ascending") /= Name_Ascending
- or GI ("image") /= Name_Image
- or GI ("value") /= Name_Value
- or GI ("driving") /= Name_Driving
- or GI ("driving_value") /= Name_Driving_Value
- or GI ("simple_name") /= Name_Simple_Name
- or GI ("instance_name") /= Name_Instance_Name
- or GI ("path_name") /= Name_Path_Name
- then
- raise Program_Error;
- end if;
+ Def ("contribution", Name_Contribution);
+ Def ("dot", Name_Dot);
+ Def ("integ", Name_Integ);
+ Def ("above", Name_Above);
+ Def ("zoh", Name_ZOH);
+ Def ("ltf", Name_LTF);
+ Def ("ztf", Name_ZTF);
+ Def ("ramp", Name_Ramp);
+ Def ("slew", Name_Slew);
-- Create standard.
- if GI ("std") /= Name_Std
- or GI ("standard") /= Name_Standard
- or GI ("boolean") /= Name_Boolean
- or GI ("false") /= Name_False
- or GI ("true") /= Name_True
- or GI ("bit") /= Name_Bit
- or GI ("character") /= Name_Character
- or GI ("severity_level") /= Name_Severity_Level
- or GI ("note") /= Name_Note
- or GI ("warning") /= Name_Warning
- or GI ("error") /= Name_Error
- or GI ("failure") /= Name_Failure
- or GI ("UNIVERSAL_INTEGER") /= Name_Universal_Integer
- or GI ("UNIVERSAL_REAL") /= Name_Universal_Real
- or GI ("CONVERTIBLE_INTEGER") /= Name_Convertible_Integer
- or GI ("CONVERTIBLE_REAL") /= Name_Convertible_Real
- or GI ("integer") /= Name_Integer
- or GI ("real") /= Name_Real
- or GI ("time") /= Name_Time
- or GI ("fs") /= Name_Fs
- or GI ("ps") /= Name_Ps
- or GI ("ns") /= Name_Ns
- or GI ("us") /= Name_Us
- or GI ("ms") /= Name_Ms
- or GI ("sec") /= Name_Sec
- or GI ("min") /= Name_Min
- or GI ("hr") /= Name_Hr
- or GI ("delay_length") /= Name_Delay_Length
- or GI ("now") /= Name_Now
- or GI ("natural") /= Name_Natural
- or GI ("positive") /= Name_Positive
- or GI ("string") /= Name_String
- or GI ("bit_vector") /= Name_Bit_Vector
- or GI ("file_open_kind") /= Name_File_Open_Kind
- or GI ("read_mode") /= Name_Read_Mode
- or GI ("write_mode") /= Name_Write_Mode
- or GI ("append_mode") /= Name_Append_Mode
- or GI ("file_open_status") /= Name_File_Open_Status
- or GI ("open_ok") /= Name_Open_Ok
- or GI ("status_error") /= Name_Status_Error
- or GI ("name_error") /= Name_Name_Error
- or GI ("mode_error") /= Name_Mode_Error
- or GI ("foreign") /= Name_Foreign
- then
- raise Program_Error;
- end if;
+ Def ("std", Name_Std);
+ Def ("standard", Name_Standard);
+ Def ("boolean", Name_Boolean);
+ Def ("false", Name_False);
+ Def ("true", Name_True);
+ Def ("bit", Name_Bit);
+ Def ("character", Name_Character);
+ Def ("severity_level", Name_Severity_Level);
+ Def ("note", Name_Note);
+ Def ("warning", Name_Warning);
+ Def ("error", Name_Error);
+ Def ("failure", Name_Failure);
+ Def ("UNIVERSAL_INTEGER", Name_Universal_Integer);
+ Def ("UNIVERSAL_REAL", Name_Universal_Real);
+ Def ("CONVERTIBLE_INTEGER", Name_Convertible_Integer);
+ Def ("CONVERTIBLE_REAL", Name_Convertible_Real);
+ Def ("integer", Name_Integer);
+ Def ("real", Name_Real);
+ Def ("time", Name_Time);
+ Def ("fs", Name_Fs);
+ Def ("ps", Name_Ps);
+ Def ("ns", Name_Ns);
+ Def ("us", Name_Us);
+ Def ("ms", Name_Ms);
+ Def ("sec", Name_Sec);
+ Def ("min", Name_Min);
+ Def ("hr", Name_Hr);
+ Def ("delay_length", Name_Delay_Length);
+ Def ("now", Name_Now);
+ Def ("natural", Name_Natural);
+ Def ("positive", Name_Positive);
+ Def ("string", Name_String);
+ Def ("bit_vector", Name_Bit_Vector);
+ Def ("file_open_kind", Name_File_Open_Kind);
+ Def ("read_mode", Name_Read_Mode);
+ Def ("write_mode", Name_Write_Mode);
+ Def ("append_mode", Name_Append_Mode);
+ Def ("file_open_status", Name_File_Open_Status);
+ Def ("open_ok", Name_Open_Ok);
+ Def ("status_error", Name_Status_Error);
+ Def ("name_error", Name_Name_Error);
+ Def ("mode_error", Name_Mode_Error);
+ Def ("foreign", Name_Foreign);
+ Def ("domain_type", Name_Domain_Type);
+ Def ("quiescent_domain", Name_Quiescent_Domain);
+ Def ("time_domain", Name_Time_Domain);
+ Def ("frequency_domain", Name_Frequency_Domain);
+ Def ("domain", Name_Domain);
+ Def ("frequency", Name_Frequency);
+ Def ("real_vector", Name_Real_Vector);
- if GI ("nul") /= Name_Nul
- or GI ("soh") /= Name_Soh
- or GI ("stx") /= Name_Stx
- or GI ("etx") /= Name_Etx
- or GI ("eot") /= Name_Eot
- or GI ("enq") /= Name_Enq
- or GI ("ack") /= Name_Ack
- or GI ("bel") /= Name_Bel
- or GI ("bs") /= Name_Bs
- or GI ("ht") /= Name_Ht
- or GI ("lf") /= Name_Lf
- or GI ("vt") /= Name_Vt
- or GI ("ff") /= Name_Ff
- or GI ("cr") /= Name_Cr
- or GI ("so") /= Name_So
- or GI ("si") /= Name_Si
- or GI ("dle") /= Name_Dle
- or GI ("dc1") /= Name_Dc1
- or GI ("dc2") /= Name_Dc2
- or GI ("dc3") /= Name_Dc3
- or GI ("dc4") /= Name_Dc4
- or GI ("nak") /= Name_Nak
- or GI ("syn") /= Name_Syn
- or GI ("etb") /= Name_Etb
- or GI ("can") /= Name_Can
- or GI ("em") /= Name_Em
- or GI ("sub") /= Name_Sub
- or GI ("esc") /= Name_Esc
- or GI ("fsp") /= Name_Fsp
- or GI ("gsp") /= Name_Gsp
- or GI ("rsp") /= Name_Rsp
- or GI ("usp") /= Name_Usp
- or GI ("del") /= Name_Del
- then
- raise Program_Error;
- end if;
+ Def ("nul", Name_Nul);
+ Def ("soh", Name_Soh);
+ Def ("stx", Name_Stx);
+ Def ("etx", Name_Etx);
+ Def ("eot", Name_Eot);
+ Def ("enq", Name_Enq);
+ Def ("ack", Name_Ack);
+ Def ("bel", Name_Bel);
+ Def ("bs", Name_Bs);
+ Def ("ht", Name_Ht);
+ Def ("lf", Name_Lf);
+ Def ("vt", Name_Vt);
+ Def ("ff", Name_Ff);
+ Def ("cr", Name_Cr);
+ Def ("so", Name_So);
+ Def ("si", Name_Si);
+ Def ("dle", Name_Dle);
+ Def ("dc1", Name_Dc1);
+ Def ("dc2", Name_Dc2);
+ Def ("dc3", Name_Dc3);
+ Def ("dc4", Name_Dc4);
+ Def ("nak", Name_Nak);
+ Def ("syn", Name_Syn);
+ Def ("etb", Name_Etb);
+ Def ("can", Name_Can);
+ Def ("em", Name_Em);
+ Def ("sub", Name_Sub);
+ Def ("esc", Name_Esc);
+ Def ("fsp", Name_Fsp);
+ Def ("gsp", Name_Gsp);
+ Def ("rsp", Name_Rsp);
+ Def ("usp", Name_Usp);
+ Def ("del", Name_Del);
- if GI ("c128") /= Name_C128
- or GI ("c129") /= Name_C129
- or GI ("c130") /= Name_C130
- or GI ("c131") /= Name_C131
- or GI ("c132") /= Name_C132
- or GI ("c133") /= Name_C133
- or GI ("c134") /= Name_C134
- or GI ("c135") /= Name_C135
- or GI ("c136") /= Name_C136
- or GI ("c137") /= Name_C137
- or GI ("c138") /= Name_C138
- or GI ("c139") /= Name_C139
- or GI ("c140") /= Name_C140
- or GI ("c141") /= Name_C141
- or GI ("c142") /= Name_C142
- or GI ("c143") /= Name_C143
- or GI ("c144") /= Name_C144
- or GI ("c145") /= Name_C145
- or GI ("c146") /= Name_C146
- or GI ("c147") /= Name_C147
- or GI ("c148") /= Name_C148
- or GI ("c149") /= Name_C149
- or GI ("c150") /= Name_C150
- or GI ("c151") /= Name_C151
- or GI ("c152") /= Name_C152
- or GI ("c153") /= Name_C153
- or GI ("c154") /= Name_C154
- or GI ("c155") /= Name_C155
- or GI ("c156") /= Name_C156
- or GI ("c157") /= Name_C157
- or GI ("c158") /= Name_C158
- or GI ("c159") /= Name_C159
- then
- raise Program_Error;
- end if;
+ Def ("c128", Name_C128);
+ Def ("c129", Name_C129);
+ Def ("c130", Name_C130);
+ Def ("c131", Name_C131);
+ Def ("c132", Name_C132);
+ Def ("c133", Name_C133);
+ Def ("c134", Name_C134);
+ Def ("c135", Name_C135);
+ Def ("c136", Name_C136);
+ Def ("c137", Name_C137);
+ Def ("c138", Name_C138);
+ Def ("c139", Name_C139);
+ Def ("c140", Name_C140);
+ Def ("c141", Name_C141);
+ Def ("c142", Name_C142);
+ Def ("c143", Name_C143);
+ Def ("c144", Name_C144);
+ Def ("c145", Name_C145);
+ Def ("c146", Name_C146);
+ Def ("c147", Name_C147);
+ Def ("c148", Name_C148);
+ Def ("c149", Name_C149);
+ Def ("c150", Name_C150);
+ Def ("c151", Name_C151);
+ Def ("c152", Name_C152);
+ Def ("c153", Name_C153);
+ Def ("c154", Name_C154);
+ Def ("c155", Name_C155);
+ Def ("c156", Name_C156);
+ Def ("c157", Name_C157);
+ Def ("c158", Name_C158);
+ Def ("c159", Name_C159);
-- Create misc.
- if GI ("guard") /= Name_Guard
- or GI ("deallocate") /= Name_Deallocate
- or GI ("file_open") /= Name_File_Open
- or GI ("file_close") /= Name_File_Close
- or GI ("read") /= Name_Read
- or GI ("write") /= Name_Write
- or GI ("flush") /= Name_Flush
- or GI ("endfile") /= Name_Endfile
- or GI ("p") /= Name_P
- or GI ("f") /= Name_F
- or GI ("external_name") /= Name_External_Name
- or GI ("open_kind") /= Name_Open_Kind
- or GI ("status") /= Name_Status
- or GI ("first") /= Name_First
- or GI ("last") /= Name_Last
- or GI ("textio") /= Name_Textio
- or GI ("work") /= Name_Work
- or GI ("text") /= Name_Text
- or GI ("to_string") /= Name_To_String
- or GI ("untruncated_text_read") /= Name_Untruncated_Text_Read
- then
- raise Program_Error;
- end if;
+ Def ("guard", Name_Guard);
+ Def ("deallocate", Name_Deallocate);
+ Def ("file_open", Name_File_Open);
+ Def ("file_close", Name_File_Close);
+ Def ("read", Name_Read);
+ Def ("write", Name_Write);
+ Def ("flush", Name_Flush);
+ Def ("endfile", Name_Endfile);
+ Def ("p", Name_P);
+ Def ("f", Name_F);
+ Def ("external_name", Name_External_Name);
+ Def ("open_kind", Name_Open_Kind);
+ Def ("status", Name_Status);
+ Def ("first", Name_First);
+ Def ("last", Name_Last);
+ Def ("textio", Name_Textio);
+ Def ("work", Name_Work);
+ Def ("text", Name_Text);
+ Def ("to_string", Name_To_String);
+ Def ("untruncated_text_read", Name_Untruncated_Text_Read);
- if GI ("ieee") /= Name_Ieee
- or GI ("std_logic_1164") /= Name_Std_Logic_1164
- or GI ("std_ulogic") /= Name_Std_Ulogic
- or GI ("std_ulogic_vector") /= Name_Std_Ulogic_Vector
- or GI ("std_logic") /= Name_Std_Logic
- or GI ("std_logic_vector") /= Name_Std_Logic_Vector
- or GI ("rising_edge") /= Name_Rising_Edge
- or GI ("falling_edge") /= Name_Falling_Edge
- or GI ("vital_timing") /= Name_VITAL_Timing
- or GI ("vital_level0") /= Name_VITAL_Level0
- or GI ("vital_level1") /= Name_VITAL_Level1
- then
- raise Program_Error;
- end if;
+ Def ("ieee", Name_Ieee);
+ Def ("std_logic_1164", Name_Std_Logic_1164);
+ Def ("std_ulogic", Name_Std_Ulogic);
+ Def ("std_ulogic_vector", Name_Std_Ulogic_Vector);
+ Def ("std_logic", Name_Std_Logic);
+ Def ("std_logic_vector", Name_Std_Logic_Vector);
+ Def ("rising_edge", Name_Rising_Edge);
+ Def ("falling_edge", Name_Falling_Edge);
+ Def ("vital_timing", Name_VITAL_Timing);
+ Def ("vital_level0", Name_VITAL_Level0);
+ Def ("vital_level1", Name_VITAL_Level1);
-- Verilog keywords
- if GI ("always") /= Name_Always
- or GI ("assign") /= Name_Assign
- or GI ("buf") /= Name_Buf
- or GI ("bufif0") /= Name_Bufif0
- or GI ("bufif1") /= Name_Bufif1
- or GI ("casex") /= Name_Casex
- or GI ("casez") /= Name_Casez
- or GI ("cmos") /= Name_Cmos
- or GI ("deassign") /= Name_Deassign
- or GI ("default") /= Name_Default
- or GI ("defparam") /= Name_Defparam
- or GI ("disable") /= Name_Disable
- or GI ("endcase") /= Name_Endcase
- or GI ("endfunction") /= Name_Endfunction
- or GI ("endmodule") /= Name_Endmodule
- or GI ("endprimitive") /= Name_Endprimitive
- or GI ("endspecify") /= Name_Endspecify
- or GI ("endtable") /= Name_Endtable
- or GI ("endtask") /= Name_Endtask
- or GI ("forever") /= Name_Forever
- or GI ("fork") /= Name_Fork
- or GI ("highz0") /= Name_Highz0
- or GI ("highz1") /= Name_Highz1
- or GI ("initial") /= Name_Initial
- or GI ("input") /= Name_Input
- or GI ("join") /= Name_Join
- or GI ("large") /= Name_Large
- or GI ("medium") /= Name_Medium
- or GI ("module") /= Name_Module
- or GI ("negedge") /= Name_Negedge
- or GI ("nmos") /= Name_Nmos
- or GI ("notif0") /= Name_Notif0
- or GI ("notif1") /= Name_Notif1
- or GI ("output") /= Name_Output
- or GI ("parameter") /= Name_Parameter
- or GI ("pmos") /= Name_Pmos
- or GI ("posedge") /= Name_Posedge
- or GI ("primitive") /= Name_Primitive
- or GI ("pull0") /= Name_Pull0
- or GI ("pull1") /= Name_Pull1
- or GI ("pulldown") /= Name_Pulldown
- or GI ("pullup") /= Name_Pullup
- or GI ("reg") /= Name_Reg
- or GI ("repeat") /= Name_Repeat
- or GI ("rcmos") /= Name_Rcmos
- or GI ("rnmos") /= Name_Rnmos
- or GI ("rpmos") /= Name_Rpmos
- or GI ("rtran") /= Name_Rtran
- or GI ("rtranif0") /= Name_Rtranif0
- or GI ("rtranif1") /= Name_Rtranif1
- or GI ("small") /= Name_Small
- or GI ("specify") /= Name_Specify
- or GI ("specparam") /= Name_Specparam
- or GI ("strong0") /= Name_Strong0
- or GI ("strong1") /= Name_Strong1
- or GI ("supply0") /= Name_Supply0
- or GI ("supply1") /= Name_Supply1
- or GI ("table") /= Name_Tablex
- or GI ("task") /= Name_Task
- or GI ("tran") /= Name_Tran
- or GI ("tranif0") /= Name_Tranif0
- or GI ("tranif1") /= Name_Tranif1
- or GI ("tri") /= Name_Tri
- or GI ("tri0") /= Name_Tri0
- or GI ("tri1") /= Name_Tri1
- or GI ("trireg") /= Name_Trireg
- or GI ("wand") /= Name_Wand
- or GI ("weak0") /= Name_Weak0
- or GI ("weak1") /= Name_Weak1
- or GI ("wire") /= Name_Wire
- or GI ("wor") /= Name_Wor
- then
- raise Program_Error;
- end if;
+ Def ("always", Name_Always);
+ Def ("assign", Name_Assign);
+ Def ("buf", Name_Buf);
+ Def ("bufif0", Name_Bufif0);
+ Def ("bufif1", Name_Bufif1);
+ Def ("casex", Name_Casex);
+ Def ("casez", Name_Casez);
+ Def ("cmos", Name_Cmos);
+ Def ("deassign", Name_Deassign);
+ Def ("default", Name_Default);
+ Def ("defparam", Name_Defparam);
+ Def ("disable", Name_Disable);
+ Def ("endcase", Name_Endcase);
+ Def ("endfunction", Name_Endfunction);
+ Def ("endmodule", Name_Endmodule);
+ Def ("endprimitive", Name_Endprimitive);
+ Def ("endspecify", Name_Endspecify);
+ Def ("endtable", Name_Endtable);
+ Def ("endtask", Name_Endtask);
+ Def ("forever", Name_Forever);
+ Def ("fork", Name_Fork);
+ Def ("highz0", Name_Highz0);
+ Def ("highz1", Name_Highz1);
+ Def ("initial", Name_Initial);
+ Def ("input", Name_Input);
+ Def ("join", Name_Join);
+ Def ("large", Name_Large);
+ Def ("medium", Name_Medium);
+ Def ("module", Name_Module);
+ Def ("negedge", Name_Negedge);
+ Def ("nmos", Name_Nmos);
+ Def ("notif0", Name_Notif0);
+ Def ("notif1", Name_Notif1);
+ Def ("output", Name_Output);
+ Def ("parameter", Name_Parameter);
+ Def ("pmos", Name_Pmos);
+ Def ("posedge", Name_Posedge);
+ Def ("primitive", Name_Primitive);
+ Def ("pull0", Name_Pull0);
+ Def ("pull1", Name_Pull1);
+ Def ("pulldown", Name_Pulldown);
+ Def ("pullup", Name_Pullup);
+ Def ("reg", Name_Reg);
+ Def ("repeat", Name_Repeat);
+ Def ("rcmos", Name_Rcmos);
+ Def ("rnmos", Name_Rnmos);
+ Def ("rpmos", Name_Rpmos);
+ Def ("rtran", Name_Rtran);
+ Def ("rtranif0", Name_Rtranif0);
+ Def ("rtranif1", Name_Rtranif1);
+ Def ("small", Name_Small);
+ Def ("specify", Name_Specify);
+ Def ("specparam", Name_Specparam);
+ Def ("strong0", Name_Strong0);
+ Def ("strong1", Name_Strong1);
+ Def ("supply0", Name_Supply0);
+ Def ("supply1", Name_Supply1);
+ Def ("table", Name_Tablex);
+ Def ("task", Name_Task);
+ Def ("tran", Name_Tran);
+ Def ("tranif0", Name_Tranif0);
+ Def ("tranif1", Name_Tranif1);
+ Def ("tri", Name_Tri);
+ Def ("tri0", Name_Tri0);
+ Def ("tri1", Name_Tri1);
+ Def ("trireg", Name_Trireg);
+ Def ("wand", Name_Wand);
+ Def ("weak0", Name_Weak0);
+ Def ("weak1", Name_Weak1);
+ Def ("wire", Name_Wire);
+ Def ("wor", Name_Wor);
- if GI ("define") /= Name_Define
- or GI ("endif") /= Name_Endif
- or GI ("ifdef") /= Name_Ifdef
- or GI ("include") /= Name_Include
- or GI ("timescale") /= Name_Timescale
- or GI ("undef") /= Name_Undef
- then
- raise Program_Error;
- end if;
+ Def ("define", Name_Define);
+ Def ("endif", Name_Endif);
+ Def ("ifdef", Name_Ifdef);
+ Def ("include", Name_Include);
+ Def ("timescale", Name_Timescale);
+ Def ("undef", Name_Undef);
- if GI ("display") /= Name_Display
- or GI ("finish") /= Name_Finish
- then
- raise Program_Error;
- end if;
+ Def ("display", Name_Display);
+ Def ("finish", Name_Finish);
- if GI ("psl") /= Name_Psl
- or GI ("pragma") /= Name_Pragma
- then
- raise Program_Error;
- end if;
+ Def ("psl", Name_Psl);
+ Def ("pragma", Name_Pragma);
-- PSL keywords
- if GI ("a") /= Name_A
- or GI ("af") /= Name_Af
- or GI ("ag") /= Name_Ag
- or GI ("ax") /= Name_Ax
- or GI ("abort") /= Name_Abort
- or GI ("assume") /= Name_Assume
- or GI ("assume_guarantee") /= Name_Assume_Guarantee
- or GI ("before") /= Name_Before
- or GI ("clock") /= Name_Clock
- or GI ("const") /= Name_Const
- or GI ("cover") /= Name_Cover
- or GI ("e") /= Name_E
- or GI ("ef") /= Name_Ef
- or GI ("eg") /= Name_Eg
- or GI ("ex") /= Name_Ex
- or GI ("endpoint") /= Name_Endpoint
- or GI ("eventually") /= Name_Eventually
- or GI ("fairness") /= Name_Fairness
- or GI ("fell ") /= Name_Fell
- or GI ("forall") /= Name_forall
- or GI ("g") /= Name_G
- or GI ("inf") /= Name_Inf
- or GI ("inherit") /= Name_Inherit
- or GI ("never") /= Name_Never
- or GI ("next_a") /= Name_Next_A
- or GI ("next_e") /= Name_Next_E
- or GI ("next_event") /= Name_Next_Event
- or GI ("next_event_a") /= Name_Next_Event_A
- or GI ("next_event_e") /= Name_Next_Event_E
- or GI ("property") /= Name_Property
- or GI ("prev") /= Name_Prev
- or GI ("restrict") /= Name_Restrict
- or GI ("restrict_guarantee") /= Name_Restrict_Guarantee
- or GI ("rose") /= Name_Rose
- or GI ("sequence") /= Name_Sequence
- or GI ("strong") /= Name_Strong
- or GI ("union") /= Name_Union
- or GI ("vmode") /= Name_Vmode
- or GI ("vprop") /= Name_Vprop
- or GI ("vunit") /= Name_Vunit
- or GI ("w") /= Name_W
- or GI ("whilenot") /= Name_Whilenot
- or GI ("within") /= Name_Within
- or GI ("x") /= Name_X
- then
- raise Program_Error;
- end if;
+ Def ("a", Name_A);
+ Def ("af", Name_Af);
+ Def ("ag", Name_Ag);
+ Def ("ax", Name_Ax);
+ Def ("abort", Name_Abort);
+ Def ("assume", Name_Assume);
+ Def ("assume_guarantee", Name_Assume_Guarantee);
+ Def ("before", Name_Before);
+ Def ("clock", Name_Clock);
+ Def ("const", Name_Const);
+ Def ("cover", Name_Cover);
+ Def ("e", Name_E);
+ Def ("ef", Name_Ef);
+ Def ("eg", Name_Eg);
+ Def ("ex", Name_Ex);
+ Def ("endpoint", Name_Endpoint);
+ Def ("eventually", Name_Eventually);
+ Def ("fairness", Name_Fairness);
+ Def ("fell ", Name_Fell);
+ Def ("forall", Name_Forall);
+ Def ("g", Name_G);
+ Def ("inf", Name_Inf);
+ Def ("inherit", Name_Inherit);
+ Def ("never", Name_Never);
+ Def ("next_a", Name_Next_A);
+ Def ("next_e", Name_Next_E);
+ Def ("next_event", Name_Next_Event);
+ Def ("next_event_a", Name_Next_Event_A);
+ Def ("next_event_e", Name_Next_Event_E);
+ Def ("property", Name_Property);
+ Def ("prev", Name_Prev);
+ Def ("restrict", Name_Restrict);
+ Def ("restrict_guarantee", Name_Restrict_Guarantee);
+ Def ("rose", Name_Rose);
+ Def ("sequence", Name_Sequence);
+ Def ("strong", Name_Strong);
+ Def ("union", Name_Union);
+ Def ("vmode", Name_Vmode);
+ Def ("vprop", Name_Vprop);
+ Def ("vunit", Name_Vunit);
+ Def ("w", Name_W);
+ Def ("whilenot", Name_Whilenot);
+ Def ("within", Name_Within);
+ Def ("x", Name_X);
end Std_Names_Initialize;
end Std_Names;
diff --git a/std_names.ads b/std_names.ads
index b4455e05e..e6ba625bf 100644
--- a/std_names.ads
+++ b/std_names.ads
@@ -139,8 +139,10 @@ package Std_Names is
Name_With : constant Name_Id := Name_First_Keyword + 080;
Name_Last_Vhdl87 : constant Name_Id := Name_With;
+ subtype Name_Id_Vhdl87_Reserved_Words is
+ Name_Id range Name_First_Keyword .. Name_With;
- -- VHDL93 keywords.
+ -- VHDL93 reserved words.
Name_Xnor : constant Name_Id := Name_First_Keyword + 081;
Name_Group : constant Name_Id := Name_First_Keyword + 082;
Name_Impure : constant Name_Id := Name_First_Keyword + 083;
@@ -161,10 +163,35 @@ package Std_Names is
subtype Name_Shift_Operators is Name_Id range Name_Sll .. Name_Ror;
Name_Last_Vhdl93 : constant Name_Id := Name_Ror;
+ subtype Name_Id_Vhdl93_Reserved_Words is
+ Name_Id range Name_Xnor .. Name_Ror;
Name_Protected : constant Name_Id := Name_First_Keyword + 097;
- Name_Last_Keyword : constant Name_Id := Name_Protected;
+ Name_Last_Vhdl00 : constant Name_Id := Name_Protected;
+ subtype Name_Id_Vhdl00_Reserved_Words is
+ Name_Id range Name_Protected .. Name_Protected;
+
+ Name_Across : constant Name_Id := Name_First_Keyword + 098;
+ Name_Break : constant Name_Id := Name_First_Keyword + 099;
+ Name_Limit : constant Name_Id := Name_First_Keyword + 100;
+ Name_Nature : constant Name_Id := Name_First_Keyword + 101;
+ Name_Noise : constant Name_Id := Name_First_Keyword + 102;
+ Name_Procedural : constant Name_Id := Name_First_Keyword + 103;
+ Name_Quantity : constant Name_Id := Name_First_Keyword + 104;
+ Name_Reference : constant Name_Id := Name_First_Keyword + 105;
+ Name_Spectrum : constant Name_Id := Name_First_Keyword + 106;
+ Name_Subnature : constant Name_Id := Name_First_Keyword + 107;
+ Name_Terminal : constant Name_Id := Name_First_Keyword + 108;
+ Name_Through : constant Name_Id := Name_First_Keyword + 109;
+ Name_Tolerance : constant Name_Id := Name_First_Keyword + 110;
+
+ Name_Last_AMS_Vhdl : constant Name_Id := Name_Tolerance;
+
+ subtype Name_Id_AMS_Reserved_Words is
+ Name_Id range Name_Across .. Name_Tolerance;
+
+ Name_Last_Keyword : constant Name_Id := Name_Tolerance;
subtype Name_Id_Keywords is
Name_Id range Name_First_Keyword .. Name_Last_Keyword;
@@ -241,11 +268,25 @@ package Std_Names is
subtype Name_Id_Vhdl93_Attributes is Name_Id
range Name_First_Vhdl93_Attribute ..Name_Last_Vhdl93_Attribute;
+
+ Name_First_AMS_Attribute : constant Name_Id :=
+ Name_Last_Vhdl93_Attribute + 1;
+ Name_Contribution : constant Name_Id := Name_First_AMS_Attribute + 000;
+ Name_Dot : constant Name_Id := Name_First_AMS_Attribute + 001;
+ Name_Integ : constant Name_Id := Name_First_AMS_Attribute + 002;
+ Name_Above : constant Name_Id := Name_First_AMS_Attribute + 003;
+ Name_ZOH : constant Name_Id := Name_First_AMS_Attribute + 004;
+ Name_LTF : constant Name_Id := Name_First_AMS_Attribute + 005;
+ Name_ZTF : constant Name_Id := Name_First_AMS_Attribute + 006;
+ Name_Ramp : constant Name_Id := Name_First_AMS_Attribute + 007;
+ Name_Slew : constant Name_Id := Name_First_AMS_Attribute + 008;
+ Name_Last_AMS_Attribute : constant Name_Id := Name_Slew;
+
subtype Name_Id_Name_Attributes is Name_Id
range Name_Simple_Name .. Name_Path_Name;
-- Names used in std.standard package.
- Name_First_Standard : constant Name_Id := Name_Last_Vhdl93_Attribute + 1;
+ Name_First_Standard : constant Name_Id := Name_Last_AMS_Attribute + 1;
Name_Std : constant Name_Id := Name_First_Standard + 000;
Name_Standard : constant Name_Id := Name_First_Standard + 001;
Name_Boolean : constant Name_Id := Name_First_Standard + 002;
@@ -289,7 +330,17 @@ package Std_Names is
Name_Name_Error : constant Name_Id := Name_First_Standard + 040;
Name_Mode_Error : constant Name_Id := Name_First_Standard + 041;
Name_Foreign : constant Name_Id := Name_First_Standard + 042;
- Name_Last_Standard : constant Name_Id := Name_Foreign;
+
+ -- Added by AMS vhdl.
+ Name_Domain_Type : constant Name_Id := Name_First_Standard + 043;
+ Name_Quiescent_Domain : constant Name_Id := Name_First_Standard + 044;
+ Name_Time_Domain : constant Name_Id := Name_First_Standard + 045;
+ Name_Frequency_Domain : constant Name_Id := Name_First_Standard + 046;
+ Name_Domain : constant Name_Id := Name_First_Standard + 047;
+ Name_Frequency : constant Name_Id := Name_First_Standard + 048;
+ Name_Real_Vector : constant Name_Id := Name_First_Standard + 049;
+
+ Name_Last_Standard : constant Name_Id := Name_Real_Vector;
Name_First_Charname : constant Name_Id := Name_Last_Standard + 1;
Name_Nul : constant Name_Id := Name_First_Charname + 00;
@@ -519,7 +570,7 @@ package Std_Names is
Name_Eventually : constant Name_Id := Name_First_PSL + 16;
Name_Fairness : constant Name_Id := Name_First_PSL + 17;
Name_Fell : constant Name_Id := Name_First_PSL + 18;
- Name_forall : constant Name_Id := Name_First_PSL + 19;
+ Name_Forall : constant Name_Id := Name_First_PSL + 19;
Name_G : constant Name_Id := Name_First_PSL + 20;
-- Name_In
Name_Inf : constant Name_Id := Name_First_PSL + 21;
diff --git a/tokens.adb b/tokens.adb
index 2022ecc4b..07dd1ac7a 100644
--- a/tokens.adb
+++ b/tokens.adb
@@ -70,6 +70,9 @@ package body Tokens is
when Tok_Bit_String =>
return "<bit string>";
+ when Tok_Equal_Equal =>
+ return "==";
+
-- relational_operator:
when Tok_Equal =>
return "=";
@@ -317,9 +320,38 @@ package body Tokens is
when Tok_Ror =>
return "ror";
+ -- VHDL 00
when Tok_Protected =>
return "protected";
+ -- AMS-VHDL
+ when Tok_Across =>
+ return "across";
+ when Tok_Break =>
+ return "break";
+ when Tok_Limit =>
+ return "limit";
+ when Tok_Nature =>
+ return "nature";
+ when Tok_Noise =>
+ return "noise";
+ when Tok_Procedural =>
+ return "procedural";
+ when Tok_Quantity =>
+ return "quantity";
+ when Tok_Reference =>
+ return "reference";
+ when Tok_Spectrum =>
+ return "spectrum";
+ when Tok_Subnature =>
+ return "subnature";
+ when Tok_Terminal =>
+ return "terminal";
+ when Tok_Through =>
+ return "through";
+ when Tok_Tolerance =>
+ return "tolerance";
+
when Tok_And_And =>
return "&&";
when Tok_Bar_Bar =>
diff --git a/tokens.ads b/tokens.ads
index c3fd68345..c331c099e 100644
--- a/tokens.ads
+++ b/tokens.ads
@@ -37,6 +37,8 @@ package Tokens is
Tok_Box, -- <>
Tok_Dot, -- .
+ Tok_Equal_Equal, -- == (AMS Vhdl)
+
Tok_Eof, -- End of file.
Tok_Newline,
Tok_Comment,
@@ -208,6 +210,21 @@ package Tokens is
-- Added by Vhdl 2000:
Tok_Protected,
+ -- AMS reserved words
+ Tok_Across,
+ Tok_Break,
+ Tok_Limit,
+ Tok_Nature,
+ Tok_Noise,
+ Tok_Procedural,
+ Tok_Quantity,
+ Tok_Reference,
+ Tok_Spectrum,
+ Tok_Subnature,
+ Tok_Terminal,
+ Tok_Through,
+ Tok_Tolerance,
+
-- PSL words
Tok_Psl_Default,
Tok_Psl_Clock,
diff --git a/translate/gcc/Make-lang.in b/translate/gcc/Make-lang.in
index 5a0b2a580..5eab2db24 100644
--- a/translate/gcc/Make-lang.in
+++ b/translate/gcc/Make-lang.in
@@ -92,7 +92,7 @@ ghdllib: ghdl$(exeext) $(GCC_PASSES) force
# Build hooks:
-vhdl.all.build:
+vhdl.all.build:
vhdl.all.cross:
@echo "No support for building vhdl cross-compiler"
diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile
index b4199a990..47f6e0f23 100644
--- a/translate/ghdldrv/Makefile
+++ b/translate/ghdldrv/Makefile
@@ -61,7 +61,7 @@ ortho_code-x86-flags.ads:
echo "package Ortho_Code.X86.Flags renames Ortho_Code.X86.$(ORTHO_X86_FLAGS);" >> $@
ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
-ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) memsegs_c.o chkstk.o force
+ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) memsegs_c.o chkstk.o force
$(GNATMAKE) -aI../../ortho/mcode -aI../../ortho $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB))
ghdl_llvm_jit: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
@@ -158,7 +158,7 @@ install.simul:
$(MAKE) GHDL=ghdl_simul install.v87 install.v93
clean: force
- $(RM) -f *.o *.ali ghdl_gcc ghdl_mcode
+ $(RM) -f *.o *.ali ghdl_gcc ghdl_mcode
$(RM) -f b~*.ad? *~ default_pathes.ads
$(RM) -rf ../lib
diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb
index 9eaba5ce0..dedc1eb0a 100644
--- a/translate/ghdldrv/ghdlprint.adb
+++ b/translate/ghdldrv/ghdlprint.adb
@@ -374,17 +374,11 @@ package body Ghdlprint is
Disp_Spaces;
Disp_Text;
when Tok_Xnor .. Tok_Ror =>
- if Flags.Vhdl_Std > Vhdl_87 then
- Disp_Reserved;
- else
- Disp_Identifier;
- end if;
+ Disp_Reserved;
when Tok_Protected =>
- if Flags.Vhdl_Std >= Vhdl_00 then
- Disp_Reserved;
- else
- Disp_Identifier;
- end if;
+ Disp_Reserved;
+ when Tok_Across .. Tok_Tolerance =>
+ Disp_Reserved;
when Tok_Psl_Default
| Tok_Psl_Clock
| Tok_Psl_Property
@@ -429,6 +423,7 @@ package body Ghdlprint is
end if;
when Tok_Left_Paren .. Tok_Colon
| Tok_Comma .. Tok_Dot
+ | Tok_Equal_Equal
| Tok_Integer
| Tok_Real
| Tok_Equal .. Tok_Slash
diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc
index f0bdf61c6..2cd6722cd 100644
--- a/translate/grt/Makefile.inc
+++ b/translate/grt/Makefile.inc
@@ -62,7 +62,7 @@ ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),)
GRT_TARGET_OBJS=i386.o linux.o times.o
GRT_EXTRA_LIB=
endif
-ifeq ($(filter-out x84_64 darwin%,$(arch) $(osys)),)
+ifeq ($(filter-out x86_64 darwin%,$(arch) $(osys)),)
GRT_TARGET_OBJS=amd64.o linux.o times.o
GRT_EXTRA_LIB=
endif
diff --git a/translate/grt/config/amd64.S b/translate/grt/config/amd64.S
index 76475acdb..aa9a8c2ae 100644
--- a/translate/grt/config/amd64.S
+++ b/translate/grt/config/amd64.S
@@ -18,26 +18,34 @@
*/
.file "amd64.S"
.version "01.01"
-
+
+#ifdef __ELF__
+#define ENTRY(func) .align 4; .globl func; .type func,@function; func:
+#define END(func) .size func, . - func
+#define NAME(name) name
+#elif __APPLE__
+#define ENTRY(func) .align 4; .globl _##func; _##func:
+#define END(func)
+#define NAME(name) _##name
+#else
+#define ENTRY(func) .align 4; func:
+#define END(func)
+#define NAME(name) name
+#endif
.text
- /* Function called to loop on the process. */
- .align 4
- .type grt_stack_loop,@function
-grt_stack_loop:
+ /* Function called to loop on the process. */
+ENTRY(grt_stack_loop)
mov 0(%rsp),%rdi
call *8(%rsp)
- jmp grt_stack_loop
- .size grt_stack_loop, . - grt_stack_loop
+ jmp NAME(grt_stack_loop)
+END(grt_stack_loop)
/* function Stack_Create (Func : Address; Arg : Address)
return Stack_Type;
Args: FUNC (RDI), ARG (RSI)
*/
- .align 4
- .globl grt_stack_create
- .type grt_stack_create,@function
-grt_stack_create:
+ENTRY(grt_stack_create)
/* Standard prologue. */
pushq %rbp
movq %rsp,%rbp
@@ -45,15 +53,15 @@ grt_stack_create:
sub $0x10,%rsp
mov %rdi,-8(%rbp)
mov %rsi,-16(%rbp)
-
+
/* Allocate the stack, and exit in case of failure */
- callq grt_stack_allocate
+ callq NAME(grt_stack_allocate)
test %rax,%rax
je .Ldone
/* Note: %RAX contains the address of the stack_context. This is
also the top of the stack. */
-
+
/* Prepare stack. */
/* The function to be executed. */
mov -8(%rbp), %rdi
@@ -62,7 +70,12 @@ grt_stack_create:
mov -16(%rbp), %rsi
mov %rsi, -16(%rax)
/* The return function. Must be 8 mod 16. */
+#if __APPLE__
+ movq _grt_stack_loop@GOTPCREL(%rip), %rsi
+ movq %rsi, -24(%rax)
+#else
movq $grt_stack_loop, -24(%rax)
+#endif
/* The context. */
mov %rbp, -32(%rax)
mov %rbx, -40(%rax)
@@ -78,16 +91,13 @@ grt_stack_create:
.Ldone:
leave
ret
- .size grt_stack_create,. - grt_stack_create
+END(grt_stack_create)
- .align 4
- .globl grt_stack_switch
/* Arguments: TO (RDI), FROM (RSI) [VAL (RDX)]
Both are pointers to a stack_context. */
- .type grt_stack_switch,@function
-grt_stack_switch:
+ENTRY(grt_stack_switch)
/* Save call-used registers. */
pushq %rbp
pushq %rbx
@@ -110,7 +120,6 @@ grt_stack_switch:
movq %rdx, %rax
/* Run. */
ret
- .size grt_stack_switch, . - grt_stack_switch
+END(grt_stack_switch)
-
.ident "Written by T.Gingold"
diff --git a/translate/grt/config/clock.c b/translate/grt/config/clock.c
index 038ce2210..038ce2210 100644..100755
--- a/translate/grt/config/clock.c
+++ b/translate/grt/config/clock.c
diff --git a/translate/grt/config/i386.S b/translate/grt/config/i386.S
index 2490ea1dd..5c8aa0d3a 100644
--- a/translate/grt/config/i386.S
+++ b/translate/grt/config/i386.S
@@ -18,7 +18,7 @@
*/
.file "i386.S"
.version "01.01"
-
+
.text
#ifdef __ELF__
@@ -34,7 +34,7 @@
#define END(func)
#define NAME(name) name
#endif
-
+
/* Function called to loop on the process. */
ENTRY(grt_stack_loop)
call *4(%esp)
@@ -50,7 +50,7 @@ ENTRY(grt_stack_create)
movl %esp,%ebp
/* Keep aligned (call + pushl + 8 = 16 bytes). */
subl $8,%esp
-
+
/* Allocate the stack, and exit in case of failure */
call NAME(grt_stack_allocate)
testl %eax,%eax
@@ -58,7 +58,7 @@ ENTRY(grt_stack_create)
/* Note: %EAX contains the address of the stack_context. This is
also the top of the stack. */
-
+
/* Prepare stack. */
/* The function to be executed. */
movl 8(%ebp), %ecx
@@ -67,7 +67,13 @@ ENTRY(grt_stack_create)
movl 12(%ebp), %ecx
movl %ecx, -8(%eax)
/* The return function. */
+#if __APPLE__
+ call ___x86.get_pc_thunk.cx
+L1$pb:
+ movl L_grt_stack_loop$non_lazy_ptr-L1$pb(%ecx), %eax
+#else
movl $NAME(grt_stack_loop), -12(%eax)
+#endif
/* The context. */
movl %ebx, -16(%eax)
movl %esi, -20(%eax)
@@ -109,5 +115,19 @@ ENTRY(grt_stack_switch)
ret
END(grt_stack_switch)
-
+
+#if __APPLE__
+ .section __TEXT,__textcoal_nt,coalesced,pure_instructions
+ .weak_definition ___x86.get_pc_thunk.cx
+ .private_extern ___x86.get_pc_thunk.cx
+___x86.get_pc_thunk.cx:
+ movl (%esp), %ecx
+ ret
+
+ .section __IMPORT,__pointers,non_lazy_symbol_pointers
+L_grt_stack_loop$non_lazy_ptr:
+ .indirect_symbol _grt_stack_loop
+ .long 0
+#endif
+
.ident "Written by T.Gingold"
diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb
index 336cf4e0a..97a36ae17 100644
--- a/translate/grt/grt-values.adb
+++ b/translate/grt/grt-values.adb
@@ -350,7 +350,7 @@ package body Grt.Values is
S.Bounds := To_Std_String_Boundp(Bound'Address);
-- find characters at the end...
- Finish := Ghdl_Index_Type(Bound.Dim_1.Length)-1;
+ Finish := Bound.Dim_1.Length - 1;
while White(S.Base.all(Finish)) loop
Finish := Finish - 1;
end loop;
@@ -389,7 +389,7 @@ package body Grt.Values is
end;
if Rti.Kind = Ghdl_Rtik_Type_P64 then
- Mult := Ghdl_I64(Multiple.Unit_64);
+ Mult := Multiple.Unit_64;
else
Mult := Ghdl_I64(Multiple.Unit_32);
end if;
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
index b262560c6..aa7f352ea 100644
--- a/translate/grt/grt-vcd.adb
+++ b/translate/grt/grt-vcd.adb
@@ -604,7 +604,9 @@ package body Grt.Vcd is
Fact := 0.1;
Delta_Exp := 1;
end if;
- while 1 = 1 loop -- Seek the first digit
+
+ -- Seek the first digit
+ loop
Digit := Digit_Floor(Val_tmp);
if Digit > 0 then
exit;
diff --git a/translate/translation.adb b/translate/translation.adb
index 71c05971f..8c46561fc 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -10278,7 +10278,6 @@ package body Translation is
Atype := Tinfo.Ortho_Ptr_Type (Mode_Value);
end case;
when Type_Mode_Record =>
- -- part 1 of fix for https://gna.org/bugs/?19195
-- Create an object pointer.
-- At elaboration: copy base from name.
Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind);
@@ -10342,7 +10341,6 @@ package body Translation is
M2E (Name_Node));
end case;
when Type_Mode_Record =>
- -- part 2 of fix for https://gna.org/bugs/?19195
Open_Temp;
Stabilize (Name_Node);
New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var),
@@ -13220,7 +13218,6 @@ package body Translation is
return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
end if;
when Type_Mode_Record =>
- -- part 3 of fix for https://gna.org/bugs/?19195
R := Get_Var (Name_Info.Alias_Var);
return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
when others =>
@@ -27746,16 +27743,17 @@ package body Translation is
if False then
El := Get_Context_Items (Unit);
--- while El /= Null_Iir loop
--- case Get_Kind (El) is
--- when Iir_Kind_Use_Clause =>
--- null;
--- when Iir_Kind_Library_Clause =>
--- null;
--- when others =>
--- Error_Kind ("translate1", El);
--- end case;
--- end loop;
+ while El /= Null_Iir loop
+ case Get_Kind (El) is
+ when Iir_Kind_Use_Clause =>
+ null;
+ when Iir_Kind_Library_Clause =>
+ null;
+ when others =>
+ Error_Kind ("translate1", El);
+ end case;
+ El := Get_Chain (El);
+ end loop;
end if;
El := Get_Library_Unit (Unit);