aboutsummaryrefslogtreecommitdiffstats
path: root/translate/grt
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2014-01-26 07:50:15 +0100
committerTristan Gingold <tgingold@free.fr>2014-01-26 07:50:15 +0100
commitf74185d729e80fb2073375a6c4c39081209e914f (patch)
tree2179dd5f6986120bf05eede09ad10849a4ec6204 /translate/grt
parent2cc6d66e785130bb757bcb73e96cfffdc2c2f0b7 (diff)
downloadghdl-f74185d729e80fb2073375a6c4c39081209e914f.tar.gz
ghdl-f74185d729e80fb2073375a6c4c39081209e914f.tar.bz2
ghdl-f74185d729e80fb2073375a6c4c39081209e914f.zip
Make ghdl_rti_type an address. Remove union from translation.
LLVM preliminary work.
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/grt-avhpi.adb20
-rw-r--r--translate/grt/grt-disp_rti.adb10
-rw-r--r--translate/grt/grt-disp_tree.adb6
-rw-r--r--translate/grt/grt-rtis.ads13
-rw-r--r--translate/grt/grt-rtis_addr.adb34
-rw-r--r--translate/grt/grt-rtis_addr.ads5
-rw-r--r--translate/grt/grt-rtis_utils.adb6
-rw-r--r--translate/grt/grt-signals.adb6
8 files changed, 50 insertions, 50 deletions
diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
index 58b9870e4..8d7dd1b7a 100644
--- a/translate/grt/grt-avhpi.adb
+++ b/translate/grt/grt-avhpi.adb
@@ -182,11 +182,11 @@ package body Grt.Avhpi is
end if;
when Ghdl_Rtik_Subtype_Array =>
if Is_Sig then
- El_Size :=
- To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Sigsize.Off;
+ El_Size := Ghdl_Index_Type
+ (To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Sigsize);
else
- El_Size :=
- To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Valsize.Off;
+ El_Size := Ghdl_Index_Type
+ (To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Valsize);
end if;
when others =>
Internal_Error ("add_index");
@@ -259,7 +259,7 @@ package body Grt.Avhpi is
declare
Base : Address;
begin
- Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc.Off).all;
+ Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc).all;
Base := Base + Iterator.It2 * Nblk.Size;
Res := (Kind => VhpiForGenerateK,
Ctxt => (Base => Base,
@@ -277,20 +277,20 @@ package body Grt.Avhpi is
case Ch.Kind is
when Ghdl_Rtik_Process =>
Res := (Kind => VhpiProcessStmtK,
- Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off,
+ Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc,
Block => Ch));
Error := AvhpiErrorOk;
return;
when Ghdl_Rtik_Block =>
Res := (Kind => VhpiBlockStmtK,
- Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off,
+ Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc,
Block => Ch));
Error := AvhpiErrorOk;
return;
when Ghdl_Rtik_If_Generate =>
Res := (Kind => VhpiIfGenerateK,
Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
- + Nblk.Loc.Off).all,
+ + Nblk.Loc).all,
Block => Ch));
-- Return only if the condition is true.
if Res.Ctxt.Base /= Null_Address then
@@ -300,7 +300,7 @@ package body Grt.Avhpi is
when Ghdl_Rtik_For_Generate =>
Res := (Kind => VhpiForGenerateK,
Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
- + Nblk.Loc.Off).all,
+ + Nblk.Loc).all,
Block => Ch));
Iterator.Max2 := Get_For_Generate_Length (Nblk, Iterator.Ctxt);
Iterator.It2 := 0;
@@ -743,7 +743,7 @@ package body Grt.Avhpi is
Rti := To_Ghdl_Rtin_Block_Acc (Ref.Ctxt.Block).Parent;
Ent := To_Ghdl_Rtin_Block_Acc (Rti);
Res := (Kind => VhpiEntityDeclK,
- Ctxt => (Base => Ref.Ctxt.Base + Ent.Loc.Off,
+ Ctxt => (Base => Ref.Ctxt.Base + Ent.Loc,
Block => Rti));
Error := AvhpiErrorOk;
end;
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index b2010f2ad..67ddc4000 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -430,7 +430,7 @@ package body Grt.Disp_Rti is
procedure Align (A : Ghdl_Index_Type) is
begin
- Bounds := Align (Bounds, A);
+ Bounds := Align (Bounds, Ghdl_Rti_Loc (A));
end Align;
procedure Update (S : Ghdl_Index_Type) is
@@ -602,7 +602,7 @@ package body Grt.Disp_Rti is
| Ghdl_Rtik_Architecture
| Ghdl_Rtik_Block
| Ghdl_Rtik_Process =>
- Nctxt := (Base => Ctxt.Base + Blk.Loc.Off,
+ Nctxt := (Base => Ctxt.Base + Blk.Loc,
Block => To_Ghdl_Rti_Access (Blk));
Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
Nctxt, Indent + 1);
@@ -610,7 +610,7 @@ package body Grt.Disp_Rti is
declare
Length : Ghdl_Index_Type;
begin
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc.Off).all,
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all,
Block => To_Ghdl_Rti_Access (Blk));
Length := Get_For_Generate_Length (Blk, Ctxt);
for I in 1 .. Length loop
@@ -620,7 +620,7 @@ package body Grt.Disp_Rti is
end loop;
end;
when Ghdl_Rtik_If_Generate =>
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc.Off).all,
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all,
Block => To_Ghdl_Rti_Access (Blk));
if Nctxt.Base /= Null_Address then
Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
@@ -705,7 +705,7 @@ package body Grt.Disp_Rti is
Disp_Name (Inst.Name);
New_Line;
- Inst_Addr := Ctxt.Base + Inst.Loc.Off;
+ Inst_Addr := Ctxt.Base + Inst.Loc;
-- Read sub instance.
Inst_Base := To_Addr_Acc (Inst_Addr).all;
diff --git a/translate/grt/grt-disp_tree.adb b/translate/grt/grt-disp_tree.adb
index c72d67b91..9e92c8392 100644
--- a/translate/grt/grt-disp_tree.adb
+++ b/translate/grt/grt-disp_tree.adb
@@ -237,7 +237,7 @@ package body Grt.Disp_Tree is
To_Ghdl_Rtin_Block_Acc (Child);
Nctxt : Rti_Context;
begin
- Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+ Nctxt := (Base => Ctxt.Base + Nblk.Loc,
Block => Child);
Disp_Header (Nctxt, False);
Disp_Sub_Block (Nblk, Nctxt);
@@ -250,7 +250,7 @@ package body Grt.Disp_Tree is
Length : Ghdl_Index_Type;
Old_Child2 : Ghdl_Rti_Access;
begin
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
Block => Child);
Length := Get_For_Generate_Length (Nblk, Ctxt);
Disp_Header (Nctxt, Length > 1);
@@ -276,7 +276,7 @@ package body Grt.Disp_Tree is
To_Ghdl_Rtin_Block_Acc (Child);
Nctxt : Rti_Context;
begin
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
Block => Child);
Disp_Header (Nctxt);
if Nctxt.Base /= Null_Address then
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 01dc7c72e..977c9c194 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -108,15 +108,8 @@ package Grt.Rtis is
type Ghdl_Rti_Array is array (Ghdl_Index_Type) of Ghdl_Rti_Access;
type Ghdl_Rti_Arr_Acc is access Ghdl_Rti_Array;
- type Ghdl_Rti_Loc (Rel : Boolean := False) is record
- case Rel is
- when True =>
- Off : Ghdl_Index_Type;
- when False =>
- Addr : Address;
- end case;
- end record;
- pragma Unchecked_Union (Ghdl_Rti_Loc);
+ subtype Ghdl_Rti_Loc is Integer_Address;
+ Null_Rti_Loc : constant Ghdl_Rti_Loc := 0;
type Ghdl_C_String_Array is array (Ghdl_Index_Type) of Ghdl_C_String;
type Ghdl_C_String_Array_Ptr is access Ghdl_C_String_Array;
@@ -344,7 +337,7 @@ package Grt.Rtis is
Ghdl_Rti_Top : Ghdl_Rtin_Block :=
(Common => (Ghdl_Rtik_Top, 0, 0, 0),
Name => null,
- Loc => (Rel => True, Off => 0),
+ Loc => Null_Rti_Loc,
Parent => null,
Size => 0,
Nbr_Child => 0,
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
index adbedf7f7..f63f47b81 100644
--- a/translate/grt/grt-rtis_addr.adb
+++ b/translate/grt/grt-rtis_addr.adb
@@ -18,24 +18,30 @@
with Grt.Errors; use Grt.Errors;
package body Grt.Rtis_Addr is
+ function "+" (L : Address; R : Ghdl_Rti_Loc) return Address
+ is
+ begin
+ return To_Address (To_Integer (L) + R);
+ end "+";
+
function "+" (L : Address; R : Ghdl_Index_Type) return Address
is
begin
return To_Address (To_Integer (L) + Integer_Address (R));
end "+";
- function "-" (L : Address; R : Ghdl_Index_Type) return Address
+ function "-" (L : Address; R : Ghdl_Rti_Loc) return Address
is
begin
- return To_Address (To_Integer (L) - Integer_Address (R));
+ return To_Address (To_Integer (L) - R);
end "-";
- function Align (L : Address; R : Ghdl_Index_Type) return Address
+ function Align (L : Address; R : Ghdl_Rti_Loc) return Address
is
Nad : Integer_Address;
begin
Nad := To_Integer (L + (R - 1));
- return To_Address (Nad - (Nad mod Integer_Address (R)));
+ return To_Address (Nad - (Nad mod R));
end Align;
function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context
@@ -46,13 +52,13 @@ package body Grt.Rtis_Addr is
case Ctxt.Block.Kind is
when Ghdl_Rtik_Process
| Ghdl_Rtik_Block =>
- return (Base => Ctxt.Base - Blk.Loc.Off,
+ return (Base => Ctxt.Base - Blk.Loc,
Block => Blk.Parent);
when Ghdl_Rtik_Architecture =>
- if Blk.Loc.Off /= 0 then
+ if Blk.Loc /= Null_Rti_Loc then
Internal_Error ("get_parent_context(3)");
end if;
- return (Base => Ctxt.Base + Blk.Loc.Off,
+ return (Base => Ctxt.Base + Blk.Loc,
Block => Blk.Parent);
when Ghdl_Rtik_For_Generate
| Ghdl_Rtik_If_Generate =>
@@ -75,7 +81,7 @@ package body Grt.Rtis_Addr is
exit;
when Ghdl_Rtik_Block =>
Blk1 := To_Ghdl_Rtin_Block_Acc (Parent);
- Nbase := Nbase + Blk1.Loc.Off;
+ Nbase := Nbase + Blk1.Loc;
Parent := Blk1.Parent;
when others =>
Internal_Error ("get_parent_context(2)");
@@ -102,7 +108,7 @@ package body Grt.Rtis_Addr is
else
Stmt := Link.Parent.Stmt;
Obj := To_Ghdl_Rtin_Instance_Acc (Stmt);
- Ctxt := (Base => Link.Parent.all'Address - Obj.Loc.Off,
+ Ctxt := (Base => Link.Parent.all'Address - Obj.Loc,
Block => Obj.Parent);
end if;
end Get_Instance_Link;
@@ -116,10 +122,10 @@ package body Grt.Rtis_Addr is
Nctxt : Rti_Context;
begin
if Depth = 0 then
- return Loc.Addr;
+ return To_Address (Loc);
elsif Ctxt.Block.Depth = Depth then
--Addr := Base + Storage_Offset (Obj.Loc.Off);
- return Ctxt.Base + Loc.Off;
+ return Ctxt.Base + Loc;
else
if Ctxt.Block.Depth < Depth then
Internal_Error ("loc_to_addr");
@@ -128,7 +134,7 @@ package body Grt.Rtis_Addr is
loop
Nctxt := Get_Parent_Context (Cur_Ctxt);
if Nctxt.Block.Depth = Depth then
- return Nctxt.Base + Loc.Off;
+ return Nctxt.Base + Loc;
end if;
Cur_Ctxt := Nctxt;
end loop;
@@ -178,7 +184,7 @@ package body Grt.Rtis_Addr is
Inst_Base : Address;
begin
-- Address of the field containing the address of the instance.
- Inst_Addr := Ctxt.Base + Inst.Loc.Off;
+ Inst_Addr := Ctxt.Base + Inst.Loc;
-- Read sub instance address.
Inst_Base := To_Addr_Acc (Inst_Addr).all;
-- Read instance RTI.
@@ -198,7 +204,7 @@ package body Grt.Rtis_Addr is
procedure Align (A : Ghdl_Index_Type) is
begin
- Bounds := Align (Bounds, A);
+ Bounds := Align (Bounds, Ghdl_Rti_Loc (A));
end Align;
procedure Update (S : Ghdl_Index_Type) is
diff --git a/translate/grt/grt-rtis_addr.ads b/translate/grt/grt-rtis_addr.ads
index 8f79126f1..b4e4b5fbb 100644
--- a/translate/grt/grt-rtis_addr.ads
+++ b/translate/grt/grt-rtis_addr.ads
@@ -22,11 +22,12 @@ with Grt.Rtis; use Grt.Rtis;
-- Addresses handling.
package Grt.Rtis_Addr is
+ function "+" (L : Address; R : Ghdl_Rti_Loc) return Address;
function "+" (L : Address; R : Ghdl_Index_Type) return Address;
- function "-" (L : Address; R : Ghdl_Index_Type) return Address;
+ function "-" (L : Address; R : Ghdl_Rti_Loc) return Address;
- function Align (L : Address; R : Ghdl_Index_Type) return Address;
+ function Align (L : Address; R : Ghdl_Rti_Loc) return Address;
-- An RTI context contains a pointer (BASE) to or into an instance.
-- BLOCK describes data being pointed. If a reference is made to a field
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
index 1c526c360..403e40473 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -50,7 +50,7 @@ package body Grt.Rtis_Utils is
Nblk : Ghdl_Rtin_Block_Acc;
begin
Nblk := To_Ghdl_Rtin_Block_Acc (Child);
- Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+ Nctxt := (Base => Ctxt.Base + Nblk.Loc,
Block => Child);
Res := Traverse_Blocks_1 (Nctxt);
end;
@@ -61,7 +61,7 @@ package body Grt.Rtis_Utils is
begin
Nblk := To_Ghdl_Rtin_Block_Acc (Child);
Nctxt :=
- (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+ (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
Block => Child);
Length := Get_For_Generate_Length (Nblk, Ctxt);
for I in 1 .. Length loop
@@ -76,7 +76,7 @@ package body Grt.Rtis_Utils is
begin
Nblk := To_Ghdl_Rtin_Block_Acc (Child);
Nctxt :=
- (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+ (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
Block => Child);
if Nctxt.Base /= Null_Address then
Res := Traverse_Blocks_1 (Nctxt);
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 3ea693daf..67aa5fd43 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -1290,7 +1290,7 @@ package body Grt.Signals is
Mode => Ghdl_Rti_Signal_Mode_None,
Max_Depth => 0),
Name => null,
- Loc => (Rel => True, Off => 0),
+ Loc => Null_Rti_Loc,
Obj_Type => null);
Boolean_Signal_Rti : aliased Ghdl_Rtin_Object :=
@@ -1299,7 +1299,7 @@ package body Grt.Signals is
Mode => Ghdl_Rti_Signal_Mode_None,
Max_Depth => 0),
Name => null,
- Loc => (Rel => True, Off => 0),
+ Loc => Null_Rti_Loc,
Obj_Type => null);
function Ghdl_Create_Signal_Attribute
@@ -1380,7 +1380,7 @@ package body Grt.Signals is
Mode => Ghdl_Rti_Signal_Mode_None,
Max_Depth => 0),
Name => null,
- Loc => (Rel => True, Off => 0),
+ Loc => Null_Rti_Loc,
Obj_Type => Std_Standard_Boolean_RTI_Ptr);
function Ghdl_Signal_Create_Guard (This : System.Address;