diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-12-13 07:34:11 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-12-13 07:34:11 +0100 |
commit | 687d32b88144d65f153eea439cbf9ce763c2d5c5 (patch) | |
tree | 2221af4f3cbcf0129744ebd7b63daf6abcf3900b /src/grt/grt-avhpi.adb | |
parent | 13adc95751db357e2060b16fee2baaa818743b91 (diff) | |
download | ghdl-687d32b88144d65f153eea439cbf9ce763c2d5c5.tar.gz ghdl-687d32b88144d65f153eea439cbf9ce763c2d5c5.tar.bz2 ghdl-687d32b88144d65f153eea439cbf9ce763c2d5c5.zip |
rtis: add source location for blocks and object. Use them in fst dumper.
Diffstat (limited to 'src/grt/grt-avhpi.adb')
-rw-r--r-- | src/grt/grt-avhpi.adb | 83 |
1 files changed, 78 insertions, 5 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb index 690a6bb8f..434e99938 100644 --- a/src/grt/grt-avhpi.adb +++ b/src/grt/grt-avhpi.adb @@ -551,6 +551,41 @@ package body Grt.Avhpi is procedure Vhpi_Get_Str (Property : VhpiStrPropertyT; Obj : VhpiHandleT; + Res : out Ghdl_C_String) is + begin + Res := null; + + case Property is + when VhpiFileNameP => + declare + Parent : Ghdl_Rti_Access; + begin + Parent := Obj.Ctxt.Block; + while Parent /= null loop + case Parent.Kind is + when Ghdl_Rtik_Package + | Ghdl_Rtik_Package_Body + | Ghdl_Rtik_Entity + | Ghdl_Rtik_Architecture => + Res := + To_Ghdl_Rtin_Block_Filename_Acc (Parent).Filename; + return; + when Ghdl_Rtik_Block + | Ghdl_Rtik_Process => + Parent := + To_Ghdl_Rtin_Block_Acc (Parent).Parent; + when others => + return; + end case; + end loop; + end; + when others => + null; + end case; + end Vhpi_Get_Str; + + procedure Vhpi_Get_Str (Property : VhpiStrPropertyT; + Obj : VhpiHandleT; Res : out String; Len : out Natural) is @@ -747,6 +782,13 @@ package body Grt.Avhpi is when others => return; end case; + when VhpiCompInstStmtK => + Res := (Kind => VhpiArchBodyK, + Ctxt => Null_Context); + Get_Instance_Context (Ref.Inst, Ref.Ctxt, Res.Ctxt); + pragma Assert (Ref.Ctxt.Block.Kind = Ghdl_Rtik_Architecture); + Error := AvhpiErrorOk; + return; when others => return; end case; @@ -973,6 +1015,9 @@ package body Grt.Avhpi is Error : out AvhpiErrorT) is begin + -- Default error. + Error := AvhpiErrorNotImplemented; + case Property is when VhpiLeftBoundP => if Obj.Kind /= VhpiIntRangeK then @@ -985,9 +1030,9 @@ package body Grt.Avhpi is when Ghdl_Rtik_Type_I32 => Res := Obj.Rng_Addr.I32.Left; when others => - Error := AvhpiErrorNotImplemented; + null; end case; - return; + when VhpiRightBoundP => if Obj.Kind /= VhpiIntRangeK then Error := AvhpiErrorBadRel; @@ -998,11 +1043,39 @@ package body Grt.Avhpi is when Ghdl_Rtik_Type_I32 => Res := Obj.Rng_Addr.I32.Right; when others => - Error := AvhpiErrorNotImplemented; + null; end case; - return; + + when VhpiLineNoP => + declare + Linecol : Ghdl_Index_Type; + begin + case Obj.Kind is + when VhpiSigDeclK + | VhpiPortDeclK + | VhpiGenericDeclK => + -- Objects. + Linecol := Obj.Obj.Linecol; + when VhpiPackInstK + | VhpiArchBodyK + | VhpiEntityDeclK + | VhpiProcessStmtK + | VhpiBlockStmtK + | VhpiIfGenerateK => + -- Blocks. + Linecol := + To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block).Linecol; + when VhpiCompInstStmtK => + Linecol := Obj.Inst.Linecol; + when others => + return; + end case; + Res := VhpiIntT (Linecol / 256); + Error := AvhpiErrorOk; + end; + when others => - Error := AvhpiErrorNotImplemented; + null; end case; end Vhpi_Get; |