Skip to content

Commit 154dac8

Browse files
Petr BauchPetr Bauch
Petr Bauch
authored and
Petr Bauch
committed
Fix non-termination issues
Not quite there yet but enough for the test-case.
1 parent e25a0cb commit 154dac8

File tree

5 files changed

+188
-156
lines changed

5 files changed

+188
-156
lines changed

‎gnat2goto/driver/tree_walk.adb

Lines changed: 182 additions & 125 deletions
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ package body Tree_Walk is
5959
function Do_Assignment_Statement (N : Node_Id) return Irep
6060
with Pre => Nkind (N) = N_Assignment_Statement,
6161
Post => Kind (Do_Assignment_Statement'Result) in
62-
I_Code_Assign;
62+
I_Code_Assign | I_Code_Block;
6363

6464
function Do_Bare_Range_Constraint (Range_Expr : Node_Id; Underlying : Irep)
6565
return Irep
@@ -790,6 +790,8 @@ package body Tree_Walk is
790790
Make_Pointer_Type (Do_Type_Reference (LHS_Element_Type));
791791
RHS_Data_Type : constant Irep :=
792792
Make_Pointer_Type (Do_Type_Reference (RHS_Element_Type));
793+
LHS_fun_call : constant Irep :=
794+
Fresh_Var_Symbol_Expr (LHS_Data_Type, "copy_fun_lhs");
793795
begin
794796
if not Can_Get_Array_Index_Type (Name (N)) then
795797
Report_Unhandled_Node_Empty (N, "Do_Array_Assignment",
@@ -803,6 +805,7 @@ package body Tree_Walk is
803805
end if;
804806
LHS_Idx_Type := Get_Array_Index_Type (Name (N));
805807
RHS_Idx_Type := Get_Array_Index_Type (Expression (N));
808+
-- LHS_Length := Make_Integer_Constant (2, LHS_Idx_Type);
806809
LHS_Length := Make_Array_Length_Expr (LHS, LHS_Idx_Type);
807810
Copy_Func :=
808811
Get_Array_Copy_Function (LHS_Element_Type,
@@ -845,6 +848,7 @@ package body Tree_Walk is
845848
Component_Name => "data",
846849
I_Type => LHS_Data_Type,
847850
Source_Location => Sloc (N));
851+
848852
RHS_Data : constant Irep :=
849853
Make_Member_Expr (Compound => RHS,
850854
Component_Name => "data",
@@ -856,9 +860,12 @@ package body Tree_Walk is
856860
Append_Argument (Copy_Args, LHS_Length);
857861
end;
858862

859-
Append_Op (Ret, Make_Code_Function_Call (I_Function => Copy_Func,
860-
Arguments => Copy_Args,
861-
Source_Location => Sloc (N)));
863+
Append_Op (Ret,
864+
Make_Code_Function_Call (Arguments => Copy_Args,
865+
I_Function => Copy_Func,
866+
Lhs => LHS_fun_call,
867+
Source_Location => Sloc (N),
868+
I_Type => Make_Void_Type));
862869

863870
return Ret;
864871

@@ -3983,97 +3990,120 @@ package body Tree_Walk is
39833990
(LHS_Element_Type, RHS_Element_Type, Index_Type);
39843991
Map_Cursor : Array_Copy_Maps.Cursor;
39853992
Map_Inserted : Boolean;
3986-
begin
3987-
Array_Copy_Map.Insert (Map_Key, Ireps.Empty, Map_Cursor, Map_Inserted);
3988-
if not Map_Inserted then
3989-
return Array_Copy_Maps.Element (Map_Cursor);
3990-
end if;
39913993

3992-
-- Create a new copy function:
3993-
declare
3994-
Func_Type : constant Irep := New_Irep (I_Code_Type);
3995-
Func_Args : constant Irep := New_Irep (I_Parameter_List);
3996-
Write_Ptr_Arg : constant Irep := New_Irep (I_Code_Parameter);
3997-
Read_Ptr_Arg : constant Irep := New_Irep (I_Code_Parameter);
3994+
function Build_Copy_Function return Symbol;
3995+
3996+
-------------------------
3997+
-- Build_Copy_Function --
3998+
-------------------------
3999+
4000+
-- Build a functions:
4001+
-- n.b.: the typecast is optional
4002+
-- void copy_array(lhs_type* out, rhs_type* in, int len) {
4003+
-- int idx = 0;
4004+
-- for (;idx < len; idx++)
4005+
-- out[idx] = (lhs_type)in[idx];
4006+
-- }
4007+
function Build_Copy_Function return Symbol
4008+
is
4009+
Source_Loc : constant Source_Ptr := Sloc (RHS_Element_Type);
4010+
Map_Size_Str : constant String :=
4011+
Integer'Image (Integer (Array_Copy_Map.Length));
4012+
Func_Name : constant String :=
4013+
"__ada_copy_array" & Map_Size_Str (2 .. Map_Size_Str'Last);
4014+
Body_Block : constant Irep := Make_Code_Block (Source_Loc);
4015+
Func_Params : constant Irep := New_Irep (I_Parameter_List);
39984016
LHS_Ptr_Type : constant Irep :=
39994017
Make_Pointer_Type (Do_Type_Reference (LHS_Element_Type));
4018+
Write_Ptr_Param : constant Irep :=
4019+
Create_Fun_Parameter (Fun_Name => Func_Name,
4020+
Param_Name => "out",
4021+
Param_Type => LHS_Ptr_Type,
4022+
Param_List => Func_Params,
4023+
A_Symbol_Table => Global_Symbol_Table,
4024+
Source_Location => Source_Loc);
40004025
RHS_Ptr_Type : constant Irep :=
40014026
Make_Pointer_Type (Do_Type_Reference (RHS_Element_Type));
4002-
Len_Arg : constant Irep := New_Irep (I_Code_Parameter);
4027+
Read_Ptr_Param : constant Irep :=
4028+
Create_Fun_Parameter (Fun_Name => Func_Name,
4029+
Param_Name => "in",
4030+
Param_Type => RHS_Ptr_Type,
4031+
Param_List => Func_Params,
4032+
A_Symbol_Table => Global_Symbol_Table,
4033+
Source_Location => Source_Loc);
40034034
Len_Type : constant Irep := Do_Type_Reference (Index_Type);
4004-
Func_Symbol : Symbol;
4005-
Map_Size_Str : constant String :=
4006-
Integer'Image (Integer (Array_Copy_Map.Length));
4007-
Func_Name : constant String :=
4008-
"__ada_copy_array" & Map_Size_Str (2 .. Map_Size_Str'Last);
4009-
Body_Block : constant Irep := New_Irep (I_Code_Block);
4010-
Body_Loop : constant Irep := New_Irep (I_Code_For);
4011-
Loop_Test : constant Irep := New_Irep (I_Op_Lt);
4012-
Loop_Assign : constant Irep := New_Irep (I_Code_Assign);
4013-
RHS_Element : Irep;
4014-
RHS_Cast : Irep;
4035+
Len_Param : constant Irep :=
4036+
Create_Fun_Parameter (Fun_Name => Func_Name,
4037+
Param_Name => "len",
4038+
Param_Type => Len_Type,
4039+
Param_List => Func_Params,
4040+
A_Symbol_Table => Global_Symbol_Table,
4041+
Source_Location => Source_Loc);
4042+
Func_Type : constant Irep :=
4043+
Make_Code_Type (Parameters => Func_Params,
4044+
Ellipsis => False,
4045+
Return_Type => New_Irep (I_Void_Type),
4046+
Inlined => False,
4047+
Knr => False);
40154048
Counter_Sym : constant Irep :=
40164049
Fresh_Var_Symbol_Expr (Len_Type, "idx");
4050+
Loop_Test : constant Irep :=
4051+
Make_Op_Lt (Rhs => Param_Symbol (Len_Param),
4052+
Lhs => Counter_Sym,
4053+
Source_Location => Source_Loc,
4054+
Overflow_Check => False,
4055+
I_Type => New_Irep (I_Bool_Type));
4056+
RHS_Element : constant Irep :=
4057+
Make_Pointer_Index (Param_Symbol (Read_Ptr_Param), Counter_Sym);
4058+
RHS_Cast : Irep;
4059+
Loop_Assign : Irep;
4060+
For_Loop : Irep;
4061+
Assign_LHS : constant Irep :=
4062+
Make_Pointer_Index (Param_Symbol (Write_Ptr_Param), Counter_Sym);
40174063
begin
4018-
-- Create type (lhs_el_type*, rhs_el_type*, index_type) -> void
4019-
Set_Type (Write_Ptr_Arg, LHS_Ptr_Type);
4020-
Set_Identifier (Write_Ptr_Arg, Func_Name & "::out");
4021-
Set_Base_Name (Write_Ptr_Arg, "out");
4022-
Set_Type (Read_Ptr_Arg, RHS_Ptr_Type);
4023-
Set_Identifier (Read_Ptr_Arg, Func_Name & "::in");
4024-
Set_Base_Name (Read_Ptr_Arg, "in");
4025-
Set_Type (Len_Arg, Len_Type);
4026-
Set_Identifier (Len_Arg, Func_Name & "::len");
4027-
Set_Base_Name (Len_Arg, "len");
4028-
Append_Parameter (Func_Args, Write_Ptr_Arg);
4029-
Append_Parameter (Func_Args, Read_Ptr_Arg);
4030-
Append_Parameter (Func_Args, Len_Arg);
4031-
Set_Parameters (Func_Type, Func_Args);
4032-
Set_Return_Type (Func_Type, New_Irep (I_Void_Type));
4033-
4034-
-- Create function body (declarations and a copy for-loop):
4035-
Append_Declare_And_Init
4036-
(Counter_Sym, Make_Integer_Constant (0, Index_Type), Body_Block, 0);
4037-
4038-
Set_Iter (Body_Loop, Make_Increment (Counter_Sym, Index_Type, 1));
4039-
Set_Lhs (Loop_Test, Counter_Sym);
4040-
Set_Rhs (Loop_Test, Param_Symbol (Len_Arg));
4041-
Set_Cond (Body_Loop, Loop_Test);
4042-
4043-
Set_Lhs (Loop_Assign,
4044-
Make_Pointer_Index (Param_Symbol (Write_Ptr_Arg),
4045-
Counter_Sym));
4046-
RHS_Element := Make_Pointer_Index (Param_Symbol (Read_Ptr_Arg),
4047-
Counter_Sym);
40484064
if LHS_Element_Type = RHS_Element_Type then
40494065
RHS_Cast := RHS_Element;
40504066
else
4051-
RHS_Cast := New_Irep (I_Op_Typecast);
4052-
Set_Type (RHS_Cast, Get_Type (Get_Lhs (Loop_Assign)));
4053-
Set_Op0 (RHS_Cast, RHS_Element);
4067+
RHS_Cast :=
4068+
Make_Op_Typecast (Op0 => RHS_Element,
4069+
Source_Location => Source_Loc,
4070+
I_Type =>
4071+
Get_Type (Assign_LHS));
40544072
end if;
4073+
Loop_Assign :=
4074+
Make_Code_Assign (Rhs => RHS_Cast,
4075+
Lhs => Assign_LHS,
4076+
Source_Location => Source_Loc);
4077+
For_Loop :=
4078+
Make_Code_For (Loop_Body => Loop_Assign,
4079+
Cond => Loop_Test,
4080+
Init =>
4081+
Make_Nil (Source_Loc),
4082+
Iter => Make_Increment (Counter_Sym,
4083+
Index_Type, 1),
4084+
Source_Location => Source_Loc);
4085+
Append_Declare_And_Init
4086+
(Counter_Sym, Make_Integer_Constant (0, Index_Type), Body_Block, 0);
4087+
Append_Op (Body_Block, For_Loop);
40554088

4056-
Set_Rhs (Loop_Assign, RHS_Element);
4057-
Set_Loop_Body (Body_Loop, Loop_Assign);
4058-
4059-
Append_Op (Body_Block, Body_Loop);
4060-
4061-
-- Make function symbol:
4062-
Func_Symbol.SymType := Func_Type;
4063-
Func_Symbol.Name := Intern (Func_Name);
4064-
Func_Symbol.PrettyName := Func_Symbol.Name;
4065-
Func_Symbol.BaseName := Func_Symbol.Name;
4066-
Func_Symbol.Mode := Intern ("C");
4067-
Func_Symbol.Value := Body_Block;
4068-
Global_Symbol_Table.Insert (Intern (Func_Name), Func_Symbol);
4069-
4070-
-- Record it for the future:
4071-
Array_Copy_Map.Replace_Element (Map_Cursor,
4072-
Symbol_Expr (Func_Symbol));
4089+
return New_Function_Symbol_Entry (
4090+
Name => Func_Name,
4091+
Symbol_Type => Func_Type,
4092+
Value => Body_Block,
4093+
A_Symbol_Table => Global_Symbol_Table);
4094+
end Build_Copy_Function;
40734095

4096+
begin
4097+
Array_Copy_Map.Insert (Map_Key, Ireps.Empty, Map_Cursor, Map_Inserted);
4098+
if not Map_Inserted then
40744099
return Array_Copy_Maps.Element (Map_Cursor);
4075-
end;
4100+
end if;
4101+
4102+
-- Record it for the future:
4103+
Array_Copy_Map.Replace_Element (Map_Cursor,
4104+
Symbol_Expr (Build_Copy_Function));
40764105

4106+
return Array_Copy_Maps.Element (Map_Cursor);
40774107
end Get_Array_Copy_Function;
40784108

40794109
----------------------------
@@ -4091,70 +4121,97 @@ package body Tree_Walk is
40914121
return Array_Dup_Maps.Element (Map_Cursor);
40924122
end if;
40934123

4094-
-- Create a new duplicator function:
4124+
-- Build a function:
4125+
-- elem_type* dup_array(elem_type* ptr, int len) {
4126+
-- elem_type* new_array = alloc(sizeof(elem_type) * len);
4127+
-- copy_array(new_array, ptr, len);
4128+
-- return new_array;
4129+
-- }
40954130
declare
4096-
4097-
Func_Type : constant Irep := New_Irep (I_Code_Type);
4098-
Func_Args : constant Irep := New_Irep (I_Parameter_List);
4099-
Ptr_Arg : constant Irep := New_Irep (I_Code_Parameter);
4100-
Ptr_Type : constant Irep :=
4101-
Make_Pointer_Type (Do_Type_Reference (Element_Type));
4102-
Len_Arg : constant Irep := New_Irep (I_Code_Parameter);
4103-
Len_Type : constant Irep := Do_Type_Reference (Index_Type);
4104-
Func_Symbol : Symbol;
4131+
Func_Params : constant Irep := New_Irep (I_Parameter_List);
41054132
Map_Size_Str : constant String :=
41064133
Integer'Image (Integer (Array_Dup_Map.Length));
41074134
Func_Name : constant String :=
41084135
"__ada_dup_array" & Map_Size_Str (2 .. Map_Size_Str'Last);
4136+
Ptr_Type : constant Irep :=
4137+
Make_Pointer_Type (Do_Type_Reference (Element_Type));
4138+
Func_Type : constant Irep :=
4139+
Make_Code_Type (Parameters => Func_Params,
4140+
-- the parameters are build later
4141+
Ellipsis => False,
4142+
Return_Type => Ptr_Type,
4143+
Inlined => False,
4144+
Knr => False);
4145+
Source_Loc : constant Source_Ptr := Sloc (Element_Type);
4146+
Ptr_Param : constant Irep :=
4147+
Create_Fun_Parameter (Fun_Name => Func_Name,
4148+
Param_Name => "ptr",
4149+
Param_Type => Ptr_Type,
4150+
Param_List => Func_Params,
4151+
A_Symbol_Table => Global_Symbol_Table,
4152+
Source_Location => Source_Loc);
4153+
Len_Type : constant Irep := Do_Type_Reference (Index_Type);
4154+
Len_Param : constant Irep :=
4155+
Create_Fun_Parameter (Fun_Name => Func_Name,
4156+
Param_Name => "len",
4157+
Param_Type => Len_Type,
4158+
Param_List => Func_Params,
4159+
A_Symbol_Table => Global_Symbol_Table,
4160+
Source_Location => Source_Loc);
4161+
4162+
Func_Symbol : Symbol;
4163+
Alloc_Symbol : Symbol;
4164+
Alloc_Name : constant String := "__new_array";
41094165
Array_Copy : constant Irep :=
41104166
Fresh_Var_Symbol_Expr (Ptr_Type, "new_array");
41114167
Array_Alloc : constant Irep :=
4112-
New_Irep (I_Side_Effect_Expr_Cpp_New_Array);
4113-
Body_Block : constant Irep := New_Irep (I_Code_Block);
4114-
Call_Inst : constant Irep := New_Irep (I_Code_Function_Call);
4168+
Make_Side_Effect_Expr_Cpp_New_Array (Source_Location => Source_Loc,
4169+
Size => Param_Symbol (Len_Param),
4170+
I_Type => Ptr_Type);
4171+
Body_Block : constant Irep := Make_Code_Block (Source_Loc);
41154172
Call_Args : constant Irep := New_Irep (I_Argument_List);
4116-
Return_Inst : constant Irep := New_Irep (I_Code_Return);
4117-
4173+
Lhs_fun_call : constant Irep :=
4174+
Fresh_Var_Symbol_Expr (Do_Type_Reference (Element_Type),
4175+
"array_dup_fun_lhs");
4176+
Call_Inst : constant Irep :=
4177+
Make_Code_Function_Call (Arguments => Call_Args,
4178+
-- the argument are appended later
4179+
I_Function =>
4180+
Get_Array_Copy_Function (
4181+
Element_Type,
4182+
Element_Type,
4183+
Index_Type),
4184+
Lhs => Lhs_fun_call,
4185+
Source_Location => Source_Loc);
4186+
Return_Inst : constant Irep :=
4187+
Make_Code_Return (Return_Value => Array_Copy,
4188+
Source_Location => Source_Loc);
41184189
begin
4119-
4120-
-- Create type (element_type*, index_type) -> element_type*
4121-
Set_Type (Ptr_Arg, Ptr_Type);
4122-
Set_Identifier (Ptr_Arg, Func_Name & "::ptr");
4123-
Set_Base_Name (Ptr_Arg, "ptr");
4124-
Set_Type (Len_Arg, Len_Type);
4125-
Set_Identifier (Len_Arg, Func_Name & "::len");
4126-
Set_Base_Name (Len_Arg, "len");
4127-
Append_Parameter (Func_Args, Ptr_Arg);
4128-
Append_Parameter (Func_Args, Len_Arg);
4129-
Set_Parameters (Func_Type, Func_Args);
4130-
Set_Return_Type (Func_Type, Ptr_Type);
4131-
41324190
-- Create body (allocate and then call array_copy)
4133-
Set_Size (Array_Alloc, Param_Symbol (Len_Arg));
4134-
Set_Type (Array_Alloc, Ptr_Type);
4191+
41354192
Append_Declare_And_Init (Array_Copy, Array_Alloc, Body_Block, 0);
41364193
Append_Argument (Call_Args, Array_Copy);
4137-
Append_Argument (Call_Args, Param_Symbol (Ptr_Arg));
4138-
Append_Argument (Call_Args, Param_Symbol (Len_Arg));
4139-
Set_Arguments (Call_Inst, Call_Args);
4140-
Set_Function (Call_Inst,
4141-
Get_Array_Copy_Function (Element_Type,
4142-
Element_Type,
4143-
Index_Type));
4194+
Append_Argument (Call_Args, Param_Symbol (Ptr_Param));
4195+
Append_Argument (Call_Args, Param_Symbol (Len_Param));
41444196
Append_Op (Body_Block, Call_Inst);
4145-
4146-
Set_Return_Value (Return_Inst, Array_Copy);
41474197
Append_Op (Body_Block, Return_Inst);
41484198

4149-
-- Make function symbol:
4150-
Func_Symbol.SymType := Func_Type;
4151-
Func_Symbol.Name := Intern (Func_Name);
4152-
Func_Symbol.PrettyName := Func_Symbol.Name;
4153-
Func_Symbol.BaseName := Func_Symbol.Name;
4154-
Func_Symbol.Mode := Intern ("C");
4155-
Func_Symbol.Value := Body_Block;
4156-
Global_Symbol_Table.Insert (Intern (Func_Name), Func_Symbol);
4199+
Func_Symbol :=
4200+
New_Function_Symbol_Entry (Name => Func_Name,
4201+
Symbol_Type => Func_Type,
4202+
Value => Body_Block,
4203+
A_Symbol_Table => Global_Symbol_Table);
41574204

4205+
-- Add allocation function to symbol table: to be removed
4206+
if not (Global_Symbol_Table.Contains (Intern (Alloc_Name)))
4207+
then
4208+
Alloc_Symbol.SymType := Func_Type;
4209+
Alloc_Symbol.Name := Intern (Alloc_Name);
4210+
Alloc_Symbol.PrettyName := Alloc_Symbol.Name;
4211+
Alloc_Symbol.BaseName := Alloc_Symbol.Name;
4212+
Alloc_Symbol.Mode := Intern ("C");
4213+
Global_Symbol_Table.Insert (Intern (Alloc_Name), Alloc_Symbol);
4214+
end if;
41584215
-- Record it for the future:
41594216
Array_Dup_Map.Replace_Element (Map_Cursor, Symbol_Expr (Func_Symbol));
41604217

0 commit comments

Comments
 (0)