@@ -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