Skip to content

Commit 719ead5

Browse files
committed
Implement representation clause address
We handle it by 1: declaring a new variable with type one pointer deeper 2: assign the address to it 3: store the name (we'll need to replace it in the symbol table -- next commit)
1 parent 9e5e523 commit 719ead5

File tree

2 files changed

+81
-5
lines changed

2 files changed

+81
-5
lines changed

gnat2goto/driver/goto_utils.ads

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ with Atree; use Atree;
44
with Sinfo; use Sinfo;
55
with Symbol_Table_Info; use Symbol_Table_Info;
66
with Uintp; use Uintp;
7+
with GNAT.Table;
78

89
package GOTO_Utils is
910

@@ -19,6 +20,15 @@ package GOTO_Utils is
1920

2021
Synthetic_Variable_Counter : Positive := 1;
2122

23+
type String_Access is access String;
24+
25+
package Addressed_Variables is new
26+
GNAT.Table (Table_Component_Type => String_Access,
27+
Table_Index_Type => Natural,
28+
Table_Low_Bound => 1,
29+
Table_Initial => 1,
30+
Table_Increment => 20);
31+
2232
function Fresh_Var_Name (Infix : String) return String;
2333
function Fresh_Var_Symbol_Expr (Ty : Irep; Infix : String) return Irep;
2434

gnat2goto/driver/tree_walk.adb

Lines changed: 71 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4633,18 +4633,16 @@ package body Tree_Walk is
46334633
Entity_Esize : constant Uint := Esize (Entity (N));
46344634
Target_Type_Irep : constant Irep :=
46354635
Follow_Symbol_Type (Get_Type (Target_Name), Global_Symbol_Table);
4636-
Expression_Value : constant Uint := Intval (Expression (N));
46374636
begin
46384637
pragma Assert (Kind (Target_Type_Irep) in Class_Type);
46394638
if Attr_Id = "size" then
4640-
46414639
-- Just check that the front-end already applied this size
46424640
-- clause, i .e. that the size of type-irep we already had
46434641
-- equals the entity type this clause is applied to (and the
46444642
-- size specified in this clause).
46454643
pragma Assert (Entity_Esize =
46464644
UI_From_Int (Int (Get_Width (Target_Type_Irep)))
4647-
and Entity_Esize = Expression_Value);
4645+
and Entity_Esize = Intval (Expression (N)));
46484646
return;
46494647
elsif Attr_Id = "component_size" then
46504648
if not Is_Array_Type (Entity (N)) then
@@ -4660,6 +4658,7 @@ package body Tree_Walk is
46604658
Global_Symbol_Table);
46614659
Target_Subtype_Width : constant Uint :=
46624660
UI_From_Int (Int (Get_Width (Target_Subtype)));
4661+
Expression_Value : constant Uint := Intval (Expression (N));
46634662
begin
46644663
if Component_Size (Entity (N)) /= Expression_Value or
46654664
Target_Subtype_Width /= Expression_Value
@@ -4670,10 +4669,77 @@ package body Tree_Walk is
46704669
end if;
46714670
end;
46724671
return;
4673-
end if;
46744672

4675-
Report_Unhandled_Node_Empty (N, "Process_Declaration",
4673+
elsif Attr_Id = "address" then
4674+
-- Assuming this Ada code:
4675+
--------------------
4676+
-- Var : VarType;
4677+
-- for Var'Address use System'To_Address (hex_address);
4678+
--------------------
4679+
--
4680+
-- Produce this C code:
4681+
--------------------
4682+
-- VarType *Ptr_Var;
4683+
-- Ptr_Var = (VarType*)hex_address;
4684+
--------------------
4685+
pragma Assert (Global_Symbol_Table.Contains (Intern
4686+
(Get_Identifier (Target_Name))));
4687+
4688+
declare
4689+
Source_Loc : constant Source_Ptr := Sloc (N);
4690+
function Get_Address_Expr return Irep;
4691+
function Get_Address_Expr return Irep is
4692+
begin
4693+
if Nkind (Expression (N)) = N_Function_Call then
4694+
declare
4695+
Parameters : constant List_Id :=
4696+
Parameter_Associations (Expression (N));
4697+
begin
4698+
pragma Assert (not Is_Empty_List (Parameters) and then
4699+
Nkind (First (Parameters)) = N_Integer_Literal);
4700+
return
4701+
Integer_Constant_To_Expr
4702+
(Value => Intval (First (Parameters)),
4703+
Expr_Type => CProver_Size_T,
4704+
Type_Width => Size_T_Width,
4705+
Source_Location => Source_Loc);
4706+
end;
4707+
else
4708+
return Do_Expression (Expression (N));
4709+
end if;
4710+
end Get_Address_Expr;
4711+
4712+
Address_Expr : constant Irep := Get_Address_Expr;
4713+
Address_Type : constant Irep :=
4714+
Make_Pointer_Type (Target_Type_Irep);
4715+
Lhs_Expr : constant Irep :=
4716+
Make_Symbol_Expr (Source_Location => Source_Loc,
4717+
I_Type => Address_Type,
4718+
Range_Check => False,
4719+
Identifier =>
4720+
"Ptr_" & Get_Identifier (Target_Name));
4721+
Rhs_Expr : constant Irep :=
4722+
Typecast_If_Necessary (Expr => Address_Expr,
4723+
New_Type => Address_Type,
4724+
A_Symbol_Table => Global_Symbol_Table);
4725+
begin
4726+
New_Object_Symbol_Entry
4727+
(Object_Name =>
4728+
Intern ("Ptr_" & Get_Identifier (Target_Name)),
4729+
Object_Type => Address_Type,
4730+
Object_Init_Value => Rhs_Expr,
4731+
A_Symbol_Table => Global_Symbol_Table);
4732+
Append_Declare_And_Init (Symbol => Lhs_Expr,
4733+
Value => Rhs_Expr,
4734+
Block => Block,
4735+
Source_Loc => Source_Loc);
4736+
Addressed_Variables.Append (
4737+
new String'(Get_Identifier (Target_Name)));
4738+
end;
4739+
else
4740+
Report_Unhandled_Node_Empty (N, "Process_Declaration",
46764741
"Representation clause unsupported: " & Attr_Id);
4742+
end if;
46774743
end Handle_Representation_Clause;
46784744

46794745
begin

0 commit comments

Comments
 (0)