Skip to content

Commit 2db62c7

Browse files
committed
Wrap selected symbol in a dereference expression
And that those for which the address was specified (via clause). We chase them using the same idea as follow_irep and replace their symbol expression with dereference expression to the newly introduced pointer-to symbol.
1 parent 1f7f49a commit 2db62c7

File tree

3 files changed

+170
-3
lines changed

3 files changed

+170
-3
lines changed

gnat2goto/driver/driver.adb

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -705,10 +705,20 @@ package body Driver is
705705
begin
706706
Modified_Symbol.SymType :=
707707
Remove_Extra_Type_Information
708-
(Follow_Irep (SymType, Follow_Symbol'Access));
708+
(Follow_Irep (SymType, Follow_Symbol'Access));
709+
for K in 1 .. Addressed_Variables.Last loop
710+
Modified_Symbol.SymType := Wrap_Pointer
711+
(Modified_Symbol.SymType,
712+
Addressed_Variables.Table (K).all);
713+
end loop;
709714
Modified_Symbol.Value :=
710-
Remove_Extra_Type_Information
711-
(Follow_Irep (Value, Follow_Symbol'Access));
715+
Remove_Extra_Type_Information
716+
(Follow_Irep (Value, Follow_Symbol'Access));
717+
for K in 1 .. Addressed_Variables.Last loop
718+
Modified_Symbol.Value := Wrap_Pointer
719+
(Modified_Symbol.Value,
720+
Addressed_Variables.Table (K).all);
721+
end loop;
712722

713723
New_Table.Insert
714724
(Key => Symbol_Maps.Key (Sym_Iter),
Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
-------------------------------------------------------------------------------
2+
-- Separate definition for following the symbol types throughout Irep_Lists(s)
3+
-- Implementation is adopted from ireps-to_json.adb
4+
-- The rationale is to create a new list only when a new irep was created
5+
-- by the respective Follow_Irep. First, that sounds efficient and second
6+
-- Ireps were disappearing when new list was created (even if it was filled
7+
-- with the same ireps).
8+
-------------------------------------------------------------------------------
9+
separate (Ireps)
10+
function Wrap_Pointer (L : Irep_List; Name : String) return Irep_List
11+
is
12+
The_List : Irep_List_Node;
13+
Ptr : Internal_Irep_List;
14+
Arr : constant Irep_List := New_List;
15+
Modified : Boolean := False;
16+
begin
17+
if L /= 0 then
18+
The_List := Irep_List_Table.Table (To_Internal_List (L));
19+
Ptr := To_Internal_List (Irep_List (The_List.A));
20+
while Ptr /= 0 loop
21+
declare
22+
Orig_Irep : constant Irep := Irep (Irep_List_Table.Table (Ptr).A);
23+
New_Irep : constant Irep := Wrap_Pointer (Orig_Irep, Name);
24+
begin
25+
if Orig_Irep /= New_Irep then
26+
Append (Arr, New_Irep);
27+
Modified := True;
28+
else
29+
Append (Arr, Orig_Irep);
30+
end if;
31+
Ptr := Irep_List_Table.Table (Ptr).B;
32+
end;
33+
end loop;
34+
end if;
35+
36+
pragma Assert (L'Size = Arr'Size);
37+
if Modified then
38+
return Arr;
39+
else
40+
return L;
41+
end if;
42+
end Wrap_Pointer;

gnat2goto/ireps/ireps_generator.py

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -368,6 +368,25 @@ def follow_irep_set_all_subs(self, b, sn, subs, i, needs_null):
368368
write(b, "Integer (Follow_Irep (Irep (%s), Follow_Symbol));" % tbl_field)
369369
return needs_null
370370

371+
def wrap_pointer_set_all_subs(self, b, sn, subs, i, needs_null):
372+
needs_null = False
373+
setter_name, is_list = subs[i]
374+
layout_kind, layout_index, layout_typ =\
375+
self.layout[sn][setter_name]
376+
tbl_index = ada_component_name(layout_kind,
377+
layout_index)
378+
tbl_field = "N." + tbl_index
379+
if is_list:
380+
assert len(subs) == 1
381+
write(b, "Irep_Table.Table (I).%s :=" % tbl_index)
382+
with indent(b):
383+
write(b, "Integer (Wrap_Pointer (Irep_List (%s), Name));" % tbl_field)
384+
else:
385+
write(b, "Irep_Table.Table (I).%s :=" % tbl_index)
386+
with indent(b):
387+
write(b, "Integer (Wrap_Pointer (Irep (%s), Name));" % tbl_field)
388+
return needs_null
389+
371390
def remove_extra_type_information_set_all_subs(self, b, sn, subs, i, needs_null):
372391
needs_null = False
373392
setter_name, is_list = subs[i]
@@ -444,6 +463,26 @@ def follow_irep_set_all_namedsubs_and_comments(self, b, sn, setter_name, needs_n
444463
needs_null = False
445464
return needs_null
446465

466+
def wrap_pointer_set_all_namedsubs_and_comments(self, b, sn, setter_name, needs_null):
467+
needs_null = True
468+
for kind in self.named_setters[setter_name]:
469+
assert kind in ("irep", "list", "trivial")
470+
if sn in self.named_setters[setter_name][kind]:
471+
is_comment, _, _ =\
472+
self.named_setters[setter_name][kind][sn]
473+
layout_kind, layout_index, layout_typ =\
474+
self.layout[sn][setter_name]
475+
tbl_index = ada_component_name(layout_kind,
476+
layout_index)
477+
tbl_field = "N." + tbl_index
478+
479+
if kind == "irep":
480+
write(b, "Irep_Table.Table (I).%s :=" % tbl_index)
481+
with indent(b):
482+
write(b, "Integer (Wrap_Pointer (Irep (%s), Name));" % tbl_field)
483+
needs_null = False
484+
return needs_null
485+
447486
def remove_extra_type_information_set_all_namedsubs_and_comments(self, b, sn, setter_name, needs_null):
448487
needs_null = True
449488
for kind in self.named_setters[setter_name]:
@@ -530,6 +569,28 @@ def follow_irep_single_schema_name(self, b, sn):
530569
write(b, "null;")
531570
write(b, "")
532571

572+
def wrap_pointer_single_schema_name(self, b, sn):
573+
schema = self.schemata[sn]
574+
with indent(b):
575+
write(b, "when %s =>" % schema["ada_name"])
576+
with indent(b):
577+
# the ensuing case analysis may end up doing nothing for some irep kinds
578+
# in Ada cases cannot be empty hence we insert null statement if necessary
579+
needs_null = True
580+
581+
# Set all subs
582+
subs = self.collect_subs(sn)
583+
for i in xrange(len(subs)):
584+
needs_null = self.wrap_pointer_set_all_subs(b, sn, subs, i, needs_null)
585+
586+
# Set all namedSub and comments
587+
for setter_name in self.named_setters:
588+
needs_null = self.wrap_pointer_set_all_namedsubs_and_comments(b, sn, setter_name, needs_null)
589+
590+
if needs_null:
591+
write(b, "null;")
592+
write(b, "")
593+
533594
def remove_extra_type_information_single_schema_name(self, b, sn):
534595
schema = self.schemata[sn]
535596
with indent(b):
@@ -1813,6 +1874,10 @@ def generate_code(self, optimize, schema_file_names):
18131874
write(s, "-- Replace Symbol Types")
18141875
write(s, "")
18151876

1877+
write(s, "function Wrap_Pointer (I : Irep; Name : String) return Irep;")
1878+
write(s, "-- Increase Pointer Depth")
1879+
write(s, "")
1880+
18161881
write(s, "function Remove_Extra_Type_Information (I : Irep) return Irep;")
18171882
write(s, "-- Remove Type Bounds")
18181883
write(s, "")
@@ -1829,6 +1894,10 @@ def generate_code(self, optimize, schema_file_names):
18291894
write(b, "-- Replace Symbol Types")
18301895
write(b, "")
18311896

1897+
write(b, "function Wrap_Pointer (L : Irep_List; Name : String) return Irep_List;")
1898+
write(b, "-- Increase Pointer Depth")
1899+
write(b, "")
1900+
18321901
write(b, "function Remove_Extra_Type_Information (L : Irep_List) return Irep_List;")
18331902
write(b, "-- Remove Type Bounds")
18341903
write(b, "")
@@ -1880,6 +1949,11 @@ def generate_code(self, optimize, schema_file_names):
18801949
continuation(b)
18811950
write(b, "")
18821951

1952+
write(b, "function Wrap_Pointer (L : Irep_List; Name : String) return Irep_List")
1953+
write(b, "is separate;")
1954+
continuation(b)
1955+
write(b, "")
1956+
18831957
write(b, "function Remove_Extra_Type_Information (L : Irep_List) return Irep_List")
18841958
write(b, "is separate;")
18851959
continuation(b)
@@ -2036,6 +2110,47 @@ def generate_code(self, optimize, schema_file_names):
20362110
write(b, "end Follow_Irep;")
20372111
write(b, "")
20382112

2113+
write_comment_block(b, "Wrap_Pointer")
2114+
write(b, "function Wrap_Pointer (I : Irep; Name : String) return Irep")
2115+
write(b, "is")
2116+
write(b, "begin")
2117+
manual_indent(b)
2118+
write(b, "if I = 0 then")
2119+
with indent(b):
2120+
write(b, "return I;")
2121+
write(b, "end if;")
2122+
write(b, "")
2123+
write(b, "if Kind (I) = I_Code_Decl then")
2124+
with indent(b):
2125+
write(b, "return I;")
2126+
write(b, "end if;")
2127+
write(b, "")
2128+
write(b, "if Kind (I) = I_Symbol_Expr and then Get_Identifier (I) = Name")
2129+
write(b, "then")
2130+
with indent(b):
2131+
write(b, "return Make_Dereference_Expr (Make_Symbol_Expr (Get_Source_Location (I),")
2132+
with indent(b):
2133+
write(b, "Make_Pointer_Type (Get_Type (I), 64), False, \"Ptr_\" & Name),")
2134+
write(b, "Get_Source_Location (I), Get_Type (I));")
2135+
write(b, "end if;")
2136+
write(b, "")
2137+
write(b, "declare")
2138+
with indent(b):
2139+
write(b, "N : Irep_Node renames Irep_Table.Table (I);")
2140+
write(b, "begin")
2141+
manual_indent(b)
2142+
write(b, "case N.Kind is")
2143+
2144+
for sn in self.top_sorted_sn:
2145+
self.wrap_pointer_single_schema_name(b, sn)
2146+
write(b, "end case;")
2147+
manual_outdent(b)
2148+
write(b, "end;")
2149+
write(b, "return I;")
2150+
manual_outdent(b)
2151+
write(b, "end Wrap_Pointer;")
2152+
write(b, "")
2153+
20392154
write_comment_block(b, "Remove_Extra_Type_Information")
20402155
write(b, "function Remove_Extra_Type_Information (I : Irep) return Irep")
20412156
write(b, "is")

0 commit comments

Comments
 (0)