First import from sources

1 files changed, 623 insertions, 0 deletions

diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
new file mode 100644
index 0000000..62cd407
--- /dev/null
+++ b/translate/grt/grt-rtis_utils.adb
@@ -0,0 +1,623 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+with System; use System;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Types; use Grt.Types;
+--with Grt.Disp; use Grt.Disp;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Rtis_Utils is
+
+   function Traverse_Blocks (Ctxt : Rti_Context) return Traverse_Result
+   is
+      function Traverse_Instance (Ctxt : Rti_Context) return Traverse_Result;
+
+      function Traverse_Blocks_1 (Ctxt : Rti_Context) return Traverse_Result
+      is
+         Blk : Ghdl_Rtin_Block_Acc;
+
+         Res : Traverse_Result;
+         Nctxt : Rti_Context;
+         Index : Ghdl_Index_Type;
+         Child : Ghdl_Rti_Access;
+      begin
+         Res := Process (Ctxt, Ctxt.Block);
+         if Res /= Traverse_Ok then
+            return Res;
+         end if;
+
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         Index := 0;
+         while Index < Blk.Nbr_Child loop
+            Child := Blk.Children (Index);
+            Index := Index + 1;
+            case Child.Kind is
+               when Ghdl_Rtik_Process
+                 | Ghdl_Rtik_Block =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+                               Block => Child);
+                     Res := Traverse_Blocks_1 (Nctxt);
+                  end;
+               when Ghdl_Rtik_For_Generate =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                     Length : Ghdl_Index_Type;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt :=
+                       (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                        Block => Child);
+                     Length := Get_For_Generate_Length (Nblk, Ctxt);
+                     for I in 1 .. Length loop
+                        Res := Traverse_Blocks_1 (Nctxt);
+                        exit when Res = Traverse_Stop;
+                        Nctxt.Base := Nctxt.Base + Nblk.Size;
+                     end loop;
+                  end;
+               when Ghdl_Rtik_If_Generate =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt :=
+                       (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                        Block => Child);
+                     if Nctxt.Base /= Null_Address then
+                        Res := Traverse_Blocks_1 (Nctxt);
+                     end if;
+                  end;
+               when Ghdl_Rtik_Instance =>
+                  Res := Process (Ctxt, Child);
+                  if Res = Traverse_Ok then
+                     declare
+                        Obj : Ghdl_Rtin_Instance_Acc;
+                     begin
+                        Obj := To_Ghdl_Rtin_Instance_Acc (Child);
+
+                        Get_Instance_Context (Obj, Ctxt, Nctxt);
+                        Res := Traverse_Instance (Nctxt);
+                     end;
+                  end if;
+               when Ghdl_Rtik_Package
+                 | Ghdl_Rtik_Entity
+                 | Ghdl_Rtik_Architecture =>
+                  Internal_Error ("traverse_blocks");
+               when Ghdl_Rtik_Port
+                 | Ghdl_Rtik_Signal
+                 | Ghdl_Rtik_Guard
+                 | Ghdl_Rtik_Attribute_Quiet
+                 | Ghdl_Rtik_Attribute_Stable
+                 | Ghdl_Rtik_Attribute_Transaction =>
+                  Res := Process (Ctxt, Child);
+               when others =>
+                  null;
+            end case;
+            exit when Res = Traverse_Stop;
+         end loop;
+
+         return Res;
+      end Traverse_Blocks_1;
+
+      function Traverse_Instance (Ctxt : Rti_Context) return Traverse_Result
+      is
+         Blk : Ghdl_Rtin_Block_Acc;
+
+         Res : Traverse_Result;
+         Nctxt : Rti_Context;
+
+      begin
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               --  The entity.
+               Res := Traverse_Blocks_1 (Nctxt);
+               if Res /= Traverse_Stop then
+                  --  The architecture.
+                  Res := Traverse_Blocks_1 (Ctxt);
+               end if;
+            when Ghdl_Rtik_Package_Body =>
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               Res := Traverse_Blocks_1 (Nctxt);
+            when others =>
+               Internal_Error ("traverse_blocks");
+         end case;
+         return Res;
+      end Traverse_Instance;
+   begin
+      return Traverse_Instance (Ctxt);
+   end Traverse_Blocks;
+
+   function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean
+   is
+   begin
+      return (Atype.Mode and Ghdl_Rti_Type_Complex_Mask)
+        = Ghdl_Rti_Type_Complex;
+   end Rti_Complex_Type;
+
+   --  Disp value stored at ADDR and whose type is described by RTI.
+   procedure Get_Enum_Value
+     (Vstr : in out Vstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Append (Vstr, Enum_Rti.Names (Val));
+   end Get_Enum_Value;
+
+
+   procedure Foreach_Scalar (Ctxt : Rti_Context;
+                             Obj_Type : Ghdl_Rti_Access;
+                             Obj_Addr : Address;
+                             Is_Sig : Boolean)
+   is
+      --  Current address.
+      Addr : Address;
+
+      Name : Vstring;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access);
+
+      procedure Handle_Scalar (Rti : Ghdl_Rti_Access)
+      is
+         procedure Update (S : Ghdl_Index_Type) is
+         begin
+            Addr := Addr + (S / Storage_Unit);
+         end Update;
+      begin
+         Process (Addr, Name, Rti);
+
+         if Is_Sig then
+            Update (Address'Size);
+         else
+            case Rti.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Update (32);
+               when Ghdl_Rtik_Type_E8 =>
+                  Update (8);
+               when Ghdl_Rtik_Type_B2 =>
+                  Update (8);
+               when Ghdl_Rtik_Type_F64 =>
+                  Update (64);
+               when Ghdl_Rtik_Type_P64 =>
+                  Update (64);
+               when others =>
+                  Internal_Error ("handle_scalar");
+            end case;
+         end if;
+      end Handle_Scalar;
+
+      procedure Range_Pos_To_Val (Rti : Ghdl_Rti_Access;
+                                  Rng : Ghdl_Range_Ptr;
+                                  Pos : Ghdl_Index_Type;
+                                  Val : out Value_Union)
+      is
+      begin
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_I32 =>
+               case Rng.I32.Dir is
+                  when Dir_To =>
+                     Val.I32 := Rng.I32.Left + Ghdl_I32 (Pos);
+                  when Dir_Downto =>
+                     Val.I32 := Rng.I32.Left - Ghdl_I32 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_E8 =>
+               case Rng.E8.Dir is
+                  when Dir_To =>
+                     Val.E8 := Rng.E8.Left + Ghdl_E8 (Pos);
+                  when Dir_Downto =>
+                     Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_B2 =>
+               case Pos is
+                  when 0 =>
+                     Val.B2 := Rng.B2.Left;
+                  when 1 =>
+                     Val.B2 := Rng.B2.Right;
+                  when others =>
+                     Val.B2 := False;
+               end case;
+            when others =>
+               Internal_Error ("grt.rtis_utils.range_pos_to_val");
+         end case;
+      end Range_Pos_To_Val;
+
+      procedure Pos_To_Vstring
+        (Vstr : in out Vstring;
+         Rti : Ghdl_Rti_Access;
+         Rng : Ghdl_Range_Ptr;
+         Pos : Ghdl_Index_Type)
+      is
+         V : Value_Union;
+      begin
+         Range_Pos_To_Val (Rti, Rng, Pos, V);
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_I32 =>
+               declare
+                  S : String (1 .. 12);
+                  F : Natural;
+               begin
+                  To_String (S, F, V.I32);
+                  Append (Vstr, S (F .. S'Last));
+               end;
+            when Ghdl_Rtik_Type_E8 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8));
+            when Ghdl_Rtik_Type_B2 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2));
+            when others =>
+               Append (Vstr, '?');
+         end case;
+      end Pos_To_Vstring;
+
+      procedure Handle_Array_1 (El_Rti : Ghdl_Rti_Access;
+                                Rngs : Ghdl_Range_Array;
+                                Rtis : Ghdl_Rti_Arr_Acc;
+                                Index : Ghdl_Index_Type)
+      is
+         Len : Ghdl_Index_Type;
+         P : Natural;
+         Base_Type : Ghdl_Rti_Access;
+      begin
+         P := Length (Name);
+         if Index = 0 then
+            Append (Name, '(');
+         else
+            Append (Name, ',');
+         end if;
+
+         Base_Type := Get_Base_Type (Rtis (Index));
+         Len := Range_To_Length (Rngs (Index),  Base_Type);
+
+         for I in 1 .. Len loop
+            Pos_To_Vstring (Name, Base_Type, Rngs (Index), I - 1);
+            if Index = Rngs'Last then
+               Append (Name, ')');
+               Handle_Any (El_Rti);
+            else
+               Handle_Array_1 (El_Rti, Rngs, Rtis, Index + 1);
+            end if;
+            Truncate (Name, P + 1);
+         end loop;
+         Truncate (Name, P);
+      end Handle_Array_1;
+
+      procedure Handle_Array (Rti : Ghdl_Rtin_Type_Array_Acc;
+                              Vals : Ghdl_Uc_Array_Acc)
+      is
+         Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim;
+         Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
+      begin
+         Bound_To_Range (Vals.Bounds, Rti, Rngs);
+         Addr := Vals.Base;
+         Handle_Array_1 (Rti.Element, Rngs, Rti.Indexes, 0);
+      end Handle_Array;
+
+      procedure Handle_Record (Rti : Ghdl_Rtin_Type_Record_Acc)
+      is
+         El : Ghdl_Rtin_Element_Acc;
+         Obj_Addr : Address;
+         P : Natural;
+      begin
+         P := Length (Name);
+         Obj_Addr := Addr;
+         for I in 1 .. Rti.Nbrel loop
+            El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
+            if Is_Sig then
+               Addr := Obj_Addr + El.Sig_Off;
+            else
+               Addr := Obj_Addr + El.Val_Off;
+            end if;
+            Append (Name, '.');
+            Append (Name, El.Name);
+            Handle_Any (El.Eltype);
+            Truncate (Name, P);
+         end loop;
+         -- FIXME
+         --Addr := Obj_Addr + Rti.Xx;
+      end Handle_Record;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access)
+      is
+         Save_Addr : Address;
+      begin
+         case Rti.Kind is
+            when Ghdl_Rtik_Subtype_Scalar =>
+               Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype);
+            when Ghdl_Rtik_Type_I32
+              | Ghdl_Rtik_Type_E8
+              | Ghdl_Rtik_Type_B2 =>
+               Handle_Scalar (Rti);
+            when Ghdl_Rtik_Type_Array =>
+               Handle_Array (To_Ghdl_Rtin_Type_Array_Acc (Rti),
+                             To_Ghdl_Uc_Array_Acc (Addr));
+            when Ghdl_Rtik_Subtype_Array =>
+               declare
+                  St : Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                  Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               begin
+                  Bound_To_Range
+                    (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+                  if Rti_Complex_Type (Rti) then
+                     Save_Addr := Addr;
+                     Addr := To_Addr_Acc (Addr).all;
+                  end if;
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+                  if Rti_Complex_Type (Rti) then
+                     Addr := Save_Addr + (Address'Size / Storage_Unit);
+                  end if;
+               end;
+            when Ghdl_Rtik_Subtype_Array_Ptr =>
+               declare
+                  St : Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                  Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               begin
+                  Bound_To_Range
+                    (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+                  Save_Addr := Addr;
+                  Addr := To_Addr_Acc (Addr).all;
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+                  Addr := Save_Addr + (Address'Size / Storage_Unit);
+               end;
+--          when Ghdl_Rtik_Type_File =>
+--             declare
+--                Vptr : Ghdl_Value_Ptr;
+--             begin
+--                Vptr := To_Ghdl_Value_Ptr (Obj);
+--                Put (Stream, "File#");
+--                Put_I32 (Stream, Vptr.I32);
+--                --  FIXME: update OBJ (not very useful since never in a
+--                --   composite type).
+--             end;
+            when Ghdl_Rtik_Type_Record =>
+               if Rti_Complex_Type (Rti) then
+                  Save_Addr := Addr;
+                  Addr := To_Addr_Acc (Addr).all;
+               end if;
+               Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
+               if Rti_Complex_Type (Rti) then
+                  Addr := Save_Addr + (Address'Size / Storage_Unit);
+               end if;
+            when others =>
+               Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
+         end case;
+      end Handle_Any;
+   begin
+      Addr := Obj_Addr;
+      Handle_Any (Obj_Type);
+      Free (Name);
+   end Foreach_Scalar;
+
+   procedure Get_Value (Str : in out Vstring;
+                        Value : Value_Union;
+                        Type_Rti : Ghdl_Rti_Access)
+   is
+   begin
+      case Type_Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Append (Str, S (F .. S'Last));
+            end;
+         when Ghdl_Rtik_Type_E8 =>
+            Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8));
+         when Ghdl_Rtik_Type_B2 =>
+            Get_Enum_Value
+              (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
+         when Ghdl_Rtik_Type_F64 =>
+            declare
+               S : String (1 .. 32);
+               L : Integer;
+               --  Warning: this assumes a C99 snprintf (ie, it returns the
+               --  number of characters).
+               function snprintf (Cstr : Address;
+                                  Size : Natural;
+                                  Template : Address;
+                                  Arg : Ghdl_F64)
+                 return Integer;
+               pragma Import (C, snprintf);
+
+               Format : constant String := "%g" & Character'Val (0);
+            begin
+               L := snprintf (S'Address, S'Length, Format'Address, Value.F64);
+               if L < 0 then
+                  --  FIXME.
+                  Append (Str, "?");
+               else
+                  Append (Str, S (1 .. L));
+               end if;
+            end;
+         when Ghdl_Rtik_Type_P32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Append (Str, S (F .. S'Last));
+               Append (Str,
+                       To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc
+                                              (Type_Rti).Units (0)).Name);
+            end;
+         when Ghdl_Rtik_Type_P64 =>
+            declare
+               S : String (1 .. 21);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I64);
+               Append (Str, S (F .. S'Last));
+               Append (Str,
+                       To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc
+                                              (Type_Rti).Units (0)).Name);
+            end;
+         when others =>
+            Internal_Error ("grt.rtis_utils.get_value");
+      end case;
+   end Get_Value;
+
+   procedure Disp_Value (Stream : FILEs;
+                         Value : Value_Union;
+                         Type_Rti : Ghdl_Rti_Access)
+   is
+      Name : Vstring;
+   begin
+      Rtis_Utils.Get_Value (Name, Value, Type_Rti);
+      Put (Stream, Name);
+   end Disp_Value;
+
+   procedure Get_Enum_Value
+     (Rstr : in out Rstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Prepend (Rstr, Enum_Rti.Names (Val));
+   end Get_Enum_Value;
+
+
+   procedure Get_Value (Rstr : in out Rstring;
+                        Addr : Address;
+                        Type_Rti : Ghdl_Rti_Access)
+   is
+      Value : Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr);
+   begin
+      case Type_Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Prepend (Rstr, S (F .. S'Last));
+            end;
+         when Ghdl_Rtik_Type_E8 =>
+            Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8));
+         when Ghdl_Rtik_Type_B2 =>
+            Get_Enum_Value
+              (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
+         when others =>
+            Internal_Error ("grt.rtis_utils.get_value(rstr)");
+      end case;
+   end Get_Value;
+
+   procedure Get_Path_Name (Rstr : in out Rstring;
+                            Last_Ctxt : Rti_Context;
+                            Sep : Character;
+                            Is_Instance : Boolean := True)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ctxt : Rti_Context;
+   begin
+      Ctxt := Last_Ctxt;
+      loop
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         case Ctxt.Block.Kind is
+            when Ghdl_Rtik_Process
+              | Ghdl_Rtik_Block
+              | Ghdl_Rtik_If_Generate =>
+               Prepend (Rstr, Blk.Name);
+               Prepend (Rstr, Sep);
+               Ctxt := Get_Parent_Context (Ctxt);
+            when Ghdl_Rtik_Entity =>
+               declare
+                  Link : Ghdl_Entity_Link_Acc;
+               begin
+                  Link := To_Ghdl_Entity_Link_Acc (Ctxt.Base);
+                  Ctxt := (Base => Ctxt.Base,
+                           Block => Link.Rti);
+               end;
+            when Ghdl_Rtik_Architecture =>
+               declare
+                  Entity_Ctxt: Rti_Context;
+                  Link : Ghdl_Entity_Link_Acc;
+                  Parent_Inst : Ghdl_Rti_Access;
+               begin
+                  --  Architecture name.
+                  if Is_Instance then
+                     Prepend (Rstr, ')');
+                     Prepend (Rstr, Blk.Name);
+                     Prepend (Rstr, '(');
+                  end if;
+
+                  Entity_Ctxt := Get_Parent_Context (Ctxt);
+
+                  --  Instance parent.
+                  Link := To_Ghdl_Entity_Link_Acc (Entity_Ctxt.Base);
+                  Get_Instance_Link (Link, Ctxt, Parent_Inst);
+
+                  --  Add entity name.
+                  if Is_Instance or Parent_Inst = null then
+                     Prepend (Rstr,
+                              To_Ghdl_Rtin_Block_Acc (Entity_Ctxt.Block).Name);
+                  end if;
+
+                  if Parent_Inst = null then
+                     --  Top reached.
+                     Prepend (Rstr, Sep);
+                     return;
+                  else
+                     --  Instantiation statement label.
+                     if Is_Instance then
+                        Prepend (Rstr, '@');
+                     end if;
+                     Prepend (Rstr,
+                              To_Ghdl_Rtin_Object_Acc (Parent_Inst).Name);
+                     Prepend (Rstr, Sep);
+                  end if;
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Iter : Ghdl_Rtin_Object_Acc;
+                  Addr : Address;
+               begin
+                  Prepend (Rstr, ')');
+                  Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                  Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+                  Get_Value (Rstr, Addr, Get_Base_Type (Iter.Obj_Type));
+                  Prepend (Rstr, '(');
+                  Prepend (Rstr, Blk.Name);
+                  Prepend (Rstr, Sep);
+                  Ctxt := Get_Parent_Context (Ctxt);
+               end;
+            when others =>
+               Internal_Error ("grt.rtis_utils.get_path_name");
+         end case;
+      end loop;
+   end Get_Path_Name;
+
+   procedure Put (Stream : FILEs; Ctxt : Rti_Context)
+   is
+      Rstr : Rstring;
+   begin
+      Get_Path_Name (Rstr, Ctxt, '.');
+      Put (Stream, Rstr);
+      Free (Rstr);
+   end Put;
+
+end Grt.Rtis_Utils;