Skip to content

Commit a721a07

Browse files
tjj2017martin
tjj2017
authored and
martin
committed
Support implicit dereferencing.
1 parent 69aaa52 commit a721a07

File tree

2 files changed

+135
-37
lines changed

2 files changed

+135
-37
lines changed

‎gnat2goto/driver/arrays.adb

Lines changed: 106 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
with Nlists; use Nlists;
22
with Uintp; use Uintp;
3-
3+
with Namet; use Namet;
44
with Tree_Walk; use Tree_Walk;
55
with Follow; use Follow;
66
with Range_Check; use Range_Check;
@@ -791,19 +791,34 @@ package body Arrays is
791791

792792
function Do_Array_Length (N : Node_Id) return Irep
793793
is
794-
Array_Struct : constant Irep := Do_Expression (Prefix (N));
794+
-- It seems as though an N_Explicit_Drereference is placed in the tree
795+
-- even when the prefix of the Length attribute is an implicit
796+
-- dereference.
797+
-- Hence, implicit dereferences do not have to be seperately handled,
798+
-- they are handled as explicit dereferences.
799+
Array_Struct : constant Irep := Do_Expression (Prefix (N));
795800
begin
796801
return Build_Array_Size (Array_Struct);
797802
end Do_Array_Length;
798803

799804
function Do_Array_First (N : Node_Id) return Irep
800805
is
806+
-- It seems as though an N_Explicit_Drereference is placed in the tree
807+
-- even when the prefix of the Length attribute is an implicit
808+
-- dereference.
809+
-- Hence, implicit dereferences do not have to be seperately handled,
810+
-- they are handled as explicit dereferences.
801811
begin
802812
return Get_First_Index (Do_Expression (Prefix (N)));
803813
end Do_Array_First;
804814

805815
function Do_Array_Last (N : Node_Id) return Irep
806816
is
817+
-- It seems as though an N_Explicit_Drereference is placed in the tree
818+
-- even when the prefix of the Length attribute is an implicit
819+
-- dereference.
820+
-- Hence, implicit dereferences do not have to be seperately handled,
821+
-- they are handled as explicit dereferences.
807822
begin
808823
return Get_Last_Index (Do_Expression (Prefix (N)));
809824
end Do_Array_Last;
@@ -857,8 +872,28 @@ package body Arrays is
857872
-- }
858873
----------------------------------------------------------------------------
859874
function Do_Slice (N : Node_Id) return Irep is
875+
-- The prefix to the slice may be an access to an array object
876+
-- which must be implicitly dereferenced.
877+
The_Prefix : constant Node_Id := Prefix (N);
878+
Prefix_Etype : constant Node_Id := Etype (The_Prefix);
879+
Is_Implicit_Deref : constant Boolean := Is_Access_Type (Prefix_Etype);
880+
Prefix_Irep : constant Irep := Do_Expression (The_Prefix);
881+
Result_Type : constant Irep :=
882+
(if Is_Implicit_Deref then
883+
Do_Type_Reference (Designated_Type (Prefix_Etype))
884+
else
885+
Do_Type_Reference (Prefix_Etype));
886+
Base_Irep : constant Irep :=
887+
(if Is_Implicit_Deref then
888+
Make_Dereference_Expr
889+
(I_Type => Result_Type,
890+
Object => Prefix_Irep,
891+
Source_Location => Get_Source_Location (N))
892+
else
893+
Prefix_Irep);
894+
895+
-- Where required the prefix has been implicitly dereferenced.
860896
Source_Loc : constant Irep := Get_Source_Location (N);
861-
Result_Type : constant Irep := Do_Type_Reference (Etype (N));
862897
Slice_Params : constant Irep := Make_Parameter_List;
863898
Slice_Args : constant Irep := Make_Argument_List;
864899
Function_Name : constant String := "slice_expr";
@@ -937,7 +972,7 @@ package body Arrays is
937972
Func_Params => Slice_Params,
938973
FBody => Build_Slice_Func_Body,
939974
A_Symbol_Table => Global_Symbol_Table);
940-
Slice_Id : constant Irep := Do_Expression (Prefix (N));
975+
Slice_Id : constant Irep := Base_Irep;
941976
begin
942977
Append_Argument (Slice_Args,
943978
Slice_Id);
@@ -954,39 +989,74 @@ package body Arrays is
954989

955990
-- TODO: multi-dimensional arrays.
956991
function Do_Indexed_Component (N : Node_Id) return Irep is
957-
Base_Irep : constant Irep := Do_Expression (Prefix (N));
958-
Idx_Irep : constant Irep :=
959-
Typecast_If_Necessary (Do_Expression (First (Expressions (N))),
960-
CProver_Size_T, Global_Symbol_Table);
961-
962-
Source_Loc : constant Irep := Get_Source_Location (Base_Irep);
963-
First_Irep : constant Irep := Get_First_Index (Base_Irep);
964-
Last_Irep : constant Irep := Get_Last_Index (Base_Irep);
965-
Checked_Index : constant Irep :=
966-
Make_Index_Assert_Expr (N => N,
967-
Index => Idx_Irep,
968-
First_Index => First_Irep,
969-
Last_Index => Last_Irep);
970-
Zero_Based_Index : constant Irep :=
971-
Make_Op_Sub (Rhs => First_Irep,
972-
Lhs => Checked_Index,
973-
Source_Location => Source_Loc,
974-
Overflow_Check => False,
975-
I_Type => Get_Type (Idx_Irep),
976-
Range_Check => False);
977-
978-
Data_Irep : constant Irep :=
979-
Get_Data_Member (Base_Irep, Global_Symbol_Table);
980-
Data_Type : constant Irep := Get_Type (Data_Irep);
981-
Indexed_Data : constant Irep :=
982-
Offset_Array_Data (Base => Base_Irep,
983-
Offset => Zero_Based_Index);
984-
Element_Type : constant Irep := Get_Subtype (Data_Type);
992+
-- The prefix to an indexed component may be an access to an
993+
-- array object which must be implicitly dereferenced.
994+
The_Prefix : constant Node_Id := Prefix (N);
995+
Prefix_Etype : constant Node_Id := Etype (The_Prefix);
996+
Is_Implicit_Deref : constant Boolean := Is_Access_Type (Prefix_Etype);
985997
begin
986-
return
987-
Make_Dereference_Expr (Object => Indexed_Data,
988-
Source_Location => Source_Loc,
989-
I_Type => Element_Type);
998+
if (if Nkind (Prefix_Etype) = N_Defining_Identifier then
999+
Get_Name_String (Chars (Etype (Etype (Prefix (N)))))
1000+
elsif Is_Implicit_Deref then
1001+
Get_Name_String (Chars (Designated_Type (Prefix_Etype)))
1002+
else
1003+
"")
1004+
= "string"
1005+
then
1006+
return Report_Unhandled_Node_Irep (N, "Do_Expression",
1007+
"Index of string unsupported");
1008+
end if;
1009+
1010+
-- Where required the prefix has been implicitly dereferenced.
1011+
declare
1012+
Prefix_Irep : constant Irep := Do_Expression (The_Prefix);
1013+
Resolved_Type : constant Irep :=
1014+
(if Is_Implicit_Deref then
1015+
Do_Type_Reference (Designated_Type (Prefix_Etype))
1016+
else
1017+
Do_Type_Reference (Prefix_Etype));
1018+
Base_Irep : constant Irep :=
1019+
(if Is_Implicit_Deref then
1020+
Make_Dereference_Expr
1021+
(I_Type => Resolved_Type,
1022+
Object => Prefix_Irep,
1023+
Source_Location => Get_Source_Location (N))
1024+
else
1025+
Prefix_Irep);
1026+
1027+
Idx_Irep : constant Irep :=
1028+
Typecast_If_Necessary (Do_Expression (First (Expressions (N))),
1029+
CProver_Size_T, Global_Symbol_Table);
1030+
1031+
Source_Loc : constant Irep := Get_Source_Location (Base_Irep);
1032+
First_Irep : constant Irep := Get_First_Index (Base_Irep);
1033+
Last_Irep : constant Irep := Get_Last_Index (Base_Irep);
1034+
Checked_Index : constant Irep :=
1035+
Make_Index_Assert_Expr (N => N,
1036+
Index => Idx_Irep,
1037+
First_Index => First_Irep,
1038+
Last_Index => Last_Irep);
1039+
Zero_Based_Index : constant Irep :=
1040+
Make_Op_Sub (Rhs => First_Irep,
1041+
Lhs => Checked_Index,
1042+
Source_Location => Source_Loc,
1043+
Overflow_Check => False,
1044+
I_Type => Get_Type (Idx_Irep),
1045+
Range_Check => False);
1046+
1047+
Data_Irep : constant Irep :=
1048+
Get_Data_Member (Base_Irep, Global_Symbol_Table);
1049+
Data_Type : constant Irep := Get_Type (Data_Irep);
1050+
Indexed_Data : constant Irep :=
1051+
Offset_Array_Data (Base => Base_Irep,
1052+
Offset => Zero_Based_Index);
1053+
Element_Type : constant Irep := Get_Subtype (Data_Type);
1054+
begin
1055+
return
1056+
Make_Dereference_Expr (Object => Indexed_Data,
1057+
Source_Location => Source_Loc,
1058+
I_Type => Element_Type);
1059+
end;
9901060
end Do_Indexed_Component;
9911061

9921062
function Get_First_Index_Component (Array_Struct : Irep)

‎gnat2goto/driver/tree_walk.adb

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1777,6 +1777,10 @@ package body Tree_Walk is
17771777
Func_Symbol : Symbol;
17781778

17791779
begin
1780+
-- It seems as though an N_Explicit_Drereference is placed in the tree
1781+
-- even when the function call is an implicit dereference.
1782+
-- Hence, implicit dereferences do not have to be seperately handled,
1783+
-- they are handled as explicit dereferences.
17801784
if Nkind (Name (N)) = N_Explicit_Dereference then
17811785
declare
17821786
Fun_Type : constant Irep :=
@@ -4203,6 +4207,10 @@ package body Tree_Walk is
42034207
function Do_Procedure_Call_Statement (N : Node_Id) return Irep
42044208
is
42054209
begin
4210+
-- It seems as though an N_Explicit_Drereference is placed in the tree
4211+
-- even when the procedure call is an implicit dereference.
4212+
-- Hence, implicit dereferences do not have to be seperately handled,
4213+
-- they are handled as explicit dereferences.
42064214
if Nkind (Name (N)) = N_Explicit_Dereference then
42074215
declare
42084216
Fun_Type : constant Irep :=
@@ -4579,7 +4587,27 @@ package body Tree_Walk is
45794587
---------------------------
45804588

45814589
function Do_Selected_Component (N : Node_Id) return Irep is
4582-
Root : constant Irep := Do_Expression (Prefix (N));
4590+
-- The prefix to a selected component may be an access to an
4591+
-- record object which must be implicitly dereferenced.
4592+
The_Prefix : constant Node_Id := Prefix (N);
4593+
Prefix_Etype : constant Node_Id := Etype (The_Prefix);
4594+
Prefix_Irep : constant Irep := Do_Expression (The_Prefix);
4595+
Is_Implicit_Deref : constant Boolean := Is_Access_Type (Prefix_Etype);
4596+
Resolved_Type : constant Irep :=
4597+
(if Is_Implicit_Deref then
4598+
Do_Type_Reference (Designated_Type (Prefix_Etype))
4599+
else
4600+
Do_Type_Reference (Prefix_Etype));
4601+
Root : constant Irep :=
4602+
(if Is_Implicit_Deref then
4603+
Make_Dereference_Expr
4604+
(I_Type => Resolved_Type,
4605+
Object => Prefix_Irep,
4606+
Source_Location => Get_Source_Location (N))
4607+
else
4608+
Prefix_Irep);
4609+
4610+
-- Where required the prefix has been implicitly dereferenced.
45834611
Component : constant Entity_Id := Entity (Selector_Name (N));
45844612

45854613
-- Example:

0 commit comments

Comments
 (0)