diff options
| -rw-r--r-- | src/psl/psl-dump_tree.adb | 771 | ||||
| -rw-r--r-- | src/psl/psl-nodes.adb | 1175 | ||||
| -rw-r--r-- | src/psl/psl-nodes.ads | 359 |
3 files changed, 750 insertions, 1555 deletions
diff --git a/src/psl/psl-dump_tree.adb b/src/psl/psl-dump_tree.adb index 4101b94..0ce3763 100644 --- a/src/psl/psl-dump_tree.adb +++ b/src/psl/psl-dump_tree.adb @@ -3,13 +3,14 @@ with Ada.Text_IO; use Ada.Text_IO; with Types; use Types; with Name_Table; with PSL.Errors; +with PSL.Nodes_Meta; package body PSL.Dump_Tree is - procedure Disp_Indent (Indent : Natural) is + procedure Put_Indent (Indent : Natural) is begin Put (String'(1 .. 2 * Indent => ' ')); - end Disp_Indent; + end Put_Indent; Hex_Digits : constant array (Integer range 0 .. 15) of Character := "0123456789abcdef"; @@ -38,6 +39,15 @@ package body PSL.Dump_Tree is Put (Res); end Disp_Int32; + function Image_Boolean (Bool : Boolean) return String is + begin + if Bool then + return "true"; + else + return "false"; + end if; + end Image_Boolean; + procedure Disp_HDL_Node (Val : HDL_Node) is begin @@ -62,43 +72,23 @@ package body PSL.Dump_Tree is procedure Disp_Header (Msg : String; Indent : Natural) is begin - Disp_Indent (Indent); + Put_Indent (Indent); Put (Msg); Put (": "); end Disp_Header; - procedure Disp_Identifier (N : Node) is - begin - Put (Name_Table.Image (Get_Identifier (N))); - New_Line; - end Disp_Identifier; - - procedure Disp_Label (N : Node) is - begin - Put (Name_Table.Image (Get_Label (N))); - New_Line; - end Disp_Label; - - procedure Disp_Boolean (Val : Boolean) is - begin - if Val then - Put ("true"); - else - Put ("false"); - end if; - end Disp_Boolean; - - procedure Disp_PSL_Presence_Kind (Pres : PSL_Presence_Kind) is + function Image_PSL_Presence_Kind (Pres : PSL_Presence_Kind) return String + is begin case Pres is when Present_Pos => - Put ('+'); + return "+"; when Present_Neg => - Put ('-'); + return "-"; when Present_Unknown => - Put ('?'); + return "?"; end case; - end Disp_PSL_Presence_Kind; + end Image_PSL_Presence_Kind; procedure Disp_Location (Loc : Location_Type) is begin @@ -113,643 +103,112 @@ package body PSL.Dump_Tree is -- New_Line; -- end Disp_String_Id; - -- Subprograms. - procedure Disp_Tree (N : Node; Indent : Natural; Full : boolean := False) is - Chain : Node; + procedure Disp_Header (N : Node) + is + use Nodes_Meta; + K : Nkind; begin - Disp_Node_Number (N); - Put (": "); if N = Null_Node then - Put_Line ("*NULL*"); + Put_Line ("*null*"); return; end if; - Put_Line (Nkind'Image (Get_Kind (N))); - Disp_Indent (Indent); - Put (" loc: "); + + K := Get_Kind (N); + Put (Get_Nkind_Image (K)); + if Has_Identifier (K) then + Put (' '); + Put (Name_Table.Image (Get_Identifier (N))); + end if; + + Put (' '); + Disp_Node_Number (N); + + New_Line; + end Disp_Header; + + procedure Disp_Tree (N : Node; Indent : Natural; Depth : Natural); + + procedure Disp_Chain (Tree_Chain: Node; Indent: Natural; Depth : Natural) + is + El: Node; + begin + New_Line; + El := Tree_Chain; + while El /= Null_Node loop + Put_Indent (Indent); + Disp_Tree (El, Indent + 1, Depth); + El := Get_Chain (El); + end loop; + end Disp_Chain; + + procedure Disp_Tree (N : Node; Indent : Natural; Depth : Natural) is + begin + Disp_Header (N); + + if Depth <= 1 or else N = Null_Node then + return; + end if; + + Disp_Header ("location", Indent); Disp_Location (Get_Location (N)); New_Line; - case Get_Kind (N) is - when N_Error => - if not Full then - return; - end if; - when N_Vmode => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Instance", Indent + 1); - Disp_Tree (Get_Instance (N), Indent + 1, Full); - Disp_Header ("Item_Chain", Indent + 1); - Disp_Tree (Get_Item_Chain (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Vunit => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Instance", Indent + 1); - Disp_Tree (Get_Instance (N), Indent + 1, Full); - Disp_Header ("Item_Chain", Indent + 1); - Disp_Tree (Get_Item_Chain (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Vprop => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Instance", Indent + 1); - Disp_Tree (Get_Instance (N), Indent + 1, Full); - Disp_Header ("Item_Chain", Indent + 1); - Disp_Tree (Get_Item_Chain (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Hdl_Mod_Name => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Prefix", Indent + 1); - Disp_Tree (Get_Prefix (N), Indent + 1, Full); - when N_Assert_Directive => - Disp_Header ("Label", Indent + 1); - Disp_Label (N); - if not Full then - return; - end if; - Disp_Header ("String", Indent + 1); - Disp_Tree (Get_String (N), Indent + 1, Full); - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("NFA", Indent + 1); - Disp_NFA (Get_NFA (N)); - New_Line; - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Property_Declaration => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Global_Clock", Indent + 1); - Disp_Tree (Get_Global_Clock (N), Indent + 1, Full); - Disp_Header ("Parameter_List", Indent + 1); - Disp_Tree (Get_Parameter_List (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Sequence_Declaration => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Parameter_List", Indent + 1); - Disp_Tree (Get_Parameter_List (N), Indent + 1, Full); - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Endpoint_Declaration => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Parameter_List", Indent + 1); - Disp_Tree (Get_Parameter_List (N), Indent + 1, Full); - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Const_Parameter => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Actual", Indent + 1); - Disp_Tree (Get_Actual (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Boolean_Parameter => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Actual", Indent + 1); - Disp_Tree (Get_Actual (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Property_Parameter => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Actual", Indent + 1); - Disp_Tree (Get_Actual (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Sequence_Parameter => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Actual", Indent + 1); - Disp_Tree (Get_Actual (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Sequence_Instance => - if not Full then - return; - end if; - Disp_Header ("Declaration", Indent + 1); - Disp_Tree (Get_Declaration (N), Indent + 1, False); - Disp_Header ("Association_Chain", Indent + 1); - Disp_Tree (Get_Association_Chain (N), Indent + 1, Full); - when N_Endpoint_Instance => - if not Full then - return; - end if; - Disp_Header ("Declaration", Indent + 1); - Disp_Tree (Get_Declaration (N), Indent + 1, False); - Disp_Header ("Association_Chain", Indent + 1); - Disp_Tree (Get_Association_Chain (N), Indent + 1, Full); - when N_Property_Instance => - if not Full then - return; - end if; - Disp_Header ("Declaration", Indent + 1); - Disp_Tree (Get_Declaration (N), Indent + 1, False); - Disp_Header ("Association_Chain", Indent + 1); - Disp_Tree (Get_Association_Chain (N), Indent + 1, Full); - when N_Actual => - if not Full then - return; - end if; - Disp_Header ("Actual", Indent + 1); - Disp_Tree (Get_Actual (N), Indent + 1, Full); - Disp_Header ("Formal", Indent + 1); - Disp_Tree (Get_Formal (N), Indent + 1, Full); - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Clock_Event => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Boolean", Indent + 1); - Disp_Tree (Get_Boolean (N), Indent + 1, Full); - when N_Always => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - when N_Never => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - when N_Eventually => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - when N_Strong => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - when N_Imp_Seq => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - when N_Overlap_Imp_Seq => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - when N_Log_Imp_Prop => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Next => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Number", Indent + 1); - Disp_Tree (Get_Number (N), Indent + 1, Full); - when N_Next_A => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Next_E => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Next_Event => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Boolean", Indent + 1); - Disp_Tree (Get_Boolean (N), Indent + 1, Full); - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Number", Indent + 1); - Disp_Tree (Get_Number (N), Indent + 1, Full); - when N_Next_Event_A => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Boolean", Indent + 1); - Disp_Tree (Get_Boolean (N), Indent + 1, Full); - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Next_Event_E => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Boolean", Indent + 1); - Disp_Tree (Get_Boolean (N), Indent + 1, Full); - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Abort => - if not Full then - return; - end if; - Disp_Header ("Property", Indent + 1); - Disp_Tree (Get_Property (N), Indent + 1, Full); - Disp_Header ("Boolean", Indent + 1); - Disp_Tree (Get_Boolean (N), Indent + 1, Full); - when N_Until => - if not Full then - return; - end if; - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - Disp_Header ("Inclusive_Flag", Indent + 1); - Disp_Boolean (Get_Inclusive_Flag (N)); - New_Line; - when N_Before => - if not Full then - return; - end if; - Disp_Header ("Strong_Flag", Indent + 1); - Disp_Boolean (Get_Strong_Flag (N)); - New_Line; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - Disp_Header ("Inclusive_Flag", Indent + 1); - Disp_Boolean (Get_Inclusive_Flag (N)); - New_Line; - when N_Or_Prop => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_And_Prop => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Braced_SERE => - if not Full then - return; - end if; - Disp_Header ("SERE", Indent + 1); - Disp_Tree (Get_SERE (N), Indent + 1, Full); - when N_Concat_SERE => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Fusion_SERE => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Within_SERE => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Match_And_Seq => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_And_Seq => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Or_Seq => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - when N_Star_Repeat_Seq => - if not Full then - return; - end if; - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Goto_Repeat_Seq => - if not Full then - return; - end if; - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Plus_Repeat_Seq => - if not Full then - return; - end if; - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - when N_Equal_Repeat_Seq => - if not Full then - return; - end if; - Disp_Header ("Sequence", Indent + 1); - Disp_Tree (Get_Sequence (N), Indent + 1, Full); - Disp_Header ("Low_Bound", Indent + 1); - Disp_Tree (Get_Low_Bound (N), Indent + 1, Full); - Disp_Header ("High_Bound", Indent + 1); - Disp_Tree (Get_High_Bound (N), Indent + 1, Full); - when N_Not_Bool => - if not Full then - return; - end if; - Disp_Header ("Boolean", Indent + 1); - Disp_Tree (Get_Boolean (N), Indent + 1, Full); - Disp_Header ("Presence", Indent + 1); - Disp_PSL_Presence_Kind (Get_Presence (N)); - New_Line; - Disp_Header ("Hash", Indent + 1); - Disp_Uns32 (Get_Hash (N)); - New_Line; - Disp_Header ("Hash_Link", Indent + 1); - Disp_Tree (Get_Hash_Link (N), Indent + 1, Full); - when N_And_Bool => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - Disp_Header ("Presence", Indent + 1); - Disp_PSL_Presence_Kind (Get_Presence (N)); - New_Line; - Disp_Header ("Hash", Indent + 1); - Disp_Uns32 (Get_Hash (N)); - New_Line; - Disp_Header ("Hash_Link", Indent + 1); - Disp_Tree (Get_Hash_Link (N), Indent + 1, Full); - when N_Or_Bool => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - Disp_Header ("Presence", Indent + 1); - Disp_PSL_Presence_Kind (Get_Presence (N)); - New_Line; - Disp_Header ("Hash", Indent + 1); - Disp_Uns32 (Get_Hash (N)); - New_Line; - Disp_Header ("Hash_Link", Indent + 1); - Disp_Tree (Get_Hash_Link (N), Indent + 1, Full); - when N_Imp_Bool => - if not Full then - return; - end if; - Disp_Header ("Left", Indent + 1); - Disp_Tree (Get_Left (N), Indent + 1, Full); - Disp_Header ("Right", Indent + 1); - Disp_Tree (Get_Right (N), Indent + 1, Full); - Disp_Header ("Presence", Indent + 1); - Disp_PSL_Presence_Kind (Get_Presence (N)); - New_Line; - Disp_Header ("Hash", Indent + 1); - Disp_Uns32 (Get_Hash (N)); - New_Line; - Disp_Header ("Hash_Link", Indent + 1); - Disp_Tree (Get_Hash_Link (N), Indent + 1, Full); - when N_HDL_Expr => - if not Full then - return; - end if; - Disp_Header ("Presence", Indent + 1); - Disp_PSL_Presence_Kind (Get_Presence (N)); - New_Line; - Disp_Header ("HDL_Node", Indent + 1); - Disp_HDL_Node (Get_HDL_Node (N)); - New_Line; - Disp_Header ("HDL_Index", Indent + 1); - Disp_Int32 (Get_HDL_Index (N)); - New_Line; - Disp_Header ("Hash", Indent + 1); - Disp_Uns32 (Get_Hash (N)); - New_Line; - Disp_Header ("Hash_Link", Indent + 1); - Disp_Tree (Get_Hash_Link (N), Indent + 1, Full); - when N_False => - if not Full then - return; - end if; - when N_True => - if not Full then - return; - end if; - when N_EOS => - if not Full then - return; - end if; - Disp_Header ("HDL_Index", Indent + 1); - Disp_Int32 (Get_HDL_Index (N)); - New_Line; - Disp_Header ("Hash", Indent + 1); - Disp_Uns32 (Get_Hash (N)); - New_Line; - Disp_Header ("Hash_Link", Indent + 1); - Disp_Tree (Get_Hash_Link (N), Indent + 1, Full); - when N_Name => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Disp_Header ("Decl", Indent + 1); - Disp_Tree (Get_Decl (N), Indent + 1, Full); - when N_Name_Decl => - Disp_Header ("Identifier", Indent + 1); - Disp_Identifier (N); - if not Full then - return; - end if; - Chain := Get_Chain (N); - if Chain /= Null_Node then - Disp_Indent (Indent); - Disp_Tree (Chain, Indent, Full); - end if; - when N_Number => - if not Full then - return; - end if; - Disp_Header ("Value", Indent + 1); - Disp_Uns32 (Get_Value (N)); - New_Line; - end case; + + declare + use Nodes_Meta; + Sub_Indent : constant Natural := Indent + 1; + + Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); + F : Fields_Enum; + begin + for I in Fields'Range loop + F := Fields (I); + Disp_Header (Get_Field_Image (F), Indent); + case Get_Field_Type (F) is + when Type_Node => + case Get_Field_Attribute (F) is + when Attr_None => + Disp_Tree (Get_Node (N, F), Sub_Indent, Depth - 1); + when Attr_Ref => + Disp_Tree (Get_Node (N, F), Sub_Indent, 0); + when Attr_Chain => + Disp_Chain (Get_Node (N, F), Sub_Indent, Depth - 1); + when Attr_Chain_Next => + Disp_Node_Number (Get_Node (N, F)); + New_Line; + when Attr_Maybe_Ref | Attr_Of_Ref => + raise Internal_Error; + end case; + when Type_Boolean => + Put_Line (Image_Boolean (Get_Boolean (N, F))); + when Type_Int32 => + Disp_Int32 (Get_Int32 (N, F)); + New_Line; + when Type_Uns32 => + Disp_Uns32 (Get_Uns32 (N, F)); + New_Line; + when Type_Name_Id => + Put_Line (Name_Table.Image (Get_Name_Id (N, F))); + when Type_HDL_Node => + Disp_HDL_Node (Get_HDL_Node (N, F)); + New_Line; + when Type_NFA => + Disp_NFA (Get_NFA (N, F)); + New_Line; + when Type_PSL_Presence_Kind => + Put (Image_PSL_Presence_Kind (Get_PSL_Presence_Kind (N, F))); + New_Line; + end case; + end loop; + end; end Disp_Tree; procedure Dump_Tree (N : Node; Full : Boolean := False) is begin - Disp_Tree (N, 0, Full); + if Full then + Disp_Tree (N, 0, 20); + else + Disp_Tree (N, 0, 0); + end if; end Dump_Tree; end PSL.Dump_Tree; diff --git a/src/psl/psl-nodes.adb b/src/psl/psl-nodes.adb index a6482a1..b5464a1 100644 --- a/src/psl/psl-nodes.adb +++ b/src/psl/psl-nodes.adb @@ -3,6 +3,7 @@ with Ada.Unchecked_Conversion; with GNAT.Table; with PSL.Errors; with PSL.Hash; +with PSL.Nodes_Meta; use PSL.Nodes_Meta; package body PSL.Nodes is -- Suppress the access check of the table base. This is really safe to @@ -16,12 +17,9 @@ package body PSL.Nodes is type Format_Type is ( - Format_Short, - Format_Medium + Format_Short ); - pragma Unreferenced (Format_Type, Format_Short, Format_Medium); - -- Common fields are: -- Flag1 : Boolean -- Flag2 : Boolean @@ -33,28 +31,14 @@ package body PSL.Nodes is -- State1 : Bit2_Type -- State2 : Bit2_Type -- Location : Int32 - -- Field1 : Int32 - -- Field2 : Int32 - -- Field3 : Int32 - -- Field4 : Int32 + -- Field1 : Node + -- Field2 : Node + -- Field3 : Node + -- Field4 : Node -- Fields of Format_Short: - -- Field5 : Int32 - -- Field6 : Int32 - - -- Fields of Format_Medium: - -- Odigit1 : Bit3_Type - -- Odigit2 : Bit3_Type - -- State3 : Bit2_Type - -- State4 : Bit2_Type - -- Field5 : Int32 - -- Field6 : Int32 - -- Field7 : Int32 (location) - -- Field8 : Int32 (field1) - -- Field9 : Int32 (field2) - -- Field10 : Int32 (field3) - -- Field11 : Int32 (field4) - -- Field12 : Int32 (field5) + -- Field5 : Node + -- Field6 : Node type State_Type is range 0 .. 3; type Bit3_Type is range 0 .. 7; @@ -84,12 +68,12 @@ package body PSL.Nodes is Flag19 : Boolean; Location : Int32; - Field1 : Int32; - Field2 : Int32; - Field3 : Int32; - Field4 : Int32; - Field5 : Int32; - Field6 : Int32; + Field1 : Node; + Field2 : Node; + Field3 : Node; + Field4 : Node; + Field5 : Node; + Field6 : Node; end record; pragma Pack (Node_Record); for Node_Record'Size use 8 * 32; @@ -123,17 +107,29 @@ package body PSL.Nodes is return Nodet.Last; end Get_Last_Node; - function Int32_To_Uns32 is new Ada.Unchecked_Conversion - (Source => Int32, Target => Uns32); + function Node_To_Uns32 is new Ada.Unchecked_Conversion + (Source => Node, Target => Uns32); + + function Uns32_To_Node is new Ada.Unchecked_Conversion + (Source => Uns32, Target => Node); + + function Node_To_Int32 is new Ada.Unchecked_Conversion + (Source => Node, Target => Int32); + + function Int32_To_Node is new Ada.Unchecked_Conversion + (Source => Int32, Target => Node); - function Uns32_To_Int32 is new Ada.Unchecked_Conversion - (Source => Uns32, Target => Int32); + function Node_To_NFA is new Ada.Unchecked_Conversion + (Source => Node, Target => NFA); - function Int32_To_NFA is new Ada.Unchecked_Conversion - (Source => Int32, Target => NFA); + function NFA_To_Node is new Ada.Unchecked_Conversion + (Source => NFA, Target => Node); - function NFA_To_Int32 is new Ada.Unchecked_Conversion - (Source => NFA, Target => Int32); + function Node_To_HDL_Node is new Ada.Unchecked_Conversion + (Source => Node, Target => HDL_Node); + + function HDL_Node_To_Node is new Ada.Unchecked_Conversion + (Source => HDL_Node, Target => Node); procedure Set_Kind (N : Node; K : Nkind) is begin @@ -189,81 +185,74 @@ package body PSL.Nodes is end Set_Location; - procedure Set_Field1 (N : Node; V : Int32) is + procedure Set_Field1 (N : Node; V : Node) is begin Nodet.Table (N).Field1 := V; end Set_Field1; - function Get_Field1 (N : Node) return Int32 is + function Get_Field1 (N : Node) return Node is begin return Nodet.Table (N).Field1; end Get_Field1; - procedure Set_Field2 (N : Node; V : Int32) is + procedure Set_Field2 (N : Node; V : Node) is begin Nodet.Table (N).Field2 := V; end Set_Field2; - function Get_Field2 (N : Node) return Int32 is + function Get_Field2 (N : Node) return Node is begin return Nodet.Table (N).Field2; end Get_Field2; - function Get_Field3 (N : Node) return Int32 is + function Get_Field3 (N : Node) return Node is begin return Nodet.Table (N).Field3; end Get_Field3; - procedure Set_Field3 (N : Node; V : Int32) is + procedure Set_Field3 (N : Node; V : Node) is begin Nodet.Table (N).Field3 := V; end Set_Field3; - function Get_Field4 (N : Node) return Int32 is + function Get_Field4 (N : Node) return Node is begin return Nodet.Table (N).Field4; end Get_Field4; - procedure Set_Field4 (N : Node; V : Int32) is + procedure Set_Field4 (N : Node; V : Node) is begin Nodet.Table (N).Field4 := V; end Set_Field4; - function Get_Field5 (N : Node) return Int32 is + function Get_Field5 (N : Node) return Node is begin return Nodet.Table (N).Field5; end Get_Field5; - procedure Set_Field5 (N : Node; V : Int32) is + procedure Set_Field5 (N : Node; V : Node) is begin Nodet.Table (N).Field5 := V; end Set_Field5; - function Get_Field6 (N : Node) return Int32 is + function Get_Field6 (N : Node) return Node is begin return Nodet.Table (N).Field6; end Get_Field6; - procedure Set_Field6 (N : Node; V : Int32) is + procedure Set_Field6 (N : Node; V : Node) is begin Nodet.Table (N).Field6 := V; end Set_Field6; - procedure Set_Field7 (N : Node; V : Int32) is - begin - Nodet.Table (N + 1).Field1 := V; - end Set_Field7; - - function Get_Field7 (N : Node) return Int32 is - begin - return Nodet.Table (N + 1).Field1; - end Get_Field7; + function Get_Format (Kind : Nkind) return Format_Type; + pragma Unreferenced (Get_Format); function Create_Node (Kind : Nkind) return Node is @@ -271,7 +260,7 @@ package body PSL.Nodes is begin if Free_Nodes /= Null_Node then Res := Free_Nodes; - Free_Nodes := Node (Get_Field1 (Res)); + Free_Nodes := Get_Field1 (Res); else Nodet.Increment_Last; Res := Nodet.Last; @@ -285,7 +274,7 @@ package body PSL.Nodes is is begin Set_Kind (N, N_Error); - Set_Field1 (N, Int32 (Free_Nodes)); + Set_Field1 (N, Free_Nodes); Free_Nodes := N; end Free_Node; @@ -393,15 +382,16 @@ package body PSL.Nodes is end Reference_Failed; pragma Unreferenced (Reference_Failed); - pragma Unreferenced (Set_Field7, Get_Field7); - -- Subprograms. - procedure Check_Kind_For_Identifier (N : Node) is + -- Subprograms + function Get_Format (Kind : Nkind) return Format_Type is begin - case Get_Kind (N) is - when N_Vmode + case Kind is + when N_Error + | N_Vmode | N_Vunit | N_Vprop | N_Hdl_Mod_Name + | N_Assert_Directive | N_Property_Declaration | N_Sequence_Declaration | N_Endpoint_Declaration @@ -409,823 +399,566 @@ package body PSL.Nodes is | N_Boolean_Parameter | N_Property_Parameter | N_Sequence_Parameter + | N_Sequence_Instance + | N_Endpoint_Instance + | N_Property_Instance + | N_Actual + | N_Clock_Event + | N_Always + | N_Never + | N_Eventually + | N_Strong + | N_Imp_Seq + | N_Overlap_Imp_Seq + | N_Log_Imp_Prop + | N_Next + | N_Next_A + | N_Next_E + | N_Next_Event + | N_Next_Event_A + | N_Next_Event_E + | N_Abort + | N_Until + | N_Before + | N_Or_Prop + | N_And_Prop + | N_Braced_SERE + | N_Concat_SERE + | N_Fusion_SERE + | N_Within_SERE + | N_Match_And_Seq + | N_And_Seq + | N_Or_Seq + | N_Star_Repeat_Seq + | N_Goto_Repeat_Seq + | N_Plus_Repeat_Seq + | N_Equal_Repeat_Seq + | N_Not_Bool + | N_And_Bool + | N_Or_Bool + | N_Imp_Bool + | N_HDL_Expr + | N_False + | N_True + | N_EOS | N_Name - | N_Name_Decl => - null; - when others => - Failed ("Get/Set_Identifier", N); + | N_Name_Decl + | N_Number => + return Format_Short; end case; - end Check_Kind_For_Identifier; + end Get_Format; function Get_Identifier (N : Node) return Name_Id is begin - Check_Kind_For_Identifier (N); - return Name_Id (Get_Field1 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Identifier (Get_Kind (N)), + "no field Identifier"); + return Name_Id'Val (Get_Field1 (N)); end Get_Identifier; procedure Set_Identifier (N : Node; Id : Name_Id) is begin - Check_Kind_For_Identifier (N); - Set_Field1 (N, Int32 (Id)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Identifier (Get_Kind (N)), + "no field Identifier"); + Set_Field1 (N, Name_Id'Pos (Id)); end Set_Identifier; - procedure Check_Kind_For_Chain (N : Node) is + function Get_Label (N : Node) return Name_Id is begin - case Get_Kind (N) is - when N_Vmode - | N_Vunit - | N_Vprop - | N_Assert_Directive - | N_Property_Declaration - | N_Sequence_Declaration - | N_Endpoint_Declaration - | N_Const_Parameter - | N_Boolean_Parameter - | N_Property_Parameter - | N_Sequence_Parameter - | N_Actual - | N_Name_Decl => - null; - when others => - Failed ("Get/Set_Chain", N); - end case; - end Check_Kind_For_Chain; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Label (Get_Kind (N)), + "no field Label"); + return Name_Id'Val (Get_Field1 (N)); + end Get_Label; + + procedure Set_Label (N : Node; Id : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Label (Get_Kind (N)), + "no field Label"); + Set_Field1 (N, Name_Id'Pos (Id)); + end Set_Label; function Get_Chain (N : Node) return Node is begin - Check_Kind_For_Chain (N); - return Node (Get_Field2 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Chain (Get_Kind (N)), + "no field Chain"); + return Get_Field2 (N); end Get_Chain; procedure Set_Chain (N : Node; Chain : Node) is begin - Check_Kind_For_Chain (N); - Set_Field2 (N, Int32 (Chain)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Chain (Get_Kind (N)), + "no field Chain"); + Set_Field2 (N, Chain); end Set_Chain; - procedure Check_Kind_For_Instance (N : Node) is - begin - case Get_Kind (N) is - when N_Vmode - | N_Vunit - | N_Vprop => - null; - when others => - Failed ("Get/Set_Instance", N); - end case; - end Check_Kind_For_Instance; - function Get_Instance (N : Node) return Node is begin - Check_Kind_For_Instance (N); - return Node (Get_Field3 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Instance (Get_Kind (N)), + "no field Instance"); + return Get_Field3 (N); end Get_Instance; procedure Set_Instance (N : Node; Instance : Node) is begin - Check_Kind_For_Instance (N); - Set_Field3 (N, Int32 (Instance)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Instance (Get_Kind (N)), + "no field Instance"); + Set_Field3 (N, Instance); end Set_Instance; - procedure Check_Kind_For_Item_Chain (N : Node) is - begin - case Get_Kind (N) is - when N_Vmode - | N_Vunit - | N_Vprop => - null; - when others => - Failed ("Get/Set_Item_Chain", N); - end case; - end Check_Kind_For_Item_Chain; - - function Get_Item_Chain (N : Node) return Node is - begin - Check_Kind_For_Item_Chain (N); - return Node (Get_Field4 (N)); - end Get_Item_Chain; - - procedure Set_Item_Chain (N : Node; Item : Node) is - begin - Check_Kind_For_Item_Chain (N); - Set_Field4 (N, Int32 (Item)); - end Set_Item_Chain; - - procedure Check_Kind_For_Prefix (N : Node) is - begin - case Get_Kind (N) is - when N_Hdl_Mod_Name => - null; - when others => - Failed ("Get/Set_Prefix", N); - end case; - end Check_Kind_For_Prefix; - function Get_Prefix (N : Node) return Node is begin - Check_Kind_For_Prefix (N); - return Node (Get_Field2 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Prefix (Get_Kind (N)), + "no field Prefix"); + return Get_Field2 (N); end Get_Prefix; procedure Set_Prefix (N : Node; Prefix : Node) is begin - Check_Kind_For_Prefix (N); - Set_Field2 (N, Int32 (Prefix)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Prefix (Get_Kind (N)), + "no field Prefix"); + Set_Field2 (N, Prefix); end Set_Prefix; - procedure Check_Kind_For_Label (N : Node) is - begin - case Get_Kind (N) is - when N_Assert_Directive => - null; - when others => - Failed ("Get/Set_Label", N); - end case; - end Check_Kind_For_Label; - - function Get_Label (N : Node) return Name_Id is - begin - Check_Kind_For_Label (N); - return Name_Id (Get_Field1 (N)); - end Get_Label; - - procedure Set_Label (N : Node; Id : Name_Id) is - begin - Check_Kind_For_Label (N); - Set_Field1 (N, Int32 (Id)); - end Set_Label; - - procedure Check_Kind_For_String (N : Node) is - begin - case Get_Kind (N) is - when N_Assert_Directive => - null; - when others => - Failed ("Get/Set_String", N); - end case; - end Check_Kind_For_String; - - function Get_String (N : Node) return Node is - begin - Check_Kind_For_String (N); - return Node (Get_Field3 (N)); - end Get_String; - - procedure Set_String (N : Node; Str : Node) is + function Get_Item_Chain (N : Node) return Node is begin - Check_Kind_For_String (N); - Set_Field3 (N, Int32 (Str)); - end Set_String; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Item_Chain (Get_Kind (N)), + "no field Item_Chain"); + return Get_Field4 (N); + end Get_Item_Chain; - procedure Check_Kind_For_Property (N : Node) is + procedure Set_Item_Chain (N : Node; Item : Node) is begin - case Get_Kind (N) is - when N_Assert_Directive - | N_Property_Declaration - | N_Clock_Event - | N_Always - | N_Never - | N_Eventually - | N_Strong - | N_Imp_Seq - | N_Overlap_Imp_Seq - | N_Next - | N_Next_A - | N_Next_E - | N_Next_Event - | N_Next_Event_A - | N_Next_Event_E - | N_Abort => - null; - when others => - Failed ("Get/Set_Property", N); - end case; - end Check_Kind_For_Property; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Item_Chain (Get_Kind (N)), + "no field Item_Chain"); + Set_Field4 (N, Item); + end Set_Item_Chain; function Get_Property (N : Node) return Node is begin - Check_Kind_For_Property (N); - return Node (Get_Field4 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Property (Get_Kind (N)), + "no field Property"); + return Get_Field4 (N); end Get_Property; procedure Set_Property (N : Node; Property : Node) is begin - Check_Kind_For_Property (N); - Set_Field4 (N, Int32 (Property)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Property (Get_Kind (N)), + "no field Property"); + Set_Field4 (N, Property); end Set_Property; - procedure Check_Kind_For_NFA (N : Node) is - begin - case Get_Kind (N) is - when N_Assert_Directive => - null; - when others => - Failed ("Get/Set_NFA", N); - end case; - end Check_Kind_For_NFA; - - function Get_NFA (N : Node) return NFA is - begin - Check_Kind_For_NFA (N); - return Int32_To_NFA (Get_Field5 (N)); - end Get_NFA; - - procedure Set_NFA (N : Node; P : NFA) is + function Get_String (N : Node) return Node is begin - Check_Kind_For_NFA (N); - Set_Field5 (N, NFA_To_Int32 (P)); - end Set_NFA; + pragma Assert (N /= Null_Node); + pragma Assert (Has_String (Get_Kind (N)), + "no field String"); + return Get_Field3 (N); + end Get_String; - procedure Check_Kind_For_Global_Clock (N : Node) is + procedure Set_String (N : Node; Str : Node) is begin - case Get_Kind (N) is - when N_Property_Declaration => - null; - when others => - Failed ("Get/Set_Global_Clock", N); - end case; - end Check_Kind_For_Global_Clock; + pragma Assert (N /= Null_Node); + pragma Assert (Has_String (Get_Kind (N)), + "no field String"); + Set_Field3 (N, Str); + end Set_String; - function Get_Global_Clock (N : Node) return Node is + function Get_SERE (N : Node) return Node is begin - Check_Kind_For_Global_Clock (N); - return Node (Get_Field3 (N)); - end Get_Global_Clock; + pragma Assert (N /= Null_Node); + pragma Assert (Has_SERE (Get_Kind (N)), + "no field SERE"); + return Get_Field1 (N); + end Get_SERE; - procedure Set_Global_Clock (N : Node; Clock : Node) is + procedure Set_SERE (N : Node; S : Node) is begin - Check_Kind_For_Global_Clock (N); - Set_Field3 (N, Int32 (Clock)); - end Set_Global_Clock; + pragma Assert (N /= Null_Node); + pragma Assert (Has_SERE (Get_Kind (N)), + "no field SERE"); + Set_Field1 (N, S); + end Set_SERE; - procedure Check_Kind_For_Parameter_List (N : Node) is + function Get_Left (N : Node) return Node is begin - case Get_Kind (N) is - when N_Property_Declaration - | N_Sequence_Declaration - | N_Endpoint_Declaration => - null; - when others => - Failed ("Get/Set_Parameter_List", N); - end case; - end Check_Kind_For_Parameter_List; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Left (Get_Kind (N)), + "no field Left"); + return Get_Field1 (N); + end Get_Left; - function Get_Parameter_List (N : Node) return Node is + procedure Set_Left (N : Node; S : Node) is begin - Check_Kind_For_Parameter_List (N); - return Node (Get_Field5 (N)); - end Get_Parameter_List; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Left (Get_Kind (N)), + "no field Left"); + Set_Field1 (N, S); + end Set_Left; - procedure Set_Parameter_List (N : Node; E : Node) is + function Get_Right (N : Node) return Node is begin - Check_Kind_For_Parameter_List (N); - Set_Field5 (N, Int32 (E)); - end Set_Parameter_List; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Right (Get_Kind (N)), + "no field Right"); + return Get_Field2 (N); + end Get_Right; - procedure Check_Kind_For_Sequence (N : Node) is + procedure Set_Right (N : Node; S : Node) is begin - case Get_Kind (N) is - when N_Sequence_Declaration - | N_Endpoint_Declaration - | N_Imp_Seq - | N_Overlap_Imp_Seq - | N_Star_Repeat_Seq - | N_Goto_Repeat_Seq - | N_Plus_Repeat_Seq - | N_Equal_Repeat_Seq => - null; - when others => - Failed ("Get/Set_Sequence", N); - end case; - end Check_Kind_For_Sequence; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Right (Get_Kind (N)), + "no field Right"); + Set_Field2 (N, S); + end Set_Right; function Get_Sequence (N : Node) return Node is begin - Check_Kind_For_Sequence (N); - return Node (Get_Field3 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Sequence (Get_Kind (N)), + "no field Sequence"); + return Get_Field3 (N); end Get_Sequence; procedure Set_Sequence (N : Node; S : Node) is begin - Check_Kind_For_Sequence (N); - Set_Field3 (N, Int32 (S)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Sequence (Get_Kind (N)), + "no field Sequence"); + Set_Field3 (N, S); end Set_Sequence; - procedure Check_Kind_For_Actual (N : Node) is - begin - case Get_Kind (N) is - when N_Const_Parameter - | N_Boolean_Parameter - | N_Property_Parameter - | N_Sequence_Parameter - | N_Actual => - null; - when others => - Failed ("Get/Set_Actual", N); - end case; - end Check_Kind_For_Actual; - - function Get_Actual (N : Node) return Node is - begin - Check_Kind_For_Actual (N); - return Node (Get_Field3 (N)); - end Get_Actual; - - procedure Set_Actual (N : Node; E : Node) is - begin - Check_Kind_For_Actual (N); - Set_Field3 (N, Int32 (E)); - end Set_Actual; - - procedure Check_Kind_For_Declaration (N : Node) is - begin - case Get_Kind (N) is - when N_Sequence_Instance - | N_Endpoint_Instance - | N_Property_Instance => - null; - when others => - Failed ("Get/Set_Declaration", N); - end case; - end Check_Kind_For_Declaration; - - function Get_Declaration (N : Node) return Node is - begin - Check_Kind_For_Declaration (N); - return Node (Get_Field1 (N)); - end Get_Declaration; - - procedure Set_Declaration (N : Node; Decl : Node) is - begin - Check_Kind_For_Declaration (N); - Set_Field1 (N, Int32 (Decl)); - end Set_Declaration; - - procedure Check_Kind_For_Association_Chain (N : Node) is - begin - case Get_Kind (N) is - when N_Sequence_Instance - | N_Endpoint_Instance - | N_Property_Instance => - null; - when others => - Failed ("Get/Set_Association_Chain", N); - end case; - end Check_Kind_For_Association_Chain; - - function Get_Association_Chain (N : Node) return Node is - begin - Check_Kind_For_Association_Chain (N); - return Node (Get_Field2 (N)); - end Get_Association_Chain; - - procedure Set_Association_Chain (N : Node; Chain : Node) is - begin - Check_Kind_For_Association_Chain (N); - Set_Field2 (N, Int32 (Chain)); - end Set_Association_Chain; - - procedure Check_Kind_For_Formal (N : Node) is - begin - case Get_Kind (N) is - when N_Actual => - null; - when others => - Failed ("Get/Set_Formal", N); - end case; - end Check_Kind_For_Formal; - - function Get_Formal (N : Node) return Node is - begin - Check_Kind_For_Formal (N); - return Node (Get_Field4 (N)); - end Get_Formal; - - procedure Set_Formal (N : Node; E : Node) is - begin - Check_Kind_For_Formal (N); - Set_Field4 (N, Int32 (E)); - end Set_Formal; - - procedure Check_Kind_For_Boolean (N : Node) is - begin - case Get_Kind (N) is - when N_Clock_Event - | N_Next_Event - | N_Next_Event_A - | N_Next_Event_E - | N_Abort - | N_Not_Bool => - null; - when others => - Failed ("Get/Set_Boolean", N); - end case; - end Check_Kind_For_Boolean; - - function Get_Boolean (N : Node) return Node is - begin - Check_Kind_For_Boolean (N); - return Node (Get_Field3 (N)); - end Get_Boolean; - - procedure Set_Boolean (N : Node; B : Node) is - begin - Check_Kind_For_Boolean (N); - Set_Field3 (N, Int32 (B)); - end Set_Boolean; - - procedure Check_Kind_For_Strong_Flag (N : Node) is - begin - case Get_Kind (N) is - when N_Next - | N_Next_A - | N_Next_E - | N_Next_Event - | N_Next_Event_A - | N_Next_Event_E - | N_Until - | N_Before => - null; - when others => - Failed ("Get/Set_Strong_Flag", N); - end case; - end Check_Kind_For_Strong_Flag; - function Get_Strong_Flag (N : Node) return Boolean is begin - Check_Kind_For_Strong_Flag (N); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Strong_Flag (Get_Kind (N)), + "no field Strong_Flag"); return Get_Flag1 (N); end Get_Strong_Flag; procedure Set_Strong_Flag (N : Node; B : Boolean) is begin - Check_Kind_For_Strong_Flag (N); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Strong_Flag (Get_Kind (N)), + "no field Strong_Flag"); Set_Flag1 (N, B); end Set_Strong_Flag; - procedure Check_Kind_For_Number (N : Node) is + function Get_Inclusive_Flag (N : Node) return Boolean is begin - case Get_Kind (N) is - when N_Next - | N_Next_Event => - null; - when others => - Failed ("Get/Set_Number", N); - end case; - end Check_Kind_For_Number; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Inclusive_Flag (Get_Kind (N)), + "no field Inclusive_Flag"); + return Get_Flag2 (N); + end Get_Inclusive_Flag; - function Get_Number (N : Node) return Node is + procedure Set_Inclusive_Flag (N : Node; B : Boolean) is begin - Check_Kind_For_Number (N); - return Node (Get_Field1 (N)); - end Get_Number; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Inclusive_Flag (Get_Kind (N)), + "no field Inclusive_Flag"); + Set_Flag2 (N, B); + end Set_Inclusive_Flag; - procedure Set_Number (N : Node; S : Node) is + function Get_Low_Bound (N : Node) return Node is begin - Check_Kind_For_Number (N); - Set_Field1 (N, Int32 (S)); - end Set_Number; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Low_Bound (Get_Kind (N)), + "no field Low_Bound"); + return Get_Field1 (N); + end Get_Low_Bound; - procedure Check_Kind_For_Decl (N : Node) is + procedure Set_Low_Bound (N : Node; S : Node) is begin - case Get_Kind (N) is - when N_Name => - null; - when others => - Failed ("Get/Set_Decl", N); - end case; - end Check_Kind_For_Decl; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Low_Bound (Get_Kind (N)), + "no field Low_Bound"); + Set_Field1 (N, S); + end Set_Low_Bound; - function Get_Decl (N : Node) return Node is + function Get_High_Bound (N : Node) return Node is begin - Check_Kind_For_Decl (N); - return Node (Get_Field2 (N)); - end Get_Decl; + pragma Assert (N /= Null_Node); + pragma Assert (Has_High_Bound (Get_Kind (N)), + "no field High_Bound"); + return Get_Field2 (N); + end Get_High_Bound; - procedure Set_Decl (N : Node; D : Node) is + procedure Set_High_Bound (N : Node; S : Node) is begin - Check_Kind_For_Decl (N); - Set_Field2 (N, Int32 (D)); - end Set_Decl; + pragma Assert (N /= Null_Node); + pragma Assert (Has_High_Bound (Get_Kind (N)), + "no field High_Bound"); + Set_Field2 (N, S); + end Set_High_Bound; - procedure Check_Kind_For_Value (N : Node) is + function Get_Number (N : Node) return Node is begin - case Get_Kind (N) is - when N_Number => - null; - when others => - Failed ("Get/Set_Value", N); - end case; - end Check_Kind_For_Value; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Number (Get_Kind (N)), + "no field Number"); + return Get_Field1 (N); + end Get_Number; + + procedure Set_Number (N : Node; S : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Number (Get_Kind (N)), + "no field Number"); + Set_Field1 (N, S); + end Set_Number; function Get_Value (N : Node) return Uns32 is begin - Check_Kind_For_Value (N); - return Int32_To_Uns32 (Get_Field1 (N)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Value (Get_Kind (N)), + "no field Value"); + return Node_To_Uns32 (Get_Field1 (N)); end Get_Value; procedure Set_Value (N : Node; Val : Uns32) is begin - Check_Kind_For_Value (N); - Set_Field1 (N, Uns32_To_Int32 (Val)); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Value (Get_Kind (N)), + "no field Value"); + Set_Field1 (N, Uns32_To_Node (Val)); end Set_Value; - procedure Check_Kind_For_SERE (N : Node) is + function Get_Boolean (N : Node) return Node is begin - case Get_Kind (N) is - when N_Braced_SERE => - null; - when others => - Failed ("Get/Set_SERE", N); - end case; - end Check_Kind_For_SERE; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Boolean (Get_Kind (N)), + "no field Boolean"); + return Get_Field3 (N); + end Get_Boolean; - function Get_SERE (N : Node) return Node is + procedure Set_Boolean (N : Node; B : Node) is begin - Check_Kind_For_SERE (N); - return Node (Get_Field1 (N)); - end Get_SERE; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Boolean (Get_Kind (N)), + "no field Boolean"); + Set_Field3 (N, B); + end Set_Boolean; - procedure Set_SERE (N : Node; S : Node) is + function Get_Decl (N : Node) return Node is begin - Check_Kind_For_SERE (N); - Set_Field1 (N, Int32 (S)); - end Set_SERE; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Decl (Get_Kind (N)), + "no field Decl"); + return Get_Field2 (N); + end Get_Decl; - procedure Check_Kind_For_Left (N : Node) is + procedure Set_Decl (N : Node; D : Node) is begin - case Get_Kind (N) is - when N_Log_Imp_Prop - | N_Until - | N_Before - | N_Or_Prop - | N_And_Prop - | N_Concat_SERE - | N_Fusion_SERE - | N_Within_SERE - | N_Match_And_Seq - | N_And_Seq - | N_Or_Seq - | N_And_Bool - | N_Or_Bool - | N_Imp_Bool => - null; - when others => - Failed ("Get/Set_Left", N); - end case; - end Check_Kind_For_Left; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Decl (Get_Kind (N)), + "no field Decl"); + Set_Field2 (N, D); + end Set_Decl; - function Get_Left (N : Node) return Node is + function Get_HDL_Node (N : Node) return HDL_Node is begin - Check_Kind_For_Left (N); - return Node (Get_Field1 (N)); - end Get_Left; + pragma Assert (N /= Null_Node); + pragma Assert (Has_HDL_Node (Get_Kind (N)), + "no field HDL_Node"); + return Node_To_HDL_Node (Get_Field1 (N)); + end Get_HDL_Node; - procedure Set_Left (N : Node; S : Node) is + procedure Set_HDL_Node (N : Node; H : HDL_Node) is begin - Check_Kind_For_Left (N); - Set_Field1 (N, Int32 (S)); - end Set_Left; + pragma Assert (N /= Null_Node); + pragma Assert (Has_HDL_Node (Get_Kind (N)), + "no field HDL_Node"); + Set_Field1 (N, HDL_Node_To_Node (H)); + end Set_HDL_Node; - procedure Check_Kind_For_Right (N : Node) is + function Get_Hash (N : Node) return Uns32 is begin - case Get_Kind (N) is - when N_Log_Imp_Prop - | N_Until - | N_Before - | N_Or_Prop - | N_And_Prop - | N_Concat_SERE - | N_Fusion_SERE - | N_Within_SERE - | N_Match_And_Seq - | N_And_Seq - | N_Or_Seq - | N_And_Bool - | N_Or_Bool - | N_Imp_Bool => - null; - when others => - Failed ("Get/Set_Right", N); - end case; - end Check_Kind_For_Right; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Hash (Get_Kind (N)), + "no field Hash"); + return Node_To_Uns32 (Get_Field5 (N)); + end Get_Hash; - function Get_Right (N : Node) return Node is + procedure Set_Hash (N : Node; E : Uns32) is begin - Check_Kind_For_Right (N); - return Node (Get_Field2 (N)); - end Get_Right; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Hash (Get_Kind (N)), + "no field Hash"); + Set_Field5 (N, Uns32_To_Node (E)); + end Set_Hash; - procedure Set_Right (N : Node; S : Node) is + function Get_Hash_Link (N : Node) return Node is begin - Check_Kind_For_Right (N); - Set_Field2 (N, Int32 (S)); - end Set_Right; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Hash_Link (Get_Kind (N)), + "no field Hash_Link"); + return Get_Field6 (N); + end Get_Hash_Link; - procedure Check_Kind_For_Low_Bound (N : Node) is + procedure Set_Hash_Link (N : Node; E : Node) is begin - case Get_Kind (N) is - when N_Next_A - | N_Next_E - | N_Next_Event_A - | N_Next_Event_E - | N_Star_Repeat_Seq - | N_Goto_Repeat_Seq - | N_Equal_Repeat_Seq => - null; - when others => - Failed ("Get/Set_Low_Bound", N); - end case; - end Check_Kind_For_Low_Bound; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Hash_Link (Get_Kind (N)), + "no field Hash_Link"); + Set_Field6 (N, E); + end Set_Hash_Link; - function Get_Low_Bound (N : Node) return Node is + function Get_HDL_Index (N : Node) return Int32 is begin - Check_Kind_For_Low_Bound (N); - return Node (Get_Field1 (N)); - end Get_Low_Bound; + pragma Assert (N /= Null_Node); + pragma Assert (Has_HDL_Index (Get_Kind (N)), + "no field HDL_Index"); + return Node_To_Int32 (Get_Field2 (N)); + end Get_HDL_Index; - procedure Set_Low_Bound (N : Node; S : Node) is + procedure Set_HDL_Index (N : Node; Idx : Int32) is begin - Check_Kind_For_Low_Bound (N); - Set_Field1 (N, Int32 (S)); - end Set_Low_Bound; + pragma Assert (N /= Null_Node); + pragma Assert (Has_HDL_Index (Get_Kind (N)), + "no field HDL_Index"); + Set_Field2 (N, Int32_To_Node (Idx)); + end Set_HDL_Index; - procedure Check_Kind_For_High_Bound (N : Node) is + function Get_Presence (N : Node) return PSL_Presence_Kind is begin - case Get_Kind (N) is - when N_Next_A - | N_Next_E - | N_Next_Event_A - | N_Next_Event_E - | N_Star_Repeat_Seq - | N_Goto_Repeat_Seq - | N_Equal_Repeat_Seq => - null; - when others => - Failed ("Get/Set_High_Bound", N); - end case; - end Check_Kind_For_High_Bound; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Presence (Get_Kind (N)), + "no field Presence"); + return PSL_Presence_Kind'Val (Get_State1 (N)); + end Get_Presence; - function Get_High_Bound (N : Node) return Node is + procedure Set_Presence (N : Node; P : PSL_Presence_Kind) is begin - Check_Kind_For_High_Bound (N); - return Node (Get_Field2 (N)); - end Get_High_Bound; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Presence (Get_Kind (N)), + "no field Presence"); + Set_State1 (N, PSL_Presence_Kind'Pos (P)); + end Set_Presence; - procedure Set_High_Bound (N : Node; S : Node) is + function Get_NFA (N : Node) return NFA is begin - Check_Kind_For_High_Bound (N); - Set_Field2 (N, Int32 (S)); - end Set_High_Bound; + pragma Assert (N /= Null_Node); + pragma Assert (Has_NFA (Get_Kind (N)), + "no field NFA"); + return Node_To_NFA (Get_Field5 (N)); + end Get_NFA; - procedure Check_Kind_For_Inclusive_Flag (N : Node) is + procedure Set_NFA (N : Node; P : NFA) is begin - case Get_Kind (N) is - when N_Until - | N_Before => - null; - when others => - Failed ("Get/Set_Inclusive_Flag", N); - end case; - end Check_Kind_For_Inclusive_Flag; + pragma Assert (N /= Null_Node); + pragma Assert (Has_NFA (Get_Kind (N)), + "no field NFA"); + Set_Field5 (N, NFA_To_Node (P)); + end Set_NFA; - function Get_Inclusive_Flag (N : Node) return Boolean is + function Get_Parameter_List (N : Node) return Node is begin - Check_Kind_For_Inclusive_Flag (N); - return Get_Flag2 (N); - end Get_Inclusive_Flag; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Parameter_List (Get_Kind (N)), + "no field Parameter_List"); + return Get_Field5 (N); + end Get_Parameter_List; - procedure Set_Inclusive_Flag (N : Node; B : Boolean) is + procedure Set_Parameter_List (N : Node; E : Node) is begin - Check_Kind_For_Inclusive_Flag (N); - Set_Flag2 (N, B); - end Set_Inclusive_Flag; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Parameter_List (Get_Kind (N)), + "no field Parameter_List"); + Set_Field5 (N, E); + end Set_Parameter_List; - procedure Check_Kind_For_Presence (N : Node) is + function Get_Actual (N : Node) return Node is begin - case Get_Kind (N) is - when N_Not_Bool - | N_And_Bool - | N_Or_Bool - | N_Imp_Bool - | N_HDL_Expr => - null; - when others => - Failed ("Get/Set_Presence", N); - end case; - end Check_Kind_For_Presence; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Actual (Get_Kind (N)), + "no field Actual"); + return Get_Field3 (N); + end Get_Actual; - function Get_Presence (N : Node) return PSL_Presence_Kind is + procedure Set_Actual (N : Node; E : Node) is begin - Check_Kind_For_Presence (N); - return PSL_Presence_Kind'Val(Get_State1 (N)); - end Get_Presence; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Actual (Get_Kind (N)), + "no field Actual"); + Set_Field3 (N, E); + end Set_Actual; - procedure Set_Presence (N : Node; P : PSL_Presence_Kind) is + function Get_Formal (N : Node) return Node is begin - Check_Kind_For_Presence (N); - Set_State1 (N, PSL_Presence_Kind'pos (P)); - end Set_Presence; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Formal (Get_Kind (N)), + "no field Formal"); + return Get_Field4 (N); + end Get_Formal; - procedure Check_Kind_For_HDL_Node (N : Node) is + procedure Set_Formal (N : Node; E : Node) is begin - case Get_Kind (N) is - when N_HDL_Expr => - null; - when others => - Failed ("Get/Set_HDL_Node", N); - end case; - end Check_Kind_For_HDL_Node; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Formal (Get_Kind (N)), + "no field Formal"); + Set_Field4 (N, E); + end Set_Formal; - function Get_HDL_Node (N : Node) return HDL_Node is + function Get_Declaration (N : Node) return Node is begin - Check_Kind_For_HDL_Node (N); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Declaration (Get_Kind (N)), + "no field Declaration"); return Get_Field1 (N); - end Get_HDL_Node; - - procedure Set_HDL_Node (N : Node; H : HDL_Node) is - begin - Check_Kind_For_HDL_Node (N); - Set_Field1 (N, H); - end Set_HDL_Node; + end Get_Declaration; - procedure Check_Kind_For_HDL_Index (N : Node) is + procedure Set_Declaration (N : Node; Decl : Node) is begin - case Get_Kind (N) is - when N_HDL_Expr - | N_EOS => - null; - when others => - Failed ("Get/Set_HDL_Index", N); - end case; - end Check_Kind_For_HDL_Index; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Declaration (Get_Kind (N)), + "no field Declaration"); + Set_Field1 (N, Decl); + end Set_Declaration; - function Get_HDL_Index (N : Node) return Int32 is + function Get_Association_Chain (N : Node) return Node is begin - Check_Kind_For_HDL_Index (N); + pragma Assert (N /= Null_Node); + pragma Assert (Has_Association_Chain (Get_Kind (N)), + "no field Association_Chain"); return Get_Field2 (N); - end Get_HDL_Index; - - procedure Set_HDL_Index (N : Node; Idx : Int32) is - begin - Check_Kind_For_HDL_Index (N); - Set_Field2 (N, Idx); - end Set_HDL_Index; - - procedure Check_Kind_For_Hash (N : Node) is - begin - case Get_Kind (N) is - when N_Not_Bool - | N_And_Bool - | N_Or_Bool - | N_Imp_Bool - | N_HDL_Expr - | N_EOS => - null; - when others => - Failed ("Get/Set_Hash", N); - end case; - end Check_Kind_For_Hash; - - function Get_Hash (N : Node) return Uns32 is - begin - Check_Kind_For_Hash (N); - return Int32_To_Uns32 (Get_Field5 (N)); - end Get_Hash; - - procedure Set_Hash (N : Node; E : Uns32) is - begin - Check_Kind_For_Hash (N); - Set_Field5 (N, Uns32_To_Int32 (E)); - end Set_Hash; + end Get_Association_Chain; - procedure Check_Kind_For_Hash_Link (N : Node) is + procedure Set_Association_Chain (N : Node; Chain : Node) is begin - case Get_Kind (N) is - when N_Not_Bool - | N_And_Bool - | N_Or_Bool - | N_Imp_Bool - | N_HDL_Expr - | N_EOS => - null; - when others => - Failed ("Get/Set_Hash_Link", N); - end case; - end Check_Kind_For_Hash_Link; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Association_Chain (Get_Kind (N)), + "no field Association_Chain"); + Set_Field2 (N, Chain); + end Set_Association_Chain; - function Get_Hash_Link (N : Node) return Node is + function Get_Global_Clock (N : Node) return Node is begin - Check_Kind_For_Hash_Link (N); - return Node (Get_Field6 (N)); - end Get_Hash_Link; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Global_Clock (Get_Kind (N)), + "no field Global_Clock"); + return Get_Field3 (N); + end Get_Global_Clock; - procedure Set_Hash_Link (N : Node; E : Node) is + procedure Set_Global_Clock (N : Node; Clock : Node) is begin - Check_Kind_For_Hash_Link (N); - Set_Field6 (N, Int32 (E)); - end Set_Hash_Link; + pragma Assert (N /= Null_Node); + pragma Assert (Has_Global_Clock (Get_Kind (N)), + "no field Global_Clock"); + Set_Field3 (N, Clock); + end Set_Global_Clock; end PSL.Nodes; - diff --git a/src/psl/psl-nodes.ads b/src/psl/psl-nodes.ads index 2410918..b2a9a1c 100644 --- a/src/psl/psl-nodes.ads +++ b/src/psl/psl-nodes.ads @@ -77,7 +77,7 @@ package PSL.Nodes is N_Name, N_Name_Decl, N_Number - ); + ); for Nkind'Size use 8; subtype N_Booleans is Nkind range N_Not_Bool .. N_True; @@ -109,285 +109,286 @@ package PSL.Nodes is Present_Neg ); - -- Start of nodes: + -- The next line marks the start of the node description. + -- Start of Nkind. - -- N_Error (Short) + -- N_Error (Short) - -- N_Vmode (Short) - -- N_Vunit (Short) - -- N_Vprop (Short) + -- N_Vmode (Short) + -- N_Vunit (Short) + -- N_Vprop (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) -- - -- Get/Set_Instance (Field3) + -- Get/Set_Instance (Field3) -- - -- Get/Set_Item_Chain (Field4) + -- Get/Set_Item_Chain (Field4) - -- N_Hdl_Mod_Name (Short) + -- N_Hdl_Mod_Name (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Prefix (Field2) + -- Get/Set_Prefix (Field2) - -- N_Assert_Directive (Short) + -- N_Assert_Directive (Short) -- - -- Get/Set_Label (Field1) + -- Get/Set_Label (Field1) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) -- - -- Get/Set_String (Field3) + -- Get/Set_String (Field3) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) -- - -- Get/Set_NFA (Field5) + -- Get/Set_NFA (Field5) - -- N_Property_Declaration (Short) + -- N_Property_Declaration (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) -- - -- Get/Set_Global_Clock (Field3) + -- Get/Set_Global_Clock (Field3) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) -- - -- Get/Set_Parameter_List (Field5) + -- Get/Set_Parameter_List (Field5) - -- N_Sequence_Declaration (Short) - -- N_Endpoint_Declaration (Short) + -- N_Sequence_Declaration (Short) + -- N_Endpoint_Declaration (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) -- - -- Get/Set_Sequence (Field3) + -- Get/Set_Sequence (Field3) -- - -- Get/Set_Parameter_List (Field5) + -- Get/Set_Parameter_List (Field5) - -- N_Const_Parameter (Short) - -- N_Boolean_Parameter (Short) - -- N_Property_Parameter (Short) - -- N_Sequence_Parameter (Short) + -- N_Const_Parameter (Short) + -- N_Boolean_Parameter (Short) + -- N_Property_Parameter (Short) + -- N_Sequence_Parameter (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) -- -- -- Current actual parameter. - -- Get/Set_Actual (Field3) + -- Get/Set_Actual (Field3) - -- N_Sequence_Instance (Short) - -- N_Endpoint_Instance (Short) - -- N_Property_Instance (Short) + -- N_Sequence_Instance (Short) + -- N_Endpoint_Instance (Short) + -- N_Property_Instance (Short) -- - -- Get/Set_Declaration (Field1) [Flat] + -- Get/Set_Declaration (Field1) -- - -- Get/Set_Association_Chain (Field2) + -- Get/Set_Association_Chain (Field2) - -- N_Actual (Short) + -- N_Actual (Short) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) -- - -- Get/Set_Actual (Field3) + -- Get/Set_Actual (Field3) -- - -- Get/Set_Formal (Field4) + -- Get/Set_Formal (Field4) - -- N_Clock_Event (Short) + -- N_Clock_Event (Short) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) -- - -- Get/Set_Boolean (Field3) + -- Get/Set_Boolean (Field3) - -- N_Always (Short) - -- N_Never (Short) - -- N_Eventually (Short) - -- N_Strong (Short) + -- N_Always (Short) + -- N_Never (Short) + -- N_Eventually (Short) + -- N_Strong (Short) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) - -- N_Next (Short) + -- N_Next (Short) -- - -- Get/Set_Strong_Flag (Flag1) + -- Get/Set_Strong_Flag (Flag1) -- - -- Get/Set_Number (Field1) + -- Get/Set_Number (Field1) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) - -- N_Name (Short) + -- N_Name (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Decl (Field2) + -- Get/Set_Decl (Field2) - -- N_Name_Decl (Short) + -- N_Name_Decl (Short) -- - -- Get/Set_Identifier (Field1) + -- Get/Set_Identifier (Field1) -- - -- Get/Set_Chain (Field2) + -- Get/Set_Chain (Field2) - -- N_Number (Short) + -- N_Number (Short) -- - -- Get/Set_Value (Field1) + -- Get/Set_Value (Field1) - -- N_Braced_SERE (Short) + -- N_Braced_SERE (Short) -- - -- Get/Set_SERE (Field1) + -- Get/Set_SERE (Field1) - -- N_Concat_SERE (Short) - -- N_Fusion_SERE (Short) - -- N_Within_SERE (Short) + -- N_Concat_SERE (Short) + -- N_Fusion_SERE (Short) + -- N_Within_SERE (Short) -- - -- Get/Set_Left (Field1) + -- Get/Set_Left (Field1) -- - -- Get/Set_Right (Field2) + -- Get/Set_Right (Field2) - -- N_Star_Repeat_Seq (Short) - -- N_Goto_Repeat_Seq (Short) - -- N_Equal_Repeat_Seq (Short) + -- N_Star_Repeat_Seq (Short) + -- N_Goto_Repeat_Seq (Short) + -- N_Equal_Repeat_Seq (Short) -- -- Note: can be null_node for star_repeat_seq. - -- Get/Set_Sequence (Field3) + -- Get/Set_Sequence (Field3) -- - -- Get/Set_Low_Bound (Field1) + -- Get/Set_Low_Bound (Field1) -- - -- Get/Set_High_Bound (Field2) + -- Get/Set_High_Bound (Field2) - -- N_Plus_Repeat_Seq (Short) + -- N_Plus_Repeat_Seq (Short) -- -- Note: can be null_node. - -- Get/Set_Sequence (Field3) + -- Get/Set_Sequence (Field3) - -- N_Match_And_Seq (Short) - -- N_And_Seq (Short) - -- N_Or_Seq (Short) + -- N_Match_And_Seq (Short) + -- N_And_Seq (Short) + -- N_Or_Seq (Short) -- - -- Get/Set_Left (Field1) + -- Get/Set_Left (Field1) -- - -- Get/Set_Right (Field2) + -- Get/Set_Right (Field2) - -- N_Imp_Seq (Short) - -- N_Overlap_Imp_Seq (Short) + -- N_Imp_Seq (Short) + -- N_Overlap_Imp_Seq (Short) -- - -- Get/Set_Sequence (Field3) + -- Get/Set_Sequence (Field3) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) - -- N_Log_Imp_Prop (Short) + -- N_Log_Imp_Prop (Short) -- - -- Get/Set_Left (Field1) + -- Get/Set_Left (Field1) -- - -- Get/Set_Right (Field2) + -- Get/Set_Right (Field2) - -- N_Next_A (Short) - -- N_Next_E (Short) + -- N_Next_A (Short) + -- N_Next_E (Short) -- - -- Get/Set_Strong_Flag (Flag1) + -- Get/Set_Strong_Flag (Flag1) -- - -- Get/Set_Low_Bound (Field1) + -- Get/Set_Low_Bound (Field1) -- - -- Get/Set_High_Bound (Field2) + -- Get/Set_High_Bound (Field2) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) - -- N_Next_Event (Short) + -- N_Next_Event (Short) -- - -- Get/Set_Strong_Flag (Flag1) + -- Get/Set_Strong_Flag (Flag1) -- - -- Get/Set_Number (Field1) + -- Get/Set_Number (Field1) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) -- - -- Get/Set_Boolean (Field3) + -- Get/Set_Boolean (Field3) - -- N_Or_Prop (Short) - -- N_And_Prop (Short) + -- N_Or_Prop (Short) + -- N_And_Prop (Short) -- - -- Get/Set_Left (Field1) + -- Get/Set_Left (Field1) -- - -- Get/Set_Right (Field2) + -- Get/Set_Right (Field2) - -- N_Until (Short) - -- N_Before (Short) + -- N_Until (Short) + -- N_Before (Short) -- - -- Get/Set_Strong_Flag (Flag1) + -- Get/Set_Strong_Flag (Flag1) -- - -- Get/Set_Inclusive_Flag (Flag2) + -- Get/Set_Inclusive_Flag (Flag2) -- - -- Get/Set_Left (Field1) + -- Get/Set_Left (Field1) -- - -- Get/Set_Right (Field2) + -- Get/Set_Right (Field2) - -- N_Next_Event_A (Short) - -- N_Next_Event_E (Short) + -- N_Next_Event_A (Short) + -- N_Next_Event_E (Short) -- - -- Get/Set_Strong_Flag (Flag1) + -- Get/Set_Strong_Flag (Flag1) -- - -- Get/Set_Low_Bound (Field1) + -- Get/Set_Low_Bound (Field1) -- - -- Get/Set_High_Bound (Field2) + -- Get/Set_High_Bound (Field2) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) -- - -- Get/Set_Boolean (Field3) + -- Get/Set_Boolean (Field3) - -- N_Abort (Short) + -- N_Abort (Short) -- - -- Get/Set_Property (Field4) + -- Get/Set_Property (Field4) -- - -- Get/Set_Boolean (Field3) + -- Get/Set_Boolean (Field3) - -- N_HDL_Expr (Short) + -- N_HDL_Expr (Short) -- - -- Get/Set_Presence (State1) + -- Get/Set_Presence (State1) -- - -- Get/Set_HDL_Node (Field1) + -- Get/Set_HDL_Node (Field1) -- - -- Get/Set_HDL_Index (Field2) + -- Get/Set_HDL_Index (Field2) -- - -- Get/Set_Hash (Field5) + -- Get/Set_Hash (Field5) -- - -- Get/Set_Hash_Link (Field6) + -- Get/Set_Hash_Link (Field6) - -- N_Not_Bool (Short) + -- N_Not_Bool (Short) -- - -- Get/Set_Presence (State1) + -- Get/Set_Presence (State1) -- - -- Get/Set_Boolean (Field3) + -- Get/Set_Boolean (Field3) -- - -- Get/Set_Hash (Field5) + -- Get/Set_Hash (Field5) -- - -- Get/Set_Hash_Link (Field6) + -- Get/Set_Hash_Link (Field6) - -- N_And_Bool (Short) - -- N_Or_Bool (Short) - -- N_Imp_Bool (Short) + -- N_And_Bool (Short) + -- N_Or_Bool (Short) + -- N_Imp_Bool (Short) -- - -- Get/Set_Presence (State1) + -- Get/Set_Presence (State1) -- - -- Get/Set_Left (Field1) + -- Get/Set_Left (Field1) -- - -- Get/Set_Right (Field2) + -- Get/Set_Right (Field2) -- - -- Get/Set_Hash (Field5) + -- Get/Set_Hash (Field5) -- - -- Get/Set_Hash_Link (Field6) + -- Get/Set_Hash_Link (Field6) - -- N_True (Short) - -- N_False (Short) + -- N_True (Short) + -- N_False (Short) - -- N_EOS (Short) + -- N_EOS (Short) -- End of simulation. -- - -- Get/Set_HDL_Index (Field2) + -- Get/Set_HDL_Index (Field2) -- - -- Get/Set_Hash (Field5) + -- Get/Set_Hash (Field5) -- - -- Get/Set_Hash_Link (Field6) + -- Get/Set_Hash_Link (Field6) - -- End of nodes. + -- End of Nkind. subtype Node is Types.PSL_Node; @@ -402,6 +403,8 @@ package PSL.Nodes is subtype HDL_Node is Types.Int32; HDL_Null : constant HDL_Node := 0; + -- General methods. + procedure Init; -- Get the number of the last node. @@ -416,7 +419,7 @@ package PSL.Nodes is -- Return the type of a node. function Get_Psl_Type (N : Node) return PSL_Types; - -- Field: Location + -- Note: use field Location function Get_Location (N : Node) return Location_Type; procedure Set_Location (N : Node; Loc : Location_Type); @@ -429,53 +432,53 @@ package PSL.Nodes is -- procedure Set_Parent (N : Node; Parent : Node); -- Disp: Special - -- Field: Field1 (conv) + -- Field: Field1 (pos) function Get_Identifier (N : Node) return Name_Id; procedure Set_Identifier (N : Node; Id : Name_Id); -- Disp: Special - -- Field: Field1 (conv) + -- Field: Field1 (pos) function Get_Label (N : Node) return Name_Id; procedure Set_Label (N : Node; Id : Name_Id); -- Disp: Chain - -- Field: Field2 (conv) + -- Field: Field2 Chain function Get_Chain (N : Node) return Node; procedure Set_Chain (N : Node; Chain : Node); - -- Field: Field3 (conv) + -- Field: Field3 function Get_Instance (N : Node) return Node; procedure Set_Instance (N : Node; Instance : Node); - -- Field: Field2 (conv) + -- Field: Field2 function Get_Prefix (N : Node) return Node; procedure Set_Prefix (N : Node; Prefix : Node); - -- Field: Field4 (conv) + -- Field: Field4 function Get_Item_Chain (N : Node) return Node; procedure Set_Item_Chain (N : Node; Item : Node); - -- Field: Field4 (conv) + -- Field: Field4 function Get_Property (N : Node) return Node; procedure Set_Property (N : Node; Property : Node); - -- Field: Field3 (conv) + -- Field: Field3 function Get_String (N : Node) return Node; procedure Set_String (N : Node; Str : Node); - -- Field: Field1 (conv) + -- Field: Field1 function Get_SERE (N : Node) return Node; procedure Set_SERE (N : Node; S : Node); - -- Field: Field1 (conv) + -- Field: Field1 function Get_Left (N : Node) return Node; procedure Set_Left (N : Node; S : Node); - -- Field: Field2 (conv) + -- Field: Field2 function Get_Right (N : Node) return Node; procedure Set_Right (N : Node; S : Node); - -- Field: Field3 (conv) + -- Field: Field3 function Get_Sequence (N : Node) return Node; procedure Set_Sequence (N : Node; S : Node); @@ -487,15 +490,15 @@ package PSL.Nodes is function Get_Inclusive_Flag (N : Node) return Boolean; procedure Set_Inclusive_Flag (N : Node; B : Boolean); - -- Field: Field1 (conv) + -- Field: Field1 function Get_Low_Bound (N : Node) return Node; procedure Set_Low_Bound (N : Node; S : Node); - -- Field: Field2 (conv) + -- Field: Field2 function Get_High_Bound (N : Node) return Node; procedure Set_High_Bound (N : Node; S : Node); - -- Field: Field1 (conv) + -- Field: Field1 function Get_Number (N : Node) return Node; procedure Set_Number (N : Node; S : Node); @@ -503,15 +506,15 @@ package PSL.Nodes is function Get_Value (N : Node) return Uns32; procedure Set_Value (N : Node; Val : Uns32); - -- Field: Field3 (conv) + -- Field: Field3 function Get_Boolean (N : Node) return Node; procedure Set_Boolean (N : Node; B : Node); - -- Field: Field2 (conv) + -- Field: Field2 function Get_Decl (N : Node) return Node; procedure Set_Decl (N : Node; D : Node); - -- Field: Field1 (conv) + -- Field: Field1 (uc) function Get_HDL_Node (N : Node) return HDL_Node; procedure Set_HDL_Node (N : Node; H : HDL_Node); @@ -520,12 +523,12 @@ package PSL.Nodes is procedure Set_Hash (N : Node; E : Uns32); pragma Inline (Get_Hash); - -- Field: Field6 (conv) + -- Field: Field6 function Get_Hash_Link (N : Node) return Node; procedure Set_Hash_Link (N : Node; E : Node); pragma Inline (Get_Hash_Link); - -- Field: Field2 + -- Field: Field2 (uc) function Get_HDL_Index (N : Node) return Int32; procedure Set_HDL_Index (N : Node; Idx : Int32); @@ -537,27 +540,27 @@ package PSL.Nodes is function Get_NFA (N : Node) return NFA; procedure Set_NFA (N : Node; P : NFA); - -- Field: Field5 (conv) + -- Field: Field5 function Get_Parameter_List (N : Node) return Node; procedure Set_Parameter_List (N : Node; E : Node); - -- Field: Field3 (conv) + -- Field: Field3 function Get_Actual (N : Node) return Node; procedure Set_Actual (N : Node; E : Node); - -- Field: Field4 (conv) + -- Field: Field4 function Get_Formal (N : Node) return Node; procedure Set_Formal (N : Node; E : Node); - -- Field: Field1 (conv) + -- Field: Field1 Ref function Get_Declaration (N : Node) return Node; procedure Set_Declaration (N : Node; Decl : Node); - -- Field: Field2 (conv) + -- Field: Field2 function Get_Association_Chain (N : Node) return Node; procedure Set_Association_Chain (N : Node; Chain : Node); - -- Field: Field3 (conv) + -- Field: Field3 function Get_Global_Clock (N : Node) return Node; procedure Set_Global_Clock (N : Node; Clock : Node); end PSL.Nodes; |