-- GHDL Run Time (GRT) - RTI utilities.
-- 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 Grt.Errors; use Grt.Errors;
with Grt.To_Strings; use Grt.To_Strings;
with Grt.Vstrings_IO; use Grt.Vstrings_IO;
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,
Block => Child);
Res := Traverse_Blocks_1 (Nctxt);
end;
when Ghdl_Rtik_For_Generate =>
declare
Gen : constant Ghdl_Rtin_Generate_Acc :=
To_Ghdl_Rtin_Generate_Acc (Child);
Length : Ghdl_Index_Type;
begin
Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
Block => Gen.Child);
Length := Get_For_Generate_Length (Gen, Ctxt);
for I in 1 .. Length loop
Res := Traverse_Blocks_1 (Nctxt);
exit when Res = Traverse_Stop;
Nctxt.Base := Nctxt.Base + Gen.Size;
end loop;
end;
when Ghdl_Rtik_If_Generate
| Ghdl_Rtik_Case_Generate =>
Nctxt := Get_If_Case_Generate_Child (Ctxt, Child);
if Nctxt.Base /= Null_Address then
Res := Traverse_Blocks_1 (Nctxt);
end if;
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);
if Nctxt /= Null_Context then
Res := Traverse_Instance (Nctxt);
end if;
end;
end if;
when Ghdl_Rtik_Package
| Ghdl_Rtik_Entity
| Ghdl_Rtik_Architecture =>
Internal_Error ("traverse_blocks");
when others =>
Res := Process (Ctxt, Child);
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;
-- 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 Object_To_Base_Bounds (Obj_Type : Ghdl_Rti_Access;
Obj_Loc : Address;
Addr : out Address;
Bounds : out Address) is
begin
-- FIXME: put this into a function.
Bounds := Null_Address;
Addr := Obj_Loc;
case Obj_Type.Kind is
when Ghdl_Rtik_Subtype_Array
| Ghdl_Rtik_Type_Record
| Ghdl_Rtik_Subtype_Record =>
-- Object is a pointer.
if Rti_Complex_Type (Obj_Type) then
Addr := To_Addr_Acc (Obj_Loc).all;
end if;
when Ghdl_Rtik_Type_Array
| Ghdl_Rtik_Type_Unbounded_Record
| Ghdl_Rtik_Subtype_Unbounded_Record =>
-- Object is a fat pointer.
Bounds := To_Ghdl_Uc_Array_Acc (Obj_Loc).Bounds;
Addr := To_Ghdl_Uc_Array_Acc (Obj_Loc).Base;
when others =>
null;
end case;
end Object_To_Base_Bounds;
procedure Record_To_Element (Obj : Address;
El : Ghdl_Rtin_Element_Acc;
Is_Sig : Boolean;
Rec_Layout : Address;
El_Addr : out Address;
El_Bounds : out Address)
is
Off : Ghdl_Index_Type;
Off_Addr : Address;
begin
if Is_Sig then
Off := El.Sig_Off;
else
Off := El.Val_Off;
end if;
case El.Common.Mode is
when Ghdl_Rti_Element_Static =>
El_Addr := Obj + Off;
El_Bounds := Null_Address;
when Ghdl_Rti_Element_Complex =>
Off_Addr := Rec_Layout + Off;
El_Addr := Obj + To_Ghdl_Index_Ptr (Off_Addr).all;
El_Bounds := Null_Address;
when Ghdl_Rti_Element_Unbounded =>
Off_Addr := Rec_Layout + Off;
El_Addr := Obj + To_Ghdl_Index_Ptr (Off_Addr).all;
El_Bounds := Rec_Layout + El.Layout_Off;
if El.Eltype.Kind = Ghdl_Rtik_Type_Array then
El_Bounds := Array_Layout_To_Bounds (El_Bounds);
end if;
when others =>
Internal_Error ("record_to_element");
end case;
end Record_To_Element;
procedure Foreach_Scalar (Ctxt : Rti_Context;
Obj_Type : Ghdl_Rti_Access;
Obj_Addr : Address;
Is_Sig : Boolean;
Param : Param_Type)
is
-- Current address.
Addr : Address;
Bounds : 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, Param);
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_E32 =>
Update (32);
when Ghdl_Rtik_Type_B1 =>
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_E32 =>
case Rng.E32.Dir is
when Dir_To =>
Val.E32 := Rng.E32.Left + Ghdl_E32 (Pos);
when Dir_Downto =>
Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos);
end case;
when Ghdl_Rtik_Type_B1 =>
case Pos is
when 0 =>
Val.B1 := Rng.B1.Left;
when 1 =>
Val.B1 := Rng.B1.Right;
when others =>
Val.B1 := 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_E32 =>
Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E32));
when Ghdl_Rtik_Type_B1 =>
Get_Enum_Value (Vstr, Rti, Ghdl_B1'Pos (V.B1));
when others =>
Append (Vstr, '?');
end case;
end Pos_To_Vstring;
procedure Handle_Array_1 (Arr_Rti : Ghdl_Rtin_Type_Array_Acc;
Index : Ghdl_Index_Type)
is
Idx_Rti : constant Ghdl_Rti_Access := Arr_Rti.Indexes (Index);
Base_Type : constant Ghdl_Rti_Access := Get_Base_Type (Idx_Rti);
El_Rti : constant Ghdl_Rti_Access := Arr_Rti.Element;
Last_Index : constant Ghdl_Index_Type := Arr_Rti.Nbr_Dim - 1;
Rng : Ghdl_Range_Ptr;
Len : Ghdl_Index_Type;
P : Natural;
Cur_Bounds : Address;
begin
P := Length (Name);
if Index = 0 then
Append (Name, '(');
else
Append (Name, ',');
end if;
Extract_Range (Bounds, Base_Type, Rng);
Len := Range_To_Length (Rng, Base_Type);
Cur_Bounds := Bounds;
for I in 1 .. Len loop
Pos_To_Vstring (Name, Base_Type, Rng, I - 1);
if Index = Last_Index then
-- FIXME: not always needed.
Bounds := Array_Layout_To_Bounds (Cur_Bounds);
Append (Name, ')');
Handle_Any (El_Rti);
else
Bounds := Cur_Bounds;
Handle_Array_1 (Arr_Rti, Index + 1);
end if;
Truncate (Name, P + 1);
end loop;
Truncate (Name, P);
end Handle_Array_1;
procedure Handle_Record (Rti : Ghdl_Rtin_Type_Record_Acc)
is
Rec_Addr : constant Address := Addr;
Rec_Bounds : constant Address := Bounds;
Sizes : constant Ghdl_Indexes_Ptr :=
To_Ghdl_Indexes_Ptr (Bounds);
El : Ghdl_Rtin_Element_Acc;
P : Natural;
begin
P := Length (Name);
for I in 1 .. Rti.Nbrel loop
El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
Record_To_Element
(Rec_Addr, El, Is_Sig, Rec_Bounds, Addr, Bounds);
Append (Name, '.');
Append (Name, El.Name);
Handle_Any (El.Eltype);
Truncate (Name, P);
end loop;
if Is_Sig then
Addr := Rec_Addr + Sizes.Signal;
else
Addr := Rec_Addr + Sizes.Value;
end if;
-- Bounds was fully used, no need to restore it.
Bounds := Null_Address;
end Handle_Record;
procedure Handle_Any (Rti : Ghdl_Rti_Access) is
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_E32
| Ghdl_Rtik_Type_B1 =>
Handle_Scalar (Rti);
when Ghdl_Rtik_Type_Array =>
Handle_Array_1 (To_Ghdl_Rtin_Type_Array_Acc (Rti), 0);
when Ghdl_Rtik_Subtype_Array =>
declare
St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
Bt : constant Ghdl_Rtin_Type_Array_Acc :=
To_Ghdl_Rtin_Type_Array_Acc (St.Basetype);
Prev_Bounds : constant Address := Bounds;
Layout : Address;
begin
Layout := Loc_To_Addr (St.Common.Depth, St.Layout, Ctxt);
Bounds := Array_Layout_To_Bounds (Layout);
Handle_Array_1 (Bt, 0);
Bounds := Prev_Bounds;
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 =>
declare
Bt : constant Ghdl_Rtin_Type_Record_Acc :=
To_Ghdl_Rtin_Type_Record_Acc (Rti);
Prev_Bounds : constant Address := Bounds;
begin
Bounds := Loc_To_Addr (Bt.Common.Depth, Bt.Layout, Ctxt);
Handle_Record (Bt);
Bounds := Prev_Bounds;
end;
when Ghdl_Rtik_Type_Unbounded_Record =>
-- Bounds (layout) must have been extracted.
Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
when Ghdl_Rtik_Subtype_Unbounded_Record =>
declare
St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
Bt : constant Ghdl_Rtin_Type_Record_Acc :=
To_Ghdl_Rtin_Type_Record_Acc (St.Basetype);
begin
Handle_Record (Bt);
end;
when Ghdl_Rtik_Subtype_Record =>
declare
St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
Bt : constant Ghdl_Rtin_Type_Record_Acc :=
To_Ghdl_Rtin_Type_Record_Acc (St.Basetype);
Prev_Bounds : constant Address := Bounds;
begin
Bounds := Loc_To_Addr (St.Common.Depth, St.Layout, Ctxt);
Handle_Record (Bt);
Bounds := Prev_Bounds;
end;
when others =>
Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
end case;
end Handle_Any;
begin
Object_To_Base_Bounds (Obj_Type, Obj_Addr, Addr, Bounds);
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_E32 =>
Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E32));
when Ghdl_Rtik_Type_B1 =>
Get_Enum_Value
(Str, Type_Rti, Ghdl_Index_Type (Ghdl_B1'Pos (Value.B1)));
when Ghdl_Rtik_Type_F64 =>
declare
S : String (1 .. 32);
L : Integer;
function Snprintf_G (Cstr : Address;
Size : Natural;
Arg : Ghdl_F64)
return Integer;
pragma Import (C, Snprintf_G, "__ghdl_snprintf_g");
begin
L := Snprintf_G (S'Address, S'Length, 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, Get_Physical_Unit_Name
(To_Ghdl_Rtin_Type_Physical_Acc (Type_Rti).Units (0)));
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, Get_Physical_Unit_Name
(To_Ghdl_Rtin_Type_Physical_Acc (Type_Rti).Units (0)));
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);
Free (Name);
end Disp_Value;
function Get_Physical_Unit_Name (Unit : Ghdl_Rti_Access)
return Ghdl_C_String
is
begin
case Unit.Kind is
when Ghdl_Rtik_Unit64 =>
return To_Ghdl_Rtin_Unit64_Acc (Unit).Name;
when Ghdl_Rtik_Unitptr =>
return To_Ghdl_Rtin_Unitptr_Acc (Unit).Name;
when others =>
Internal_Error ("rtis_utils.physical_unit_name");
end case;
end Get_Physical_Unit_Name;
function Get_Physical_Unit_Value (Unit : Ghdl_Rti_Access;
Type_Rti : Ghdl_Rti_Access)
return Ghdl_I64 is
begin
case Unit.Kind is
when Ghdl_Rtik_Unit64 =>
return To_Ghdl_Rtin_Unit64_Acc (Unit).Value;
when Ghdl_Rtik_Unitptr =>
case Type_Rti.Kind is
when Ghdl_Rtik_Type_P64 =>
return To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I64;
when Ghdl_Rtik_Type_P32 =>
return Ghdl_I64
(To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I32);
when others =>
Internal_Error ("get_physical_unit_value(1)");
end case;
when others =>
Internal_Error ("get_physical_unit_value(2)");
end case;
end Get_Physical_Unit_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 : constant 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_E32 =>
Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E32));
when Ghdl_Rtik_Type_B1 =>
Get_Enum_Value
(Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B1'Pos (Value.B1)));
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_Entity =>
declare
Link : Ghdl_Entity_Link_Acc;
begin
Link := To_Ghdl_Entity_Link_Acc (Ctxt.Base);
Ctxt := (Base => Ctxt.Base,
Block => Link.Rti);
if Ctxt.Block = null then
-- Process in an entity.
-- FIXME: check.
Prepend (Rstr, Blk.Name);
return;
end if;
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_Process
| Ghdl_Rtik_Block =>
Prepend (Rstr, Blk.Name);
Prepend (Rstr, Sep);
Ctxt := Get_Parent_Context (Ctxt);
when Ghdl_Rtik_Generate_Body =>
declare
Gen : constant Ghdl_Rtin_Generate_Acc :=
To_Ghdl_Rtin_Generate_Acc (Blk.Parent);
Iter : Ghdl_Rtin_Object_Acc;
Addr : Address;
begin
if Blk.Parent.Kind = Ghdl_Rtik_For_Generate then
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, '(');
end if;
Prepend (Rstr, Gen.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;
function Get_Linecol_Line (Linecol : Ghdl_Index_Type) return Ghdl_U32 is
begin
return Ghdl_U32 (Linecol / 256);
end Get_Linecol_Line;
function Get_Linecol_Col (Linecol : Ghdl_Index_Type) return Ghdl_U32 is
begin
return Ghdl_U32 (Linecol mod 256);
end Get_Linecol_Col;
function Get_Filename (Ctxt : Rti_Context) return Ghdl_C_String
is
C : Rti_Context;
begin
C := Ctxt;
loop
case C.Block.Kind is
when Ghdl_Rtik_Package
| Ghdl_Rtik_Package_Body
| Ghdl_Rtik_Architecture
| Ghdl_Rtik_Entity =>
declare
Blk : constant Ghdl_Rtin_Block_Filename_Acc :=
To_Ghdl_Rtin_Block_Filename_Acc (C.Block);
begin
return Blk.Filename;
end;
when others =>
C := Get_Parent_Context (C);
end case;
end loop;
end Get_Filename;
end Grt.Rtis_Utils;
span class="o">-1 and sp == -1):
return s.split('=', maxsplit)
else:
return s.split(None, maxsplit)
def grub_exact_split(s, num):
ret = grub_split(s, num - 1)
if len(ret) < num:
return ret + [""] * (num - len(ret))
return ret
def get_path(s):
"""Returns a tuple of (GrubDiskPart, path) corresponding to string."""
if not s.startswith('('):
return (None, s)
idx = s.find(')')
if idx == -1:
raise ValueError, "Unable to find matching ')'"
d = s[:idx]
return (GrubDiskPart(d), s[idx + 1:])
class GrubDiskPart(object):
def __init__(self, str):
if str.find(',') != -1:
(self.disk, self.part) = str.split(",", 2)
else:
self.disk = str
self.part = None
def __repr__(self):
if self.part is not None:
return "d%dp%d" %(self.disk, self.part)
else:
return "d%d" %(self.disk,)
def get_disk(self):
return self._disk
def set_disk(self, val):
val = val.replace("(", "").replace(")", "")
self._disk = int(val[2:])
disk = property(get_disk, set_disk)
def get_part(self):
return self._part
def set_part(self, val):
if val is None:
self._part = val
return
val = val.replace("(", "").replace(")", "")
if val[:5] == "msdos":
val = val[5:]
if val[:3] == "gpt":
val = val[3:]
self._part = int(val)
part = property(get_part, set_part)
class _GrubImage(object):
def __init__(self, title, lines):
self.reset(lines)
self.title = title.strip()
def __repr__(self):
return ("title: %s\n"
" root: %s\n"
" kernel: %s\n"
" args: %s\n"
" initrd: %s\n" %(self.title, self.root, self.kernel,
self.args, self.initrd))
def _parse(self, lines):
map(self.set_from_line, lines)
def reset(self, lines):
self._root = self._initrd = self._kernel = self._args = None
self.lines = []
self._parse(lines)
def set_root(self, val):
self._root = GrubDiskPart(val)
def get_root(self):
return self._root
root = property(get_root, set_root)
def set_kernel(self, val):
if val.find(" ") == -1:
self._kernel = get_path(val)
self._args = None
return
(kernel, args) = val.split(None, 1)
self._kernel = get_path(kernel)
self._args = args
def get_kernel(self):
return self._kernel
def get_args(self):
return self._args
kernel = property(get_kernel, set_kernel)
args = property(get_args)
def set_initrd(self, val):
self._initrd = get_path(val)
def get_initrd(self):
return self._initrd
initrd = property(get_initrd, set_initrd)
class GrubImage(_GrubImage):
def __init__(self, title, lines):
_GrubImage.__init__(self, title, lines)
def set_from_line(self, line, replace = None):
(com, arg) = grub_exact_split(line, 2)
if self.commands.has_key(com):
if self.commands[com] is not None:
setattr(self, self.commands[com], arg.strip())
else:
logging.info("Ignored image directive %s" %(com,))
else:
logging.warning("Unknown image directive %s" %(com,))
# now put the line in the list of lines
if replace is None:
self.lines.append(line)
else:
self.lines.pop(replace)
self.lines.insert(replace, line)
# set up command handlers
commands = { "root": "root",
"rootnoverify": "root",
"kernel": "kernel",
"initrd": "initrd",
"chainloader": None,
"module": None}
class _GrubConfigFile(object):
def __init__(self, fn = None):
self.filename = fn
self.images = []
self.timeout = -1
self._default = 0
self.passwordAccess = True
self.passExc = None
if fn is not None:
self.parse()
def parse(self, buf = None):
raise RuntimeError, "unimplemented parse function"
def hasPasswordAccess(self):
return self.passwordAccess
def setPasswordAccess(self, val):
self.passwordAccess = val
def hasPassword(self):
return hasattr(self, 'password')
def checkPassword(self, password):
# Always allow if no password defined in grub.conf
if not self.hasPassword():
return True
pwd = getattr(self, 'password').split()
# We check whether password is in MD5 hash for comparison
if pwd[0] == '--md5':
try:
import crypt
if crypt.crypt(password, pwd[1]) == pwd[1]:
return True
except Exception, e:
self.passExc = "Can't verify password: %s" % str(e)
return False
# ... and if not, we compare it as a plain text
if pwd[0] == password:
return True
return False
def set(self, line):
(com, arg) = grub_exact_split(line, 2)
if self.commands.has_key(com):
if self.commands[com] is not None:
setattr(self, self.commands[com], arg.strip())
else:
logging.info("Ignored directive %s" %(com,))
else:
logging.warning("Unknown directive %s" %(com,))
def add_image(self, image):
self.images.append(image)
def _get_default(self):
return self._default
def _set_default(self, val):
if val == "saved":
self._default = 0
else:
self._default = int(val)
if self._default < 0:
raise ValueError, "default must be positive number"
default = property(_get_default, _set_default)
def set_splash(self, val):
self._splash = get_path(val)
def get_splash(self):
return self._splash
splash = property(get_splash, set_splash)
# set up command handlers
commands = { "default": "default",
"timeout": "timeout",
"fallback": "fallback",
"hiddenmenu": "hiddenmenu",
"splashimage": "splash",
"password": "password" }
for c in ("bootp", "color", "device", "dhcp", "hide", "ifconfig",
"pager", "partnew", "parttype", "rarp", "serial",
"setkey", "terminal", "terminfo", "tftpserver", "unhide"):
commands[c] = None
del c
class GrubConfigFile(_GrubConfigFile):
def __init__(self, fn = None):
_GrubConfigFile.__init__(self,fn)
def new_image(self, title, lines):
return GrubImage(title, lines)
def parse(self, buf = None):
if buf is None:
if self.filename is None:
raise ValueError, "No config file defined to parse!"
f = open(self.filename, 'r')
lines = f.readlines()
f.close()
else:
lines = buf.split("\n")
img = None
title = ""
for l in lines:
l = l.strip()
# skip blank lines
if len(l) == 0:
continue
# skip comments
if l.startswith('#'):
continue
# new image
if l.startswith("title"):
if img is not None:
self.add_image(GrubImage(title, img))
img = []
title = l[6:]
continue
if img is not None:
img.append(l)
continue
(com, arg) = grub_exact_split(l, 2)
if self.commands.has_key(com):
if self.commands[com] is not None:
setattr(self, self.commands[com], arg.strip())
else:
logging.info("Ignored directive %s" %(com,))
else:
logging.warning("Unknown directive %s" %(com,))
if img:
self.add_image(GrubImage(title, img))
if self.hasPassword():
self.setPasswordAccess(False)
def grub2_handle_set(arg):
(com,arg) = grub_split(arg,2)
com="set:" + com
m = re.match("([\"\'])(.*)\\1", arg)
if m is not None:
arg=m.group(2)
return (com,arg)
class Grub2Image(_GrubImage):
def __init__(self, title, lines):
_GrubImage.__init__(self, title, lines)
def set_from_line(self, line, replace = None):
(com, arg) = grub_exact_split(line, 2)
if com == "set":
(com,arg) = grub2_handle_set(arg)
if self.commands.has_key(com):
if self.commands[com] is not None:
setattr(self, self.commands[com], arg.strip())
else:
logging.info("Ignored image directive %s" %(com,))
elif com.startswith('set:'):
pass
else:
logging.warning("Unknown image directive %s" %(com,))
# now put the line in the list of lines
if replace is None:
self.lines.append(line)
else:
self.lines.pop(replace)
self.lines.insert(replace, line)
commands = {'set:root': 'root',
'linux': 'kernel',
'initrd': 'initrd',
'echo': None,
'insmod': None,
'search': None}
class Grub2ConfigFile(_GrubConfigFile):
def __init__(self, fn = None):
_GrubConfigFile.__init__(self, fn)
def new_image(self, title, lines):
return Grub2Image(title, lines)
def parse(self, buf = None):
if buf is None:
if self.filename is None:
raise ValueError, "No config file defined to parse!"
f = open(self.filename, 'r')
lines = f.readlines()
f.close()
else:
lines = buf.split("\n")
in_function = False
img = None
title = ""
menu_level=0
for l in lines:
l = l.strip()
# skip blank lines
if len(l) == 0:
continue
# skip comments
if l.startswith('#'):
continue
# skip function declarations
if l.startswith('function'):
in_function = True
continue
if in_function:
if l.startswith('}'):
in_function = False
continue
# new image
title_match = re.match('^menuentry ["\'](.*)["\'] (.*){', l)
if title_match:
if img is not None: