aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdlprint.adb8
-rw-r--r--src/vhdl/vhdl-parse_psl.adb80
-rw-r--r--src/vhdl/vhdl-prints.adb2
-rw-r--r--src/vhdl/vhdl-scanner.adb85
-rw-r--r--src/vhdl/vhdl-scanner.ads8
-rw-r--r--src/vhdl/vhdl-tokens.adb16
-rw-r--r--src/vhdl/vhdl-tokens.ads16
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