diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 3 | ||||
-rw-r--r-- | src/std_names.adb | 2 | ||||
-rw-r--r-- | src/std_names.ads | 80 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 250 | ||||
-rw-r--r-- | src/vhdl/tokens.adb | 2 | ||||
-rw-r--r-- | src/vhdl/tokens.ads | 1 |
6 files changed, 234 insertions, 104 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 9df87930b..00fc9c25a 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -386,7 +386,8 @@ package body Ghdlprint is Disp_Reserved; when Tok_Protected => Disp_Reserved; - when Tok_Context => + when Tok_Context + | Tok_Parameter => Disp_Reserved; when Tok_Across .. Tok_Tolerance => Disp_Reserved; diff --git a/src/std_names.adb b/src/std_names.adb index 971effb08..253f844ad 100644 --- a/src/std_names.adb +++ b/src/std_names.adb @@ -155,6 +155,7 @@ package body Std_Names is Def ("protected", Name_Protected); Def ("context", Name_Context); + Def ("parameter", Name_Parameter); Def ("across", Name_Across); Def ("break", Name_Break); @@ -451,7 +452,6 @@ package body Std_Names is 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); diff --git a/src/std_names.ads b/src/std_names.ads index 431a8c7dd..70badeb34 100644 --- a/src/std_names.ads +++ b/src/std_names.ads @@ -170,13 +170,14 @@ package Std_Names is Name_Last_Vhdl00 : constant Name_Id := Name_Protected; subtype Name_Id_Vhdl00_Reserved_Words is - Name_Id range Name_Protected .. Name_Protected; + Name_Id range Name_Protected .. Name_Last_Vhdl00; Name_Context : constant Name_Id := Name_First_Keyword + 098; + Name_Parameter : constant Name_Id := Name_First_Keyword + 099; - Name_Last_Vhdl08 : constant Name_Id := Name_Context; + Name_Last_Vhdl08 : constant Name_Id := Name_Parameter; subtype Name_Id_Vhdl08_Reserved_Words is - Name_Id range Name_Context .. Name_Context; + Name_Id range Name_Context .. Name_Last_Vhdl08; Name_First_Ams_Keyword : constant Name_Id := Name_Last_Vhdl08 + 1; Name_Across : constant Name_Id := Name_First_Ams_Keyword + 000; @@ -523,43 +524,42 @@ package Std_Names is Name_Notif0 : constant Name_Id := Name_First_Verilog + 31; Name_Notif1 : constant Name_Id := Name_First_Verilog + 32; Name_Output : constant Name_Id := Name_First_Verilog + 33; - Name_Parameter : constant Name_Id := Name_First_Verilog + 34; - Name_Pmos : constant Name_Id := Name_First_Verilog + 35; - Name_Posedge : constant Name_Id := Name_First_Verilog + 36; - Name_Primitive : constant Name_Id := Name_First_Verilog + 37; - Name_Pull0 : constant Name_Id := Name_First_Verilog + 38; - Name_Pull1 : constant Name_Id := Name_First_Verilog + 39; - Name_Pulldown : constant Name_Id := Name_First_Verilog + 40; - Name_Pullup : constant Name_Id := Name_First_Verilog + 41; - Name_Reg : constant Name_Id := Name_First_Verilog + 42; - Name_Repeat : constant Name_Id := Name_First_Verilog + 43; - Name_Rcmos : constant Name_Id := Name_First_Verilog + 44; - Name_Rnmos : constant Name_Id := Name_First_Verilog + 45; - Name_Rpmos : constant Name_Id := Name_First_Verilog + 46; - Name_Rtran : constant Name_Id := Name_First_Verilog + 47; - Name_Rtranif0 : constant Name_Id := Name_First_Verilog + 48; - Name_Rtranif1 : constant Name_Id := Name_First_Verilog + 49; - Name_Small : constant Name_Id := Name_First_Verilog + 50; - Name_Specify : constant Name_Id := Name_First_Verilog + 51; - Name_Specparam : constant Name_Id := Name_First_Verilog + 52; - Name_Strong0 : constant Name_Id := Name_First_Verilog + 53; - Name_Strong1 : constant Name_Id := Name_First_Verilog + 54; - Name_Supply0 : constant Name_Id := Name_First_Verilog + 55; - Name_Supply1 : constant Name_Id := Name_First_Verilog + 56; - Name_Tablex : constant Name_Id := Name_First_Verilog + 57; - Name_Task : constant Name_Id := Name_First_Verilog + 58; - Name_Tran : constant Name_Id := Name_First_Verilog + 59; - Name_Tranif0 : constant Name_Id := Name_First_Verilog + 60; - Name_Tranif1 : constant Name_Id := Name_First_Verilog + 61; - Name_Tri : constant Name_Id := Name_First_Verilog + 62; - Name_Tri0 : constant Name_Id := Name_First_Verilog + 63; - Name_Tri1 : constant Name_Id := Name_First_Verilog + 64; - Name_Trireg : constant Name_Id := Name_First_Verilog + 65; - Name_Wand : constant Name_Id := Name_First_Verilog + 66; - Name_Weak0 : constant Name_Id := Name_First_Verilog + 67; - Name_Weak1 : constant Name_Id := Name_First_Verilog + 68; - Name_Wire : constant Name_Id := Name_First_Verilog + 69; - Name_Wor : constant Name_Id := Name_First_Verilog + 70; + Name_Pmos : constant Name_Id := Name_First_Verilog + 34; + Name_Posedge : constant Name_Id := Name_First_Verilog + 35; + Name_Primitive : constant Name_Id := Name_First_Verilog + 36; + Name_Pull0 : constant Name_Id := Name_First_Verilog + 37; + Name_Pull1 : constant Name_Id := Name_First_Verilog + 38; + Name_Pulldown : constant Name_Id := Name_First_Verilog + 39; + Name_Pullup : constant Name_Id := Name_First_Verilog + 40; + Name_Reg : constant Name_Id := Name_First_Verilog + 41; + Name_Repeat : constant Name_Id := Name_First_Verilog + 42; + Name_Rcmos : constant Name_Id := Name_First_Verilog + 43; + Name_Rnmos : constant Name_Id := Name_First_Verilog + 44; + Name_Rpmos : constant Name_Id := Name_First_Verilog + 45; + Name_Rtran : constant Name_Id := Name_First_Verilog + 46; + Name_Rtranif0 : constant Name_Id := Name_First_Verilog + 47; + Name_Rtranif1 : constant Name_Id := Name_First_Verilog + 48; + Name_Small : constant Name_Id := Name_First_Verilog + 49; + Name_Specify : constant Name_Id := Name_First_Verilog + 50; + Name_Specparam : constant Name_Id := Name_First_Verilog + 51; + Name_Strong0 : constant Name_Id := Name_First_Verilog + 52; + Name_Strong1 : constant Name_Id := Name_First_Verilog + 53; + Name_Supply0 : constant Name_Id := Name_First_Verilog + 54; + Name_Supply1 : constant Name_Id := Name_First_Verilog + 55; + Name_Tablex : constant Name_Id := Name_First_Verilog + 56; + Name_Task : constant Name_Id := Name_First_Verilog + 57; + Name_Tran : constant Name_Id := Name_First_Verilog + 58; + Name_Tranif0 : constant Name_Id := Name_First_Verilog + 59; + Name_Tranif1 : constant Name_Id := Name_First_Verilog + 60; + Name_Tri : constant Name_Id := Name_First_Verilog + 61; + Name_Tri0 : constant Name_Id := Name_First_Verilog + 62; + Name_Tri1 : constant Name_Id := Name_First_Verilog + 63; + Name_Trireg : constant Name_Id := Name_First_Verilog + 64; + Name_Wand : constant Name_Id := Name_First_Verilog + 65; + Name_Weak0 : constant Name_Id := Name_First_Verilog + 66; + Name_Weak1 : constant Name_Id := Name_First_Verilog + 67; + Name_Wire : constant Name_Id := Name_First_Verilog + 68; + Name_Wor : constant Name_Id := Name_First_Verilog + 69; Name_Last_Verilog : constant Name_Id := Name_Wor; -- Verilog Directives. diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 4f3dcd658..115b603a0 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -63,6 +63,8 @@ package body Parse is procedure Parse_Concurrent_Statements (Parent : Iir); function Parse_Subprogram_Declaration return Iir; function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir; + function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : Iir) + return Iir; procedure Parse_Component_Specification (Res : Iir); function Parse_Binding_Indication return Iir_Binding_Indication; function Parse_Aggregate return Iir; @@ -1458,6 +1460,172 @@ package body Parse is return Inter; end Parse_Interface_Package_Declaration; + -- Precond: identifier or string + -- Postcond: next token + -- + -- [ 2.1 ] + -- designator ::= identifier | operator_symbol + procedure Parse_Subprogram_Designator (Subprg : Iir) is + begin + if Current_Token = Tok_Identifier then + Set_Identifier (Subprg, Current_Identifier); + Set_Location (Subprg); + elsif Current_Token = Tok_String then + if Kind_In (Subprg, Iir_Kind_Procedure_Declaration, + Iir_Kind_Interface_Procedure_Declaration) + then + -- LRM93 2.1 + -- A procedure designator is always an identifier. + Error_Msg_Parse ("a procedure name must be an identifier"); + end if; + -- LRM93 2.1 + -- A function designator is either an identifier or an operator + -- symbol. + Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location)); + Set_Location (Subprg); + else + -- Just to display a parse error. + Expect (Tok_Identifier); + end if; + + -- Eat designator (identifier or string). + Scan; + end Parse_Subprogram_Designator; + + -- Precond: '(' or return or any + -- Postcond: next token + procedure Parse_Subprogram_Parameters_And_Return + (Subprg : Iir; Is_Func : Boolean) + is + Old : Iir; + pragma Unreferenced (Old); + Inters : Iir; + begin + if Current_Token = Tok_Parameter then + -- Eat 'parameter' + Scan; + + if Current_Token /= Tok_Left_Paren then + Error_Msg_Parse + ("'parameter' must be followed by a list of parameters"); + end if; + end if; + + if Current_Token = Tok_Left_Paren then + -- Parse the interface declaration. + if Is_Func then + Inters := Parse_Interface_List + (Function_Parameter_Interface_List, Subprg); + else + Inters := Parse_Interface_List + (Procedure_Parameter_Interface_List, Subprg); + end if; + Set_Interface_Declaration_Chain (Subprg, Inters); + end if; + + if Current_Token = Tok_Return then + if not Is_Func then + Error_Msg_Parse + ("'return' not allowed for a procedure", Cont => True); + Error_Msg_Parse + ("(remove return part or declare a function)"); + + -- Skip 'return' + Scan; + + Old := Parse_Type_Mark; + else + -- Skip 'return' + Scan; + + Set_Return_Type_Mark + (Subprg, Parse_Type_Mark (Check_Paren => True)); + end if; + else + if Is_Func then + Error_Msg_Parse ("'return' expected"); + end if; + end if; + end Parse_Subprogram_Parameters_And_Return; + + -- Precond: PROCEDURE, FUNCTION, PURE, IMPURE + -- Postcond: next token + -- + -- LRM08 6.5.4 Interface subrpogram declarations + -- interface_subprogram_declaration ::= + -- interface_subprogram_specification + -- [ IS interface_subprogram_default ] + -- + -- interface_subrpogram_specification ::= + -- interface_procedure_specification | interface_function_specification + -- + -- interface_procedure_specification ::= + -- PROCEDURE designator + -- [ [ PARAMETER ] ( formal_parameter_list ) ] + -- + -- interface_function_specification ::= + -- [ PURE | IMPURE ] FUNCTION designator + -- [ [ PARAMETER ] ( formal_parameter_list ) ] RETURN type_mark + -- + -- interface_subprogram_default ::= + -- /subprogram/_name | <> + function Parse_Interface_Subprogram_Declaration return Iir + is + Kind : Iir_Kind; + Subprg: Iir; + Old : Iir; + pragma Unreferenced (Old); + begin + -- Create the node. + case Current_Token is + when Tok_Procedure => + Kind := Iir_Kind_Interface_Procedure_Declaration; + when Tok_Function + | Tok_Pure + | Tok_Impure => + Kind := Iir_Kind_Interface_Function_Declaration; + when others => + raise Internal_Error; + end case; + Subprg := Create_Iir (Kind); + Set_Location (Subprg); + + case Current_Token is + when Tok_Procedure => + null; + when Tok_Function => + -- LRM93 2.1 + -- A function is impure if its specification contains the + -- reserved word IMPURE; otherwise it is said to be pure. + Set_Pure_Flag (Subprg, True); + when Tok_Pure + | Tok_Impure => + Set_Pure_Flag (Subprg, Current_Token = Tok_Pure); + Set_Has_Pure (Subprg, True); + -- FIXME: what to do in case of error ?? + + -- Eat 'pure' or 'impure'. + Scan; + + Expect (Tok_Function, "'function' must follow 'pure' or 'impure'"); + when others => + raise Internal_Error; + end case; + + -- Eat 'procedure' or 'function'. + Scan; + + -- Designator. + Parse_Subprogram_Designator (Subprg); + + Parse_Subprogram_Parameters_And_Return + (Subprg, Kind = Iir_Kind_Interface_Function_Declaration); + + -- TODO: interface_subprogram_default + + return Subprg; + end Parse_Interface_Subprogram_Declaration; + -- Precond : '(' -- Postcond: next token -- @@ -1510,12 +1678,24 @@ package body Parse is end if; Inters := Create_Iir (Iir_Kind_Interface_Type_Declaration); Scan_Expect (Tok_Identifier, - "am identifier is expected after 'type'"); + "an identifier is expected after 'type'"); Set_Identifier (Inters, Current_Identifier); Set_Location (Inters); -- Skip identifier Scan; + when Tok_Procedure + | Tok_Pure + | Tok_Impure + | Tok_Function => + if Ctxt /= Generic_Interface_List then + Error_Msg_Parse + ("subprogram interface only allowed in generic interface"); + elsif Flags.Vhdl_Std < Vhdl_08 then + Error_Msg_Parse + ("subprogram interface not allowed before vhdl 08"); + end if; + Inters := Parse_Interface_Subprogram_Declaration; when Tok_Right_Paren => if Res = Null_Iir then Error_Msg_Parse @@ -1526,9 +1706,7 @@ package body Parse is end if; exit; when others => - Error_Msg_Parse - ("'signal', 'constant', 'variable', 'file' " - & "or identifier expected"); + Error_Msg_Parse ("interface declaration expected"); -- Use a variable interface as a fall-back. Inters := Parse_Interface_Object_Declaration (Ctxt); end case; @@ -1551,7 +1729,8 @@ package body Parse is case Current_Token is when Tok_Comma => - Error_Msg_Parse ("';' expected instead of ','"); + Error_Msg_Parse + ("interfaces must be separated by ';' (found ',')"); when Tok_Semi_Colon => null; when others => @@ -6230,7 +6409,6 @@ package body Parse is function Parse_Subprogram_Declaration return Iir is Kind : Iir_Kind; - Inters : Iir; Subprg: Iir; Subprg_Body : Iir; Old : Iir; @@ -6280,63 +6458,11 @@ package body Parse is -- Eat 'procedure' or 'function'. Scan; - if Current_Token = Tok_Identifier then - Set_Identifier (Subprg, Current_Identifier); - Set_Location (Subprg); - elsif Current_Token = Tok_String then - if Kind = Iir_Kind_Procedure_Declaration then - -- LRM93 2.1 - -- A procedure designator is always an identifier. - Error_Msg_Parse ("a procedure name must be an identifier"); - end if; - -- LRM93 2.1 - -- A function designator is either an identifier or an operator - -- symbol. - Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location)); - Set_Location (Subprg); - else - -- Just to display a parse error. - Expect (Tok_Identifier); - end if; - - -- Eat designator (identifier or string). - Scan; - - if Current_Token = Tok_Left_Paren then - -- Parse the interface declaration. - if Kind = Iir_Kind_Function_Declaration then - Inters := Parse_Interface_List - (Function_Parameter_Interface_List, Subprg); - else - Inters := Parse_Interface_List - (Procedure_Parameter_Interface_List, Subprg); - end if; - Set_Interface_Declaration_Chain (Subprg, Inters); - end if; - - if Current_Token = Tok_Return then - if Kind = Iir_Kind_Procedure_Declaration then - Error_Msg_Parse - ("'return' not allowed for a procedure", Cont => True); - Error_Msg_Parse - ("(remove return part or declare a function)"); - - -- Skip 'return' - Scan; + -- Designator. + Parse_Subprogram_Designator (Subprg); - Old := Parse_Type_Mark; - else - -- Skip 'return' - Scan; - - Set_Return_Type_Mark - (Subprg, Parse_Type_Mark (Check_Paren => True)); - end if; - else - if Kind = Iir_Kind_Function_Declaration then - Error_Msg_Parse ("'return' expected"); - end if; - end if; + Parse_Subprogram_Parameters_And_Return + (Subprg, Kind = Iir_Kind_Function_Declaration); if Current_Token = Tok_Semi_Colon then return Subprg; diff --git a/src/vhdl/tokens.adb b/src/vhdl/tokens.adb index 97062b72b..a46edf017 100644 --- a/src/vhdl/tokens.adb +++ b/src/vhdl/tokens.adb @@ -351,6 +351,8 @@ package body Tokens is -- VHDL 08 when Tok_Context => return "context"; + when Tok_Parameter => + return "parameter"; -- AMS-VHDL when Tok_Across => diff --git a/src/vhdl/tokens.ads b/src/vhdl/tokens.ads index aaabaa650..ada8c899a 100644 --- a/src/vhdl/tokens.ads +++ b/src/vhdl/tokens.ads @@ -234,6 +234,7 @@ package Tokens is -- Added by vhdl 2008: Tok_Context, + Tok_Parameter, -- AMS reserved words Tok_Across, |