diff options
Diffstat (limited to 'src/translate/grt/grt-disp_signals.adb')
| -rw-r--r-- | src/translate/grt/grt-disp_signals.adb | 524 |
1 files changed, 0 insertions, 524 deletions
diff --git a/src/translate/grt/grt-disp_signals.adb b/src/translate/grt/grt-disp_signals.adb deleted file mode 100644 index 424d20d..0000000 --- a/src/translate/grt/grt-disp_signals.adb +++ /dev/null @@ -1,524 +0,0 @@ --- GHDL Run Time (GRT) - Display subprograms for signals. --- Copyright (C) 2002 - 2014 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. --- --- As a special exception, if other files instantiate generics from this --- unit, or you link this unit with other files to produce an executable, --- this unit does not by itself cause the resulting executable to be --- covered by the GNU General Public License. This exception does not --- however invalidate any other reasons why the executable file might be --- covered by the GNU Public License. -with System; use System; -with System.Storage_Elements; -- Work around GNAT bug. -pragma Unreferenced (System.Storage_Elements); -with Ada.Unchecked_Conversion; -with Grt.Rtis; use Grt.Rtis; -with Grt.Rtis_Addr; use Grt.Rtis_Addr; -with Grt.Rtis_Utils; use Grt.Rtis_Utils; -with Grt.Astdio; use Grt.Astdio; -with Grt.Errors; use Grt.Errors; -pragma Elaborate_All (Grt.Rtis_Utils); -with Grt.Vstrings; use Grt.Vstrings; -with Grt.Options; -with Grt.Processes; -with Grt.Disp; use Grt.Disp; - -package body Grt.Disp_Signals is - procedure Foreach_Scalar_Signal - (Process : access procedure (Val_Addr : Address; - Val_Name : Vstring; - Val_Type : Ghdl_Rti_Access; - Param : Rti_Object)) - is - procedure Call_Process (Val_Addr : Address; - Val_Name : Vstring; - Val_Type : Ghdl_Rti_Access; - Param : Rti_Object) is - begin - Process.all (Val_Addr, Val_Name, Val_Type, Param); - end Call_Process; - - pragma Inline (Call_Process); - - procedure Foreach_Scalar_Signal_Signal is new - Foreach_Scalar (Param_Type => Rti_Object, - Process => Call_Process); - - function Foreach_Scalar_Signal_Object - (Ctxt : Rti_Context; Obj : Ghdl_Rti_Access) - return Traverse_Result - is - Sig : Ghdl_Rtin_Object_Acc; - begin - case Obj.Kind is - when Ghdl_Rtik_Signal - | Ghdl_Rtik_Port - | Ghdl_Rtik_Guard - | Ghdl_Rtik_Attribute_Quiet - | Ghdl_Rtik_Attribute_Stable - | Ghdl_Rtik_Attribute_Transaction => - Sig := To_Ghdl_Rtin_Object_Acc (Obj); - Foreach_Scalar_Signal_Signal - (Ctxt, Sig.Obj_Type, - Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True, - Rti_Object'(Obj, Ctxt)); - when others => - null; - end case; - return Traverse_Ok; - end Foreach_Scalar_Signal_Object; - - function Foreach_Scalar_Signal_Traverse is - new Traverse_Blocks (Process => Foreach_Scalar_Signal_Object); - - Res : Traverse_Result; - pragma Unreferenced (Res); - begin - Res := Foreach_Scalar_Signal_Traverse (Get_Top_Context); - end Foreach_Scalar_Signal; - - procedure Disp_Context (Ctxt : Rti_Context) - is - Blk : Ghdl_Rtin_Block_Acc; - Nctxt : Rti_Context; - begin - Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block); - case Blk.Common.Kind is - when Ghdl_Rtik_Block - | Ghdl_Rtik_Process => - Nctxt := Get_Parent_Context (Ctxt); - Disp_Context (Nctxt); - Put ('.'); - Put (Blk.Name); - when Ghdl_Rtik_Entity => - Put (Blk.Name); - when Ghdl_Rtik_Architecture => - Nctxt := Get_Parent_Context (Ctxt); - Disp_Context (Nctxt); - Put ('('); - Put (Blk.Name); - Put (')'); - when others => - Internal_Error ("disp_context"); - end case; - end Disp_Context; - - -- This is a debugging procedure. - pragma Unreferenced (Disp_Context); - - -- Option --trace-signals. - - -- Disp transaction TRANS from signal SIG. - procedure Disp_Transaction (Trans : Transaction_Acc; - Sig_Type : Ghdl_Rti_Access; - Mode : Mode_Type) - is - T : Transaction_Acc; - begin - T := Trans; - loop - case T.Kind is - when Trans_Value => - if Sig_Type /= null then - Disp_Value (stdout, T.Val, Sig_Type); - else - Disp_Value (T.Val, Mode); - end if; - when Trans_Direct => - if Sig_Type /= null then - Disp_Value (stdout, T.Val_Ptr.all, Sig_Type); - else - Disp_Value (T.Val_Ptr.all, Mode); - end if; - when Trans_Null => - Put ("NULL"); - when Trans_Error => - Put ("ERROR"); - end case; - if T.Kind = Trans_Direct then - -- The Time field is not updated for direct transaction. - Put ("[DIRECT]"); - else - Put ("@"); - Put_Time (stdout, T.Time); - end if; - T := T.Next; - exit when T = null; - Put (", "); - end loop; - end Disp_Transaction; - - procedure Disp_Simple_Signal - (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean) - is - function To_Address is new Ada.Unchecked_Conversion - (Source => Resolved_Signal_Acc, Target => Address); - begin - Put (' '); - Put (stdout, Sig.all'Address); - Put (' '); - Disp_Mode (Sig.Mode); - Put (' '); - if Sig.Active then - Put ('A'); - else - Put ('-'); - end if; - if Sig.Event then - Put ('E'); - else - Put ('-'); - end if; - if Sig.Has_Active then - Put ('a'); - else - Put ('-'); - end if; - if Sig.S.Effective /= null then - Put ('e'); - else - Put ('-'); - end if; - if Boolean'(True) then - Put (" last_event="); - Put_Time (stdout, Sig.Last_Event); - Put (" last_active="); - Put_Time (stdout, Sig.Last_Active); - end if; - Put (" val="); - if Sig_Type /= null then - Disp_Value (stdout, Sig.Value, Sig_Type); - else - Disp_Value (Sig.Value, Sig.Mode); - end if; - Put ("; drv="); - if Sig_Type /= null then - Disp_Value (stdout, Sig.Driving_Value, Sig_Type); - else - Disp_Value (Sig.Driving_Value, Sig.Mode); - end if; - if Sources then - if Sig.Nbr_Ports > 0 then - Put (';'); - Put_I32 (stdout, Ghdl_I32 (Sig.Nbr_Ports)); - Put (" ports"); - end if; - if Sig.S.Mode_Sig in Mode_Signal_User then - if Sig.S.Resolv /= null then - Put (stdout, " res func "); - Put (stdout, To_Address(Sig.S.Resolv)); - end if; - if Sig.S.Nbr_Drivers = 0 then - Put ("; no driver"); - elsif Sig.S.Nbr_Drivers = 1 then - Put ("; trans="); - Disp_Transaction - (Sig.S.Drivers (0).First_Trans, Sig_Type, Sig.Mode); - else - for I in 0 .. Sig.S.Nbr_Drivers - 1 loop - New_Line; - Put (" "); - Disp_Transaction - (Sig.S.Drivers (I).First_Trans, Sig_Type, Sig.Mode); - end loop; - end if; - end if; - end if; - New_Line; - end Disp_Simple_Signal; - - procedure Disp_Signal_Name (Stream : FILEs; - Ctxt : Rti_Context; - Sig : Ghdl_Rtin_Object_Acc) is - begin - case Sig.Common.Kind is - when Ghdl_Rtik_Signal - | Ghdl_Rtik_Port - | Ghdl_Rtik_Guard => - Put (stdout, Ctxt); - Put ("."); - Put (Stream, Sig.Name); - when Ghdl_Rtik_Attribute_Quiet => - Put (stdout, Ctxt); - Put ("."); - Put (Stream, " 'quiet"); - when Ghdl_Rtik_Attribute_Stable => - Put (stdout, Ctxt); - Put ("."); - Put (Stream, " 'stable"); - when Ghdl_Rtik_Attribute_Transaction => - Put (stdout, Ctxt); - Put ("."); - Put (Stream, " 'transaction"); - when others => - null; - end case; - end Disp_Signal_Name; - - procedure Disp_Scalar_Signal (Val_Addr : Address; - Val_Name : Vstring; - Val_Type : Ghdl_Rti_Access; - Parent : Rti_Object) - is - begin - Disp_Signal_Name (stdout, Parent.Ctxt, - To_Ghdl_Rtin_Object_Acc (Parent.Obj)); - Put (stdout, Val_Name); - Disp_Simple_Signal (To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all), - Val_Type, Options.Disp_Sources); - end Disp_Scalar_Signal; - - - procedure Disp_All_Signals is - begin - Foreach_Scalar_Signal (Disp_Scalar_Signal'access); - end Disp_All_Signals; - - -- Option disp-sensitivity - - procedure Disp_Scalar_Sensitivity (Val_Addr : Address; - Val_Name : Vstring; - Val_Type : Ghdl_Rti_Access; - Parent : Rti_Object) - is - pragma Unreferenced (Val_Type); - Sig : Ghdl_Signal_Ptr; - - Action : Action_List_Acc; - begin - Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all); - if Sig.Flags.Seen then - return; - else - Sig.Flags.Seen := True; - end if; - Disp_Signal_Name (stdout, Parent.Ctxt, - To_Ghdl_Rtin_Object_Acc (Parent.Obj)); - Put (stdout, Val_Name); - New_Line (stdout); - - Action := Sig.Event_List; - while Action /= null loop - Put (stdout, " wakeup "); - Grt.Processes.Disp_Process_Name (stdout, Action.Proc); - New_Line (stdout); - Action := Action.Next; - end loop; - - if Sig.S.Mode_Sig in Mode_Signal_User then - for I in 1 .. Sig.S.Nbr_Drivers loop - Put (stdout, " driven "); - Grt.Processes.Disp_Process_Name - (stdout, Sig.S.Drivers (I - 1).Proc); - New_Line (stdout); - end loop; - end if; - end Disp_Scalar_Sensitivity; - - procedure Disp_All_Sensitivity is - begin - Foreach_Scalar_Signal (Disp_Scalar_Sensitivity'access); - end Disp_All_Sensitivity; - - - -- Option disp-signals-map - - procedure Disp_Signals_Map_Scalar (Val_Addr : Address; - Val_Name : Vstring; - Val_Type : Ghdl_Rti_Access; - Parent : Rti_Object) - is - pragma Unreferenced (Val_Type); - - function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion - (Source => Address, Target => Ghdl_Signal_Ptr); - - S : Ghdl_Signal_Ptr; - begin - Disp_Signal_Name (stdout, - Parent.Ctxt, To_Ghdl_Rtin_Object_Acc (Parent.Obj)); - Put (stdout, Val_Name); - Put (": "); - S := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all); - Put (stdout, S.all'Address); - Put (" net: "); - Put_I32 (stdout, Ghdl_I32 (S.Net)); - if S.Has_Active then - Put (" +A"); - end if; - New_Line; - end Disp_Signals_Map_Scalar; - - procedure Disp_Signals_Map is - begin - Foreach_Scalar_Signal (Disp_Signals_Map_Scalar'access); - end Disp_Signals_Map; - - -- Option --disp-signals-table - procedure Disp_Mode_Signal (Mode : Mode_Signal_Type) - is - begin - case Mode is - when Mode_Signal => - Put ("signal"); - when Mode_Linkage => - Put ("linkage"); - when Mode_Buffer => - Put ("buffer"); - when Mode_Out => - Put ("out"); - when Mode_Inout => - Put ("inout"); - when Mode_In => - Put ("in"); - when Mode_Stable => - Put ("stable"); - when Mode_Quiet => - Put ("quiet"); - when Mode_Transaction => - Put ("transaction"); - when Mode_Delayed => - Put ("delayed"); - when Mode_Guard => - Put ("guard"); - when Mode_Conv_In => - Put ("conv_in"); - when Mode_Conv_Out => - Put ("conv_out"); - when Mode_End => - Put ("end"); - end case; - end Disp_Mode_Signal; - - procedure Disp_Signals_Table - is - Sig : Ghdl_Signal_Ptr; - begin - for I in Sig_Table.First .. Sig_Table.Last loop - Sig := Sig_Table.Table (I); - Put_Sig_Index (I); - Put (": "); - Put (stdout, Sig.all'Address); - if Sig.Has_Active then - Put (" +A"); - end if; - Put (" net: "); - Put_I32 (stdout, Ghdl_I32 (Sig.Net)); - Put (" smode: "); - Disp_Mode_Signal (Sig.S.Mode_Sig); - Put (" #prt: "); - Put_I32 (stdout, Ghdl_I32 (Sig.Nbr_Ports)); - if Sig.S.Mode_Sig in Mode_Signal_User then - Put (" #drv: "); - Put_I32 (stdout, Ghdl_I32 (Sig.S.Nbr_Drivers)); - if Sig.S.Effective /= null then - Put (" eff: "); - Put (stdout, Sig.S.Effective.all'Address); - end if; - if Sig.S.Resolv /= null then - Put (" resolved"); - end if; - end if; - if Boolean'(False) then - Put (" link: "); - Put (stdout, Sig.Link.all'Address); - end if; - New_Line; - if Sig.Nbr_Ports /= 0 then - for J in 1 .. Sig.Nbr_Ports loop - Put (" "); - Put (stdout, Sig.Ports (J - 1).all'Address); - end loop; - New_Line; - end if; - end loop; - Grt.Stdio.fflush (stdout); - end Disp_Signals_Table; - - procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr) - is - begin - Disp_Simple_Signal (Sig, null, True); - end Disp_A_Signal; - - procedure Put_Signal_Name (Stream : FILEs; Sig : Ghdl_Signal_Ptr) - is - Found : Boolean := False; - Cur_Ctxt : Rti_Context; - Cur_Sig : Ghdl_Rtin_Object_Acc; - - procedure Process_Scalar (Val_Addr : Address; - Val_Name : Vstring; - Val_Type : Ghdl_Rti_Access; - Param : Boolean) - is - pragma Unreferenced (Val_Type); - pragma Unreferenced (Param); - Sig1 : Ghdl_Signal_Ptr; - begin - -- Read the signal. - Sig1 := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all); - if Sig1 = Sig and not Found then - Disp_Signal_Name (Stream, Cur_Ctxt, Cur_Sig); - Put (Stream, Val_Name); - Found := True; - end if; - end Process_Scalar; - - procedure Foreach_Scalar is new Grt.Rtis_Utils.Foreach_Scalar - (Param_Type => Boolean, Process => Process_Scalar); - - function Process_Block (Ctxt : Rti_Context; - Obj : Ghdl_Rti_Access) - return Traverse_Result - is - begin - case Obj.Kind is - when Ghdl_Rtik_Signal - | Ghdl_Rtik_Port - | Ghdl_Rtik_Guard - | Ghdl_Rtik_Attribute_Stable - | Ghdl_Rtik_Attribute_Quiet - | Ghdl_Rtik_Attribute_Transaction => - Cur_Ctxt := Ctxt; - Cur_Sig := To_Ghdl_Rtin_Object_Acc (Obj); - Foreach_Scalar - (Ctxt, Cur_Sig.Obj_Type, - Loc_To_Addr (Cur_Sig.Common.Depth, Cur_Sig.Loc, Ctxt), - True, True); - if Found then - return Traverse_Stop; - end if; - when others => - null; - end case; - return Traverse_Ok; - end Process_Block; - - function Foreach_Block is new Grt.Rtis_Utils.Traverse_Blocks - (Process_Block); - - Res_Status : Traverse_Result; - pragma Unreferenced (Res_Status); - begin - Res_Status := Foreach_Block (Get_Top_Context); - if not Found then - Put (Stream, "(unknown signal)"); - end if; - end Put_Signal_Name; - -end Grt.Disp_Signals; |