diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 8 | ||||
-rw-r--r-- | src/vhdl/vhdl-parse_psl.adb | 80 | ||||
-rw-r--r-- | src/vhdl/vhdl-prints.adb | 2 | ||||
-rw-r--r-- | src/vhdl/vhdl-scanner.adb | 85 | ||||
-rw-r--r-- | src/vhdl/vhdl-scanner.ads | 8 | ||||
-rw-r--r-- | src/vhdl/vhdl-tokens.adb | 16 | ||||
-rw-r--r-- | src/vhdl/vhdl-tokens.ads | 16 |
7 files changed, 148 insertions, 67 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index c4eb08da7..8510adabe 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -406,11 +406,17 @@ package body Ghdlprint is | Tok_Until_Em_Un | Tok_Always | Tok_Never - | Tok_Eventually + | Tok_Eventually_Em + | Tok_Next_Em | Tok_Next_A + | Tok_Next_A_Em | Tok_Next_E + | Tok_Next_E_Em | Tok_Next_Event + | Tok_Next_Event_Em | Tok_Next_Event_A + | Tok_Next_Event_A_Em + | Tok_Next_Event_E_Em | Tok_Next_Event_E => Disp_Spaces; Disp_Text; diff --git a/src/vhdl/vhdl-parse_psl.adb b/src/vhdl/vhdl-parse_psl.adb index b4957b1ab..956414e0f 100644 --- a/src/vhdl/vhdl-parse_psl.adb +++ b/src/vhdl/vhdl-parse_psl.adb @@ -485,24 +485,27 @@ package body Vhdl.Parse_Psl is end if; end Parse_Parenthesis_FL_Property; - -- Parse [ '!' ] '[' finite_Range ']' '(' FL_Property ')' - function Parse_Range_Property (K : Nkind) return Node is + -- Parse '[' finite_Range ']' '(' FL_Property ')' + function Parse_Range_Property (K : Nkind; Strong : Boolean) return Node + is Res : Node; begin Res := Create_Node_Loc (K); - Set_Strong_Flag (Res, Scan_Exclam_Mark); + Set_Strong_Flag (Res, Strong); Scan; Parse_Bracket_Range (Res); Set_Property (Res, Parse_Parenthesis_FL_Property); return Res; end Parse_Range_Property; - -- Parse [ '!' ] '(' Boolean ')' '[' Range ']' '(' FL_Property ')' - function Parse_Boolean_Range_Property (K : Nkind) return Node is + -- Parse '(' Boolean ')' '[' Range ']' '(' FL_Property ')' + function Parse_Boolean_Range_Property (K : Nkind; Strong : Boolean) + return Node + is Res : Node; begin Res := Create_Node_Loc (K); - Set_Strong_Flag (Res, Scan_Exclam_Mark); + Set_Strong_Flag (Res, Strong); Scan; Set_Boolean (Res, Parse_Parenthesis_Boolean); Parse_Bracket_Range (Res); @@ -524,11 +527,8 @@ package body Vhdl.Parse_Psl is Res := Create_Node_Loc (N_Never); Scan; Set_Property (Res, Parse_FL_Property (Prio_FL_Invariance)); - when Tok_Eventually => + when Tok_Eventually_Em => Res := Create_Node_Loc (N_Eventually); - if not Scan_Exclam_Mark then - Error_Msg_Parse ("'eventually' must be followed by '!'"); - end if; Scan; Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence)); when Tok_Next => @@ -541,9 +541,13 @@ package body Vhdl.Parse_Psl is Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence)); end if; when Tok_Next_A => - Res := Parse_Range_Property (N_Next_A); + Res := Parse_Range_Property (N_Next_A, False); + when Tok_Next_A_Em => + Res := Parse_Range_Property (N_Next_A, True); when Tok_Next_E => - Res := Parse_Range_Property (N_Next_E); + Res := Parse_Range_Property (N_Next_E, False); + when Tok_Next_E_Em => + Res := Parse_Range_Property (N_Next_E, True); when Tok_Next_Event => Res := Create_Node_Loc (N_Next_Event); Scan; @@ -553,9 +557,13 @@ package body Vhdl.Parse_Psl is end if; Set_Property (Res, Parse_Parenthesis_FL_Property); when Tok_Next_Event_A => - Res := Parse_Boolean_Range_Property (N_Next_Event_A); + Res := Parse_Boolean_Range_Property (N_Next_Event_A, False); + when Tok_Next_Event_A_Em => + Res := Parse_Boolean_Range_Property (N_Next_Event_A, True); when Tok_Next_Event_E => - Res := Parse_Boolean_Range_Property (N_Next_Event_E); + Res := Parse_Boolean_Range_Property (N_Next_Event_E, False); + when Tok_Next_Event_E_Em => + Res := Parse_Boolean_Range_Property (N_Next_Event_E, True); when Tok_Left_Paren => return Parse_Parenthesis_FL_Property; when Tok_Left_Curly => @@ -576,12 +584,15 @@ package body Vhdl.Parse_Psl is return Res; end Parse_FL_Property_1; - function Parse_St_Binary_FL_Property (K : Nkind; Left : Node) return Node is + function Parse_St_Binary_FL_Property + (K : Nkind; Left : Node; Strong : Boolean; Inclusive : Boolean) + return Node + is Res : Node; begin Res := Create_Node_Loc (K); - Set_Strong_Flag (Res, Scan_Exclam_Mark); - Set_Inclusive_Flag (Res, Scan_Underscore); + Set_Strong_Flag (Res, Strong); + Set_Inclusive_Flag (Res, Inclusive); Scan; Set_Left (Res, Left); Set_Right (Res, Parse_FL_Property (Prio_FL_Bounding)); @@ -746,12 +757,43 @@ package body Vhdl.Parse_Psl is if Prio > Prio_FL_Bounding then return Res; end if; - Res := Parse_St_Binary_FL_Property (N_Until, Res); + Res := Parse_St_Binary_FL_Property (N_Until, Res, False, False); + when Tok_Until_Em => + if Prio > Prio_FL_Bounding then + return Res; + end if; + Res := Parse_St_Binary_FL_Property (N_Until, Res, True, False); + when Tok_Until_Un => + if Prio > Prio_FL_Bounding then + return Res; + end if; + Res := Parse_St_Binary_FL_Property (N_Until, Res, False, True); + when Tok_Until_Em_Un => + if Prio > Prio_FL_Bounding then + return Res; + end if; + Res := Parse_St_Binary_FL_Property (N_Until, Res, True, True); when Tok_Before => if Prio > Prio_FL_Bounding then return Res; end if; - Res := Parse_St_Binary_FL_Property (N_Before, Res); + Res := Parse_St_Binary_FL_Property + (N_Before, Res, False, False); + when Tok_Before_Em => + if Prio > Prio_FL_Bounding then + return Res; + end if; + Res := Parse_St_Binary_FL_Property (N_Before, Res, True, False); + when Tok_Before_Un => + if Prio > Prio_FL_Bounding then + return Res; + end if; + Res := Parse_St_Binary_FL_Property (N_Before, Res, False, True); + when Tok_Before_Em_Un => + if Prio > Prio_FL_Bounding then + return Res; + end if; + Res := Parse_St_Binary_FL_Property (N_Before, Res, True, True); when Tok_Or => if Prio > Prio_Seq_Or then return Res; diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb index fd9cb2a24..2ce6c3aac 100644 --- a/src/vhdl/vhdl-prints.adb +++ b/src/vhdl/vhdl-prints.adb @@ -2026,7 +2026,7 @@ package body Vhdl.Prints is Print_Property (Ctxt, Get_Property (Prop), Prio); Disp_Token (Ctxt, Tok_Right_Paren); when N_Eventually => - Disp_Token (Ctxt, Tok_Eventually, Tok_Left_Paren); + Disp_Token (Ctxt, Tok_Eventually_Em, Tok_Left_Paren); Print_Property (Ctxt, Get_Property (Prop), Prio); Disp_Token (Ctxt, Tok_Right_Paren); when N_Strong => diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb index d0b2910bc..d01739a20 100644 --- a/src/vhdl/vhdl-scanner.adb +++ b/src/vhdl/vhdl-scanner.adb @@ -1090,8 +1090,7 @@ package body Vhdl.Scanner is if Source (P - 1) = '_' then if Allow_PSL then - -- Some PSL reserved words finish with '_'. This case is handled - -- later by Scan_Underscore and Scan_Exclam_Mark. + -- Some PSL reserved words finish with '_'. P := P - 1; Len := Len - 1; C := '_'; @@ -1232,6 +1231,37 @@ package body Vhdl.Scanner is Current_Token := Tok_Identifier; end Scan_Identifier; + procedure Scan_Psl_Keyword_Em (Tok : Token_Type; Tok_Em : Token_Type) is + begin + if Source (Pos) = '!' then + Pos := Pos + 1; + Current_Token := Tok_Em; + else + Current_Token := Tok; + end if; + end Scan_Psl_Keyword_Em; + pragma Inline (Scan_Psl_Keyword_Em); + + procedure Scan_Psl_Keyword_Em_Un + (Tok, Tok_Em, Tok_Un, Tok_Em_Un : Token_Type) is + begin + if Source (Pos) = '!' then + Pos := Pos + 1; + if Source (Pos) = '_' then + Pos := Pos + 1; + Current_Token := Tok_Em_Un; + else + Current_Token := Tok_Em; + end if; + elsif Source (Pos) = '_' then + Pos := Pos + 1; + Current_Token := Tok_Un; + else + Current_Token := Tok; + end if; + end Scan_Psl_Keyword_Em_Un; + pragma Inline (Scan_Psl_Keyword_Em_Un); + procedure Identifier_To_Token is begin if Current_Identifier in Std_Names.Name_Id_Keywords then @@ -1319,7 +1349,14 @@ package body Vhdl.Scanner is Current_Token := Tok_Identifier; end if; when Std_Names.Name_Id_Vhdl87_Reserved_Words => - null; + if Flag_Psl then + if Current_Token = Tok_Until then + Scan_Psl_Keyword_Em_Un (Tok_Until, Tok_Until_Em, + Tok_Until_Un, Tok_Until_Em_Un); + elsif Current_Token = Tok_Next then + Scan_Psl_Keyword_Em (Tok_Next, Tok_Next_Em); + end if; + end if; when others => raise Program_Error; end case; @@ -1354,25 +1391,31 @@ package body Vhdl.Scanner is when Std_Names.Name_Abort => Current_Token := Tok_Abort; when Std_Names.Name_Before => - Current_Token := Tok_Before; + Scan_Psl_Keyword_Em_Un (Tok_Before, Tok_Before_Em, + Tok_Before_Un, Tok_Before_Em_Un); when Std_Names.Name_Always => Current_Token := Tok_Always; when Std_Names.Name_Never => Current_Token := Tok_Never; when Std_Names.Name_Eventually => - Current_Token := Tok_Eventually; + if Source (Pos) = '!' then + Pos := Pos + 1; + else + Error_Msg_Scan ("'!' expected after 'eventually'"); + end if; + Current_Token := Tok_Eventually_Em; when Std_Names.Name_Next_A => - Current_Token := Tok_Next_A; + Scan_Psl_Keyword_Em (Tok_Next_A, Tok_Next_A_Em); when Std_Names.Name_Next_E => - Current_Token := Tok_Next_E; + Scan_Psl_Keyword_Em (Tok_Next_E, Tok_Next_E_Em); when Std_Names.Name_Next_Event => - Current_Token := Tok_Next_Event; + Scan_Psl_Keyword_Em (Tok_Next_Event, Tok_Next_Event_Em); when Std_Names.Name_Next_Event_A => - Current_Token := Tok_Next_Event_A; + Scan_Psl_Keyword_Em (Tok_Next_Event_A, Tok_Next_Event_A_Em); when Std_Names.Name_Next_Event_E => - Current_Token := Tok_Next_Event_E; + Scan_Psl_Keyword_Em (Tok_Next_Event_E, Tok_Next_Event_E_Em); when Std_Names.Name_Until => - Current_Token := Tok_Until; + raise Internal_Error; when others => Current_Token := Tok_Identifier; if Source (Pos - 1) = '_' then @@ -1834,26 +1877,6 @@ package body Vhdl.Scanner is return False; end Scan_Comment; - function Scan_Exclam_Mark return Boolean is - begin - if Source (Pos) = '!' then - Pos := Pos + 1; - return True; - else - return False; - end if; - end Scan_Exclam_Mark; - - function Scan_Underscore return Boolean is - begin - if Source (Pos) = '_' then - Pos := Pos + 1; - return True; - else - return False; - end if; - end Scan_Underscore; - -- The Scan_Next_Line procedure must be called after each end-of-line to -- register to next line number. This is called by Scan_CR_Newline and -- Scan_LF_Newline. diff --git a/src/vhdl/vhdl-scanner.ads b/src/vhdl/vhdl-scanner.ads index 461c431df..21186a0a3 100644 --- a/src/vhdl/vhdl-scanner.ads +++ b/src/vhdl/vhdl-scanner.ads @@ -106,14 +106,6 @@ package Vhdl.Scanner is -- Flag_Psl_Comment or Flag_Pragma_Comment is true. Flag_Comment_Keyword : Boolean := False; - -- If the next character is '!', eat it and return True, otherwise return - -- False (used by PSL). - function Scan_Exclam_Mark return Boolean; - - -- If the next character is '_', eat it and return True, otherwise return - -- False (used by PSL). - function Scan_Underscore return Boolean; - -- Get the current location, or the location of the current token. -- Since a token cannot spread over lines, file and line of the current -- token are the same as those of the current position. diff --git a/src/vhdl/vhdl-tokens.adb b/src/vhdl/vhdl-tokens.adb index 089f8173f..7e5633f16 100644 --- a/src/vhdl/vhdl-tokens.adb +++ b/src/vhdl/vhdl-tokens.adb @@ -464,18 +464,30 @@ package body Vhdl.Tokens is return "always"; when Tok_Never => return "never"; - when Tok_Eventually => - return "eventually"; + when Tok_Eventually_Em => + return "eventually!"; + when Tok_Next_Em => + return "next!"; when Tok_Next_A => return "next_a"; + when Tok_Next_A_Em => + return "next_a!"; when Tok_Next_E => return "next_e"; + when Tok_Next_E_Em => + return "next_e!"; when Tok_Next_Event => return "next_event"; + when Tok_Next_Event_Em => + return "next_event!"; when Tok_Next_Event_A => return "next_event_a"; + when Tok_Next_Event_A_Em => + return "next_event_a!"; when Tok_Next_Event_E => return "next_event_e"; + when Tok_Next_Event_E_Em => + return "next_event_e!"; end case; end Image; diff --git a/src/vhdl/vhdl-tokens.ads b/src/vhdl/vhdl-tokens.ads index 93b3c77a2..3efc165ed 100644 --- a/src/vhdl/vhdl-tokens.ads +++ b/src/vhdl/vhdl-tokens.ads @@ -279,17 +279,23 @@ package Vhdl.Tokens is Tok_Before_Em, Tok_Before_Un, Tok_Before_Em_Un, - Tok_Until_Em, - Tok_Until_Un, - Tok_Until_Em_Un, Tok_Always, Tok_Never, - Tok_Eventually, + Tok_Eventually_Em, + Tok_Next_Em, Tok_Next_A, + Tok_Next_A_Em, Tok_Next_E, + Tok_Next_E_Em, Tok_Next_Event, + Tok_Next_Event_Em, Tok_Next_Event_A, - Tok_Next_Event_E + Tok_Next_Event_A_Em, + Tok_Next_Event_E, + Tok_Next_Event_E_Em, + Tok_Until_Em, + Tok_Until_Un, + Tok_Until_Em_Un ); -- To ease interfacing |