summaryrefslogtreecommitdiff
path: root/src/vhdl/translate
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl/translate')
-rw-r--r--src/vhdl/translate/trans-chap3.adb85
-rw-r--r--src/vhdl/translate/trans-chap7.adb3
-rw-r--r--src/vhdl/translate/trans.adb45
-rw-r--r--src/vhdl/translate/trans.ads39
4 files changed, 53 insertions, 119 deletions
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 9fd88f7..4ea3312 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -136,11 +136,9 @@ package body Trans.Chap3 is
Finish_Subprogram_Decl (Interface_List, Info.C (Kind).Builder_Func);
end Create_Builder_Subprogram_Decl;
- function Gen_Call_Type_Builder (Var_Ptr : O_Dnode;
- Var_Type : Iir;
- Kind : Object_Kind_Type)
- return O_Enode
+ function Gen_Call_Type_Builder (Var : Mnode; Var_Type : Iir) return O_Enode
is
+ Kind : constant Object_Kind_Type := Get_Object_Kind (Var);
Tinfo : constant Type_Info_Acc := Get_Info (Var_Type);
Binfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Var_Type));
Assoc : O_Assoc_List;
@@ -153,30 +151,17 @@ package body Trans.Chap3 is
case Tinfo.Type_Mode is
when Type_Mode_Record
| Type_Mode_Array =>
- New_Association (Assoc, New_Obj_Value (Var_Ptr));
+ New_Association (Assoc, M2Addr (Var));
when Type_Mode_Fat_Array =>
-- Note: a fat array can only be at the top of a complex type;
-- the bounds must have been set.
- New_Association
- (Assoc, New_Value_Selected_Acc_Value
- (New_Obj (Var_Ptr), Tinfo.T.Base_Field (Kind)));
+ New_Association (Assoc, M2Addr (Chap3.Get_Array_Base (Var)));
when others =>
raise Internal_Error;
end case;
if Tinfo.Type_Mode in Type_Mode_Arrays then
- declare
- Arr : Mnode;
- begin
- case Type_Mode_Arrays (Tinfo.Type_Mode) is
- when Type_Mode_Array =>
- Arr := T2M (Var_Type, Kind);
- when Type_Mode_Fat_Array =>
- Arr := Dp2M (Var_Ptr, Tinfo, Kind);
- end case;
- New_Association
- (Assoc, M2Addr (Chap3.Get_Array_Bounds (Arr)));
- end;
+ New_Association (Assoc, M2Addr (Chap3.Get_Array_Bounds (Var)));
end if;
return New_Function_Call (Assoc);
@@ -190,9 +175,7 @@ package body Trans.Chap3 is
Open_Temp;
V := Stabilize (Var);
Mem := Create_Temp (Ghdl_Index_Type);
- New_Assign_Stmt
- (New_Obj (Mem),
- Gen_Call_Type_Builder (M2Dp (V), Var_Type, Get_Object_Kind (Var)));
+ New_Assign_Stmt (New_Obj (Mem), Gen_Call_Type_Builder (V, Var_Type));
Close_Temp;
end Gen_Call_Type_Builder;
@@ -858,9 +841,8 @@ package body Trans.Chap3 is
Index : Iir;
Targ : Mnode;
begin
- Targ := Lv2M (Target, null, Mode_Value, True,
- Baseinfo.T.Bounds_Type,
- Baseinfo.T.Bounds_Ptr_Type);
+ Targ := Lv2M (Target, null, Mode_Value,
+ Baseinfo.T.Bounds_Type, Baseinfo.T.Bounds_Ptr_Type);
Open_Temp;
if Get_Nbr_Elements (Indexes_List) > 1 then
Targ := Stabilize (Targ);
@@ -907,8 +889,7 @@ package body Trans.Chap3 is
end Get_Array_Bounds_Staticness;
-- Create a variable containing the bounds for array subtype DEF.
- procedure Create_Array_Subtype_Bounds_Var
- (Def : Iir; Elab_Now : Boolean)
+ procedure Create_Array_Subtype_Bounds_Var (Def : Iir; Elab_Now : Boolean)
is
Info : constant Type_Info_Acc := Get_Info (Def);
Base_Info : Type_Info_Acc;
@@ -992,27 +973,26 @@ package body Trans.Chap3 is
-- Set each index of the array.
Init_Var (Var_Off);
Start_Loop_Stmt (Label);
- Gen_Exit_When (Label,
- New_Compare_Op (ON_Eq,
- New_Obj_Value (Var_Off),
- New_Obj_Value (Var_Length),
- Ghdl_Bool_Type));
+ Gen_Exit_When (Label, New_Compare_Op (ON_Eq,
+ New_Obj_Value (Var_Off),
+ New_Obj_Value (Var_Length),
+ Ghdl_Bool_Type));
New_Assign_Stmt
(New_Obj (Var_Mem),
New_Unchecked_Address
(New_Slice (New_Access_Element
- (New_Convert_Ov (New_Obj_Value (Base),
- Char_Ptr_Type)),
- Chararray_Type,
- New_Obj_Value (Var_Off)),
+ (New_Convert_Ov (New_Obj_Value (Base),
+ Char_Ptr_Type)),
+ Chararray_Type,
+ New_Obj_Value (Var_Off)),
Info.T.Base_Ptr_Type (Kind)));
New_Assign_Stmt
(New_Obj (Var_Off),
New_Dyadic_Op (ON_Add_Ov,
New_Obj_Value (Var_Off),
- Gen_Call_Type_Builder (Var_Mem, El_Type, Kind)));
+ Gen_Call_Type_Builder (Dp2M (Var_Mem, El_Info, Kind), El_Type)));
Finish_Loop_Stmt (Label);
New_Return_Stmt (New_Obj_Value (Var_Off));
@@ -1175,8 +1155,7 @@ package body Trans.Chap3 is
-- OFF = SIZEOF (record).
New_Assign_Stmt
(New_Obj (Off_Var),
- New_Lit (New_Sizeof (Info.Ortho_Type (Kind),
- Ghdl_Index_Type)));
+ New_Lit (New_Sizeof (Info.Ortho_Type (Kind), Ghdl_Index_Type)));
-- Set memory for each complex element.
List := Get_Elements_Declaration_List (Def);
@@ -1219,9 +1198,9 @@ package body Trans.Chap3 is
New_Assign_Stmt
(New_Obj (Off_Var),
New_Dyadic_Op (ON_Add_Ov,
- New_Obj_Value (Off_Var),
- Gen_Call_Type_Builder
- (Ptr_Var, El_Type, Kind)));
+ New_Obj_Value (Off_Var),
+ Gen_Call_Type_Builder
+ (Dp2M (Ptr_Var, El_Tinfo, Kind), El_Type)));
Finish_Declare_Stmt;
else
@@ -1243,6 +1222,7 @@ package body Trans.Chap3 is
--------------
-- Access --
--------------
+
procedure Translate_Access_Type (Def : Iir_Access_Type_Definition)
is
D_Type : constant Iir := Get_Designated_Type (Def);
@@ -2362,11 +2342,9 @@ package body Trans.Chap3 is
Get_Info (Get_Base_Type (Index_Type));
begin
return Lv2M (New_Selected_Element (M2Lv (B),
- Base_Index_Info.Index_Field),
- Iinfo,
- Get_Object_Kind (B),
- Iinfo.T.Range_Type,
- Iinfo.T.Range_Ptr_Type);
+ Base_Index_Info.Index_Field),
+ Iinfo, Mode_Value,
+ Iinfo.T.Range_Type, Iinfo.T.Range_Ptr_Type);
end Bounds_To_Range;
function Type_To_Range (Atype : Iir) return Mnode
@@ -2607,7 +2585,7 @@ package body Trans.Chap3 is
return Lv2M (New_Slice (M2Lv (Base),
T_Info.T.Base_Type (Kind),
Index),
- T_Info, Kind, False,
+ T_Info, Kind,
T_Info.T.Base_Type (Kind),
T_Info.T.Base_Ptr_Type (Kind));
end if;
@@ -2766,11 +2744,10 @@ package body Trans.Chap3 is
else
New_Assign_Stmt
(M2Lp (Res),
- Gen_Alloc
- (Alloc_Kind,
- Chap3.Get_Object_Size (T2M (Obj_Type, Kind),
- Obj_Type),
- Dinfo.Ortho_Ptr_Type (Kind)));
+ Gen_Alloc (Alloc_Kind,
+ Chap3.Get_Object_Size (T2M (Obj_Type, Kind),
+ Obj_Type),
+ Dinfo.Ortho_Ptr_Type (Kind)));
if Is_Complex_Type (Dinfo)
and then Dinfo.C (Kind).Builder_Need_Func
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index b3dfced..6c0ec50 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -4294,8 +4294,7 @@ package body Trans.Chap7 is
begin
Open_Temp;
Arange1 := Stabilize (Lv2M (Arange, Rinfo, Mode_Value,
- Rinfo.T.Range_Type,
- Rinfo.T.Range_Ptr_Type));
+ Rinfo.T.Range_Type, Rinfo.T.Range_Ptr_Type));
Res1 := Stabilize (Res);
New_Assign_Stmt (M2Lv (Chap3.Range_To_Left (Res1)),
M2E (Chap3.Range_To_Right (Arange1)));
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index 82e34ae..a2f0a89 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -1083,25 +1083,22 @@ package body Trans is
begin
case M.M1.State is
when Mstate_E =>
- if M.M1.Is_Composite then
+ if Is_Composite (M.M1.T) then
-- Create a pointer variable.
D := Create_Temp_Init (M.M1.Ptype, M.M1.E);
return Mnode'(M1 => (State => Mstate_Dp,
- Is_Composite => True,
K => K, T => M.M1.T, Dp => D,
Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
else
-- Create a scalar variable.
D := Create_Temp_Init (M.M1.Vtype, M.M1.E);
return Mnode'(M1 => (State => Mstate_Dv,
- Is_Composite => False,
K => K, T => M.M1.T, Dv => D,
Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
end if;
when Mstate_Lp =>
D := Create_Temp_Init (M.M1.Ptype, New_Value (M.M1.Lp));
return Mnode'(M1 => (State => Mstate_Dp,
- Is_Composite => M.M1.Is_Composite,
K => K, T => M.M1.T, Dp => D,
Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
when Mstate_Lv =>
@@ -1111,14 +1108,12 @@ package body Trans is
end if;
D := Create_Temp_Init (M.M1.Vtype, New_Value (M.M1.Lv));
return Mnode'(M1 => (State => Mstate_Dv,
- Is_Composite => M.M1.Is_Composite,
K => K, T => M.M1.T, Dv => D,
Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
else
D := Create_Temp_Ptr (M.M1.Ptype, M.M1.Lv);
return Mnode'(M1 => (State => Mstate_Dp,
- Is_Composite => M.M1.Is_Composite,
K => K, T => M.M1.T, Dp => D,
Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
end if;
@@ -1142,9 +1137,7 @@ package body Trans is
E : O_Enode;
begin
-- M must be scalar or access.
- if M.M1.Is_Composite then
- raise Internal_Error;
- end if;
+ pragma Assert (not Is_Composite (M.M1.T));
case M.M1.State is
when Mstate_E =>
E := M.M1.E;
@@ -1162,7 +1155,6 @@ package body Trans is
D := Create_Temp_Init (M.M1.Vtype, E);
return Mnode'(M1 => (State => Mstate_Dv,
- Is_Composite => M.M1.Is_Composite,
K => M.M1.K, T => M.M1.T, Dv => D,
Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
end Stabilize_Value;
@@ -1378,7 +1370,6 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_E,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, E => E,
Vtype => T.Ortho_Type (Kind),
Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1388,7 +1379,6 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Lv,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Lv => L,
Vtype => T.Ortho_Type (Kind),
Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1397,13 +1387,11 @@ package body Trans is
function Lv2M (L : O_Lnode;
T : Type_Info_Acc;
Kind : Object_Kind_Type;
- Comp : Boolean;
Vtype : O_Tnode;
Ptype : O_Tnode)
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Lv,
- Is_Composite => Comp,
K => Kind, T => T, Lv => L,
Vtype => Vtype, Ptype => Ptype));
end Lv2M;
@@ -1412,7 +1400,6 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Lp,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Lp => L,
Vtype => T.Ortho_Type (Kind),
Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1426,31 +1413,16 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Lp,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Lp => L,
Vtype => Vtype, Ptype => Ptype));
end Lp2M;
- function Lv2M (L : O_Lnode;
- T : Type_Info_Acc;
- Kind : Object_Kind_Type;
- Vtype : O_Tnode;
- Ptype : O_Tnode)
- return Mnode is
- begin
- return Mnode'(M1 => (State => Mstate_Lv,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
- K => Kind, T => T, Lv => L,
- Vtype => Vtype, Ptype => Ptype));
- end Lv2M;
-
function Dv2M (D : O_Dnode;
T : Type_Info_Acc;
Kind : Object_Kind_Type)
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Dv,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Dv => D,
Vtype => T.Ortho_Type (Kind),
Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1464,7 +1436,6 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Dv,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Dv => D,
Vtype => Vtype,
Ptype => Ptype));
@@ -1478,7 +1449,6 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Dp,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Dp => D,
Vtype => Vtype, Ptype => Ptype));
end Dp2M;
@@ -1489,7 +1459,6 @@ package body Trans is
return Mnode is
begin
return Mnode'(M1 => (State => Mstate_Dp,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T, Dp => D,
Vtype => T.Ortho_Type (Kind),
Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1578,7 +1547,6 @@ package body Trans is
begin
T := Get_Info (Atype);
return Mnode'(M1 => (State => Mstate_Null,
- Is_Composite => T.Type_Mode in Type_Mode_Fat,
K => Kind, T => T,
Vtype => T.Ortho_Type (Kind),
Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1643,11 +1611,10 @@ package body Trans is
when Mstate_Dv =>
return New_Address (New_Obj (M.M1.Dv), M.M1.Ptype);
when Mstate_E =>
- if M.M1.Is_Composite then
- return M.M1.E;
- else
- raise Internal_Error;
- end if;
+ -- For scalar, M contains the value so there is no lvalue from
+ -- which the address can be taken.
+ pragma Assert (Is_Composite (M.M1.T));
+ return M.M1.E;
when Mstate_Bad
| Mstate_Null =>
raise Internal_Error;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 7156a48..656bf9a 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1459,9 +1459,6 @@ package Trans is
Mstate_Bad);
type Mnode1 (State : Mstate := Mstate_Bad) is record
- -- True if the object is composite (its value cannot be read directly).
- Is_Composite : Boolean;
-
-- Additionnal informations about the objects: kind and type.
K : Object_Kind_Type;
T : Type_Info_Acc;
@@ -1496,7 +1493,6 @@ package Trans is
-- Null Mnode.
Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null,
- Is_Composite => False,
K => Mode_Value,
Ptype => O_Tnode_Null,
Vtype => O_Tnode_Null,
@@ -1530,30 +1526,24 @@ package Trans is
function Get_Type_Info (M : Mnode) return Type_Info_Acc;
pragma Inline (Get_Type_Info);
+ -- Creation of Mnodes.
+
function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type)
return Mnode;
- function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
- return Mnode;
-
+ -- From a Lnode, general form (can be used for ranges, bounds, base...)
function Lv2M (L : O_Lnode;
T : Type_Info_Acc;
Kind : Object_Kind_Type;
- Comp : Boolean;
Vtype : O_Tnode;
Ptype : O_Tnode)
return Mnode;
- function Lv2M (L : O_Lnode;
- T : Type_Info_Acc;
- Kind : Object_Kind_Type;
- Vtype : O_Tnode;
- Ptype : O_Tnode)
- return Mnode;
-
- function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+ -- From a Lnode, only for values.
+ function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
return Mnode;
+ -- From a Lnode that designates a pointer, general form.
function Lp2M (L : O_Lnode;
T : Type_Info_Acc;
Kind : Object_Kind_Type;
@@ -1561,9 +1551,11 @@ package Trans is
Ptype : O_Tnode)
return Mnode;
- function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+ -- From a Lnode that designates a pointer to a value.
+ function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
return Mnode;
+ -- From a variable declaration, general form.
function Dv2M (D : O_Dnode;
T : Type_Info_Acc;
Kind : Object_Kind_Type;
@@ -1571,6 +1563,11 @@ package Trans is
Ptype : O_Tnode)
return Mnode;
+ -- From a variable for a value.
+ function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+ return Mnode;
+
+ -- From a pointer variable, general form.
function Dp2M (D : O_Dnode;
T : Type_Info_Acc;
Kind : Object_Kind_Type;
@@ -1578,6 +1575,7 @@ package Trans is
Ptype : O_Tnode)
return Mnode;
+ -- From a pointer to a value variable.
function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
return Mnode;
@@ -1602,13 +1600,6 @@ package Trans is
function Is_Stable (M : Mnode) return Boolean;
- -- function Varv2M
- -- (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
- -- return Mnode is
- -- begin
- -- return Lv2M (Get_Var (Var), Vtype, Mode);
- -- end Varv2M;
-
function Varv2M (Var : Var_Type;
Var_Type : Type_Info_Acc;
Mode : Object_Kind_Type;
generated by cgit (git 2.34.1) at 2024-12-20 20:20:10 +0000