summaryrefslogtreecommitdiff
path: root/translate/translation.adb
diff options
context:
space:
mode:
Diffstat (limited to 'translate/translation.adb')
-rw-r--r--translate/translation.adb260
1 files changed, 110 insertions, 150 deletions
diff --git a/translate/translation.adb b/translate/translation.adb
index 17c80f9..0eac1d0 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -237,13 +237,6 @@ package body Translation is
-- Scopes must be poped in the reverse order they are pushed.
procedure Pop_Scope (Scope_Type : O_Tnode);
- -- Same as Push_Scope/Pop_Scope, but act only if SCOPE_TYPE is not
- -- null.
- procedure Push_Scope_Soft (Scope_Type : O_Tnode; Scope_Param : O_Dnode);
- procedure Pop_Scope_Soft (Scope_Type : O_Tnode);
- pragma Inline (Push_Scope_Soft);
- pragma Inline (Pop_Scope_Soft);
-
-- Reset the identifier.
type Id_Mark_Type is limited private;
type Local_Identifier_Type is limited private;
@@ -1793,7 +1786,7 @@ package body Translation is
-- Return TRUE if base type of ATYPE is larger than its bounds, ie
-- if a value of type ATYPE may be out of range.
- function Need_Range_Check (Atype : Iir) return Boolean;
+ function Need_Range_Check (Expr : Iir; Atype : Iir) return Boolean;
-- Generate an error if VALUE (computed from EXPR which may be NULL_IIR
-- if not from a tree) is not in range specified by ATYPE.
@@ -1992,13 +1985,21 @@ package body Translation is
-- its location.
procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural);
- -- Get the offset in the range pointed by RANGE_PTR of INDEX.
+ -- Get the deepest range_expression of ATYPE.
+ -- This follows 'range and 'reverse_range.
+ -- Set IS_REVERSE to true if the range must be reversed.
+ procedure Get_Deep_Range_Expression
+ (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean);
+
+ -- Get the offset of INDEX in the range RNG.
-- This checks INDEX belongs to the range.
- -- INDEX_TYPE is the subtype of the array index.
+ -- RANGE_TYPE is the subtype of the array index (or the subtype of RNG).
+ -- For unconstrained ranges, INDEX_EXPR must be NULL_IIR and RANGE_TYPE
+ -- must be set.
function Translate_Index_To_Offset (Rng : Mnode;
Index : O_Enode;
Index_Expr : Iir;
- Index_Type : Iir;
+ Range_Type : Iir;
Loc : Iir)
return O_Enode;
end Chap6;
@@ -2258,6 +2259,12 @@ package body Translation is
-- Close the temporary region.
procedure Close_Temp;
+ -- Return TRUE if stack2 will be released. Used for fine-tuning only
+ -- (return statement).
+ function Has_Stack2_Mark return Boolean;
+ -- Manually release stack2. Used for fine-tuning only.
+ procedure Stack2_Release;
+
-- Check there is no temporary region.
procedure Check_No_Temp;
@@ -3149,10 +3156,27 @@ package body Translation is
Temp_Level.Transient_Types := Atype;
end Add_Transient_Type_In_Temp;
+ function Has_Stack2_Mark return Boolean is
+ begin
+ return Temp_Level.Stack2_Mark /= O_Dnode_Null;
+ end Has_Stack2_Mark;
+
+ procedure Stack2_Release
+ is
+ Constr : O_Assoc_List;
+ begin
+ if Temp_Level.Stack2_Mark /= O_Dnode_Null then
+ Start_Association (Constr, Ghdl_Stack2_Release);
+ New_Association (Constr,
+ New_Value (New_Obj (Temp_Level.Stack2_Mark)));
+ New_Procedure_Call (Constr);
+ Temp_Level.Stack2_Mark := O_Dnode_Null;
+ end if;
+ end Stack2_Release;
+
procedure Close_Temp
is
L : Temp_Level_Acc;
- Constr : O_Assoc_List;
begin
if Temp_Level = null then
-- OPEN_TEMP was not called.
@@ -3164,10 +3188,7 @@ package body Translation is
end if;
if Temp_Level.Stack2_Mark /= O_Dnode_Null then
- Start_Association (Constr, Ghdl_Stack2_Release);
- New_Association (Constr,
- New_Value (New_Obj (Temp_Level.Stack2_Mark)));
- New_Procedure_Call (Constr);
+ Stack2_Release;
end if;
if Temp_Level.Emitted then
Finish_Declare_Stmt;
@@ -8373,25 +8394,25 @@ package body Translation is
return New_Obj_Value (Var_Res);
end Not_In_Range;
- function Need_Range_Check (Atype : Iir) return Boolean
+ function Need_Range_Check (Expr : Iir; Atype : Iir) return Boolean
is
Info : Type_Info_Acc;
begin
Info := Get_Info (Atype);
if Info.T.Nocheck_Low and Info.T.Nocheck_Hi then
return False;
- else
- return True;
end if;
+ if Expr /= Null_Iir and then Get_Type (Expr) = Atype then
+ return False;
+ end if;
+ return True;
end Need_Range_Check;
procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir)
is
If_Blk : O_If_Block;
begin
- if not Need_Range_Check (Atype)
- or else (Expr /= Null_Iir and then Get_Type (Expr) = Atype)
- then
+ if not Need_Range_Check (Expr, Atype) then
return;
end if;
@@ -12043,12 +12064,18 @@ package body Translation is
Rng : Iir;
begin
-- Do checks if type of the expression is not a subtype.
- if Expr_Type = Null_Iir -- FIXME: to be removed (generate stmt)
- or else
- Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition
- then
+ -- FIXME: EXPR_TYPE shound not be NULL_IIR (generate stmt)
+ if Expr_Type = Null_Iir then
return True;
end if;
+ case Get_Kind (Expr_Type) is
+ when Iir_Kind_Integer_Subtype_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition
+ | Iir_Kind_Enumeration_Type_Definition =>
+ null;
+ when others =>
+ return True;
+ end case;
-- No check if the expression has the type of the index.
if Expr_Type = Rng_Type then
@@ -12078,9 +12105,15 @@ package body Translation is
-- T is an integer/enumeration subtype.
T := Atype;
loop
- if Get_Kind (T) not in Iir_Kinds_Discrete_Subtype_Definition then
- Error_Kind ("get_deep_range_expression(1)", T);
- end if;
+ case Get_Kind (T) is
+ when Iir_Kind_Integer_Subtype_Definition
+ | Iir_Kind_Enumeration_Subtype_Definition
+ | Iir_Kind_Enumeration_Type_Definition =>
+ -- These types have a range.
+ null;
+ when others =>
+ Error_Kind ("get_deep_range_expression(1)", T);
+ end case;
R := Get_Range_Constraint (T);
case Get_Kind (R) is
@@ -12105,7 +12138,7 @@ package body Translation is
function Translate_Index_To_Offset (Rng : Mnode;
Index : O_Enode;
Index_Expr : Iir;
- Index_Type : Iir;
+ Range_Type : Iir;
Loc : Iir)
return O_Enode
is
@@ -12122,9 +12155,15 @@ package body Translation is
Deep_Rng : Iir;
Deep_Reverse : Boolean;
begin
- Index_Info := Get_Info (Get_Base_Type (Index_Type));
- Need_Check := Need_Index_Check (Get_Type (Index_Expr), Index_Type);
- Get_Deep_Range_Expression (Index_Type, Deep_Rng, Deep_Reverse);
+ Index_Info := Get_Info (Get_Base_Type (Range_Type));
+ if Index_Expr = Null_Iir then
+ Need_Check := True;
+ Deep_Rng := Null_Iir;
+ Deep_Reverse := False;
+ else
+ Need_Check := Need_Index_Check (Get_Type (Index_Expr), Range_Type);
+ Get_Deep_Range_Expression (Range_Type, Deep_Rng, Deep_Reverse);
+ end if;
Res := Create_Temp (Ghdl_Index_Type);
@@ -12199,81 +12238,6 @@ package body Translation is
return New_Obj_Value (Res);
end Translate_Index_To_Offset;
- function Translate_Fat_Index_To_Offset (Rng : Mnode;
- Index : O_Enode;
- Index_Type : Iir;
- Loc : Iir)
- return O_Enode
- is
- Dir : O_Enode;
- If_Blk : O_If_Block;
- Res : O_Dnode;
- Off : O_Dnode;
- Bound : O_Enode;
- Cond1, Cond2: O_Enode;
- Index_Node : O_Dnode;
- Bound_Node : O_Dnode;
- Index_Info : Type_Info_Acc;
- begin
- Index_Info := Get_Info (Get_Base_Type (Index_Type));
-
- Res := Create_Temp (Ghdl_Index_Type);
-
- Open_Temp;
-
- Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
-
- Bound := M2E (Chap3.Range_To_Left (Rng));
-
- Index_Node := Create_Temp_Init
- (Index_Info.Ortho_Type (Mode_Value), Index);
- Bound_Node := Create_Temp_Init
- (Index_Info.Ortho_Type (Mode_Value), Bound);
- Dir := M2E (Chap3.Range_To_Dir (Rng));
-
- -- Non-static direction.
- Start_If_Stmt (If_Blk,
- New_Compare_Op (ON_Eq, Dir,
- New_Lit (Ghdl_Dir_To_Node),
- Ghdl_Bool_Type));
- -- Direction TO: INDEX - LEFT.
- New_Assign_Stmt (New_Obj (Off),
- New_Dyadic_Op (ON_Sub_Ov,
- New_Obj_Value (Index_Node),
- New_Obj_Value (Bound_Node)));
- New_Else_Stmt (If_Blk);
- -- Direction DOWNTO: LEFT - INDEX.
- New_Assign_Stmt (New_Obj (Off),
- New_Dyadic_Op (ON_Sub_Ov,
- New_Obj_Value (Bound_Node),
- New_Obj_Value (Index_Node)));
- Finish_If_Stmt (If_Blk);
-
- -- Get the offset.
- New_Assign_Stmt
- (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off),
- Ghdl_Index_Type));
-
- -- Check bounds.
- Cond1 := New_Compare_Op
- (ON_Lt,
- New_Obj_Value (Off),
- New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
- 0)),
- Ghdl_Bool_Type);
-
- Cond2 := New_Compare_Op
- (ON_Ge,
- New_Obj_Value (Res),
- M2E (Chap3.Range_To_Length (Rng)),
- Ghdl_Bool_Type);
- Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
-
- Close_Temp;
-
- return New_Obj_Value (Res);
- end Translate_Fat_Index_To_Offset;
-
-- Translate index EXPR in dimension DIM of thin array into an
-- offset.
-- This checks bounds.
@@ -12390,10 +12354,10 @@ package body Translation is
when Type_Mode_Fat_Array =>
Range_Ptr := Stabilize
(Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim));
- R := Translate_Fat_Index_To_Offset
+ R := Translate_Index_To_Offset
(Range_Ptr,
Chap7.Translate_Expression (Index, Ibasetype),
- Itype, Index);
+ Null_Iir, Itype, Index);
when Type_Mode_Ptr_Array =>
-- Manually extract range since there is no infos for
-- index subtype.
@@ -14416,7 +14380,7 @@ package body Translation is
T_Info := Get_Info (Target_Type);
case T_Info.Type_Mode is
when Type_Mode_Scalar =>
- if not Chap3.Need_Range_Check (Target_Type) then
+ if not Chap3.Need_Range_Check (Expr, Target_Type) then
New_Assign_Stmt (M2Lv (Target), Val);
else
declare
@@ -17815,14 +17779,23 @@ package body Translation is
-- * if the return type is scalar, simply returns.
declare
V : O_Dnode;
+ R : O_Enode;
begin
- V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value));
- Open_Temp;
- New_Assign_Stmt
- (New_Obj (V), Chap7.Translate_Expression (Expr, Ret_Type));
- Close_Temp;
- Chap3.Check_Range (V, Expr, Ret_Type);
- Gen_Return_Value (New_Obj_Value (V));
+ -- Always uses a temporary in case of the return expression
+ -- uses secondary stack.
+ -- FIXME: don't use the temp if not required.
+ R := Chap7.Translate_Expression (Expr, Ret_Type);
+ if Has_Stack2_Mark
+ or else Chap3.Need_Range_Check (Expr, Ret_Type)
+ then
+ V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value));
+ New_Assign_Stmt (New_Obj (V), R);
+ Stack2_Release;
+ Chap3.Check_Range (V, Expr, Ret_Type);
+ Gen_Return_Value (New_Obj_Value (V));
+ else
+ Gen_Return_Value (R);
+ end if;
end;
when Type_Mode_Acc =>
-- * access: thin and no range.
@@ -18027,8 +18000,6 @@ package body Translation is
Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
Iter_Type_Info.T.Range_Length),
New_Lit (Ghdl_Index_0),
--- New_Lit (New_Signed_Literal
--- (Iter_Type_Info.Ortho_Type (Mode_Value), 0)),
Ghdl_Bool_Type);
end if;
@@ -18059,6 +18030,8 @@ package body Translation is
Iter_Type_Info : Type_Info_Acc;
Var_Iter : Var_Acc;
Constraint : Iir;
+ Deep_Rng : Iir;
+ Deep_Reverse : Boolean;
begin
New_Exit_Stmt (Data.Label_Next);
Finish_Loop_Stmt (Data.Label_Next);
@@ -18083,10 +18056,15 @@ package body Translation is
Cond, Ghdl_Bool_Type));
-- Update the iterator.
- if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
- Gen_Update_Iterator
- (Get_Var_Label (Var_Iter), Get_Direction (Constraint),
- 1, Iter_Base_Type);
+ Chap6.Get_Deep_Range_Expression (Iter_Type, Deep_Rng, Deep_Reverse);
+ if Deep_Rng /= Null_Iir then
+ if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
+ Gen_Update_Iterator
+ (Get_Var_Label (Var_Iter), Iir_To, 1, Iter_Base_Type);
+ else
+ Gen_Update_Iterator
+ (Get_Var_Label (Var_Iter), Iir_Downto, 1, Iter_Base_Type);
+ end if;
else
Start_If_Stmt
(If_Blk1, New_Compare_Op
@@ -18637,7 +18615,8 @@ package body Translation is
Value := Create_Temp (Tinfo.Ortho_Type (Mode_Value));
New_Assign_Stmt
(New_Obj (Value),
- Chap7.Translate_Expression (Get_Actual (Value_Assoc)));
+ Chap7.Translate_Expression (Get_Actual (Value_Assoc),
+ Formal_Type));
New_Association
(Assocs,
New_Unchecked_Address (New_Obj (Value), Ghdl_Ptr_Type));
@@ -19431,7 +19410,7 @@ package body Translation is
when others =>
Error_Kind ("gen_signal_assign_non_composite", Targ_Type);
end case;
- if Chap3.Need_Range_Check (Targ_Type) then
+ if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then
declare
If_Blk : O_If_Block;
Val2 : O_Dnode;
@@ -19554,7 +19533,7 @@ package body Translation is
Error_Kind ("gen_signal_assign_non_composite", Targ_Type);
end case;
-- Check range.
- if Chap3.Need_Range_Check (Targ_Type) then
+ if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then
declare
If_Blk : O_If_Block;
V : Mnode;
@@ -21539,22 +21518,6 @@ package body Translation is
end if;
end Pop_Scope;
- procedure Push_Scope_Soft (Scope_Type : O_Tnode; Scope_Param : O_Dnode)
- is
- begin
- if Scope_Type /= O_Tnode_Null then
- Push_Scope (Scope_Type, Scope_Param);
- end if;
- end Push_Scope_Soft;
-
- procedure Pop_Scope_Soft (Scope_Type : O_Tnode)
- is
- begin
- if Scope_Type /= O_Tnode_Null then
- Pop_Scope (Scope_Type);
- end if;
- end Pop_Scope_Soft;
-
function Create_Global_Var
(Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
return Var_Acc
@@ -22915,26 +22878,20 @@ package body Translation is
Pinfo : Type_Info_Acc;
Subprg : O_Dnode;
Assoc : O_Assoc_List;
- Conv : O_Tnode;
begin
Prefix_Type := Get_Base_Type (Get_Type (Get_Prefix (Attr)));
Pinfo := Get_Info (Prefix_Type);
case Pinfo.Type_Mode is
when Type_Mode_B2 =>
Subprg := Ghdl_Value_B2;
- Conv := Ghdl_Bool_Type;
when Type_Mode_E8 =>
Subprg := Ghdl_Value_E8;
- Conv := Ghdl_I32_Type;
when Type_Mode_I32 =>
Subprg := Ghdl_Value_I32;
- Conv := Ghdl_I32_Type;
when Type_Mode_P64 =>
Subprg := Ghdl_Value_P64;
- Conv := Ghdl_I64_Type;
when Type_Mode_F64 =>
Subprg := Ghdl_Value_F64;
- Conv := Ghdl_Real_Type;
when others =>
raise Internal_Error;
end case;
@@ -22955,7 +22912,8 @@ package body Translation is
when others =>
raise Internal_Error;
end case;
- return New_Convert_Ov (New_Function_Call (Assoc), Conv);
+ return New_Convert_Ov (New_Function_Call (Assoc),
+ Pinfo.Ortho_Type (Mode_Value));
end Translate_Value_Attribute;
-- Current path for name attributes.
@@ -27023,6 +26981,8 @@ package body Translation is
Rtis.Ghdl_Rti_Access);
New_Interface_Decl (Interfaces, Param, Get_Identifier ("addr"),
Ghdl_Ptr_Type);
+ New_Interface_Decl (Interfaces, Param, Get_Identifier ("name"),
+ Ghdl_Str_Len_Ptr_Node);
Finish_Subprogram_Decl (Interfaces, Res);
end Create_Get_Name;
begin
generated by cgit (git 2.34.1) at 2024-12-21 08:08:02 +0000