gcc/ada/exp_atag.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             E X P _ A T A G                              --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2006-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;    use Atree;
  27 with Einfo;    use Einfo;
  28 with Elists;   use Elists;
  29 with Exp_Util; use Exp_Util;
  30 with Namet;    use Namet;
  31 with Nlists;   use Nlists;
  32 with Nmake;    use Nmake;
  33 with Rtsfind;  use Rtsfind;
  34 with Sinfo;    use Sinfo;
  35 with Sem_Aux;  use Sem_Aux;
  36 with Sem_Util; use Sem_Util;
  37 with Stand;    use Stand;
  38 with Snames;   use Snames;
  39 with Tbuild;   use Tbuild;
  40
  41 package body Exp_Atag is
  42
  43    -----------------------
  44    -- Local Subprograms --
  45    -----------------------
  46
  47    function Build_DT
  48      (Loc      : Source_Ptr;
  49       Tag_Node : Node_Id) return Node_Id;
  50    --  Build code that displaces the Tag to reference the base of the wrapper
  51    --  record
  52    --
  53    --  Generates:
  54    --    To_Dispatch_Table_Ptr
  55    --      (To_Address (Tag_Node) - Tag_Node.Prims_Ptr'Position);
  56
  57    function Build_TSD
  58      (Loc           : Source_Ptr;
  59       Tag_Node_Addr : Node_Id) return Node_Id;
  60    --  Build code that retrieves the address of the record containing the Type
  61    --  Specific Data generated by GNAT.
  62    --
  63    --  Generate: To_Type_Specific_Data_Ptr
  64    --              (To_Addr_Ptr (Tag_Node_Addr - Typeinfo_Offset).all);
  65
  66    ------------------------------------------------
  67    -- Build_Common_Dispatching_Select_Statements --
  68    ------------------------------------------------
  69
  70    procedure Build_Common_Dispatching_Select_Statements
  71      (Loc    : Source_Ptr;
  72       DT_Ptr : Entity_Id;
  73       Stmts  : List_Id)
  74    is
  75    begin
  76       --  Generate:
  77       --    C := get_prim_op_kind (tag! (<type>VP), S);
  78
  79       --  where C is the out parameter capturing the call kind and S is the
  80       --  dispatch table slot number.
  81
  82       Append_To (Stmts,
  83         Make_Assignment_Statement (Loc,
  84           Name =>
  85             Make_Identifier (Loc, Name_uC),
  86           Expression =>
  87             Make_Function_Call (Loc,
  88               Name => New_Occurrence_Of (RTE (RE_Get_Prim_Op_Kind), Loc),
  89               Parameter_Associations => New_List (
  90                 Unchecked_Convert_To (RTE (RE_Tag),
  91                   New_Reference_To (DT_Ptr, Loc)),
  92                 Make_Identifier (Loc, Name_uS)))));
  93
  94       --  Generate:
  95
  96       --    if C = POK_Procedure
  97       --      or else C = POK_Protected_Procedure
  98       --      or else C = POK_Task_Procedure;
  99       --    then
 100       --       F := True;
 101       --       return;
 102
 103       --  where F is the out parameter capturing the status of a potential
 104       --  entry call.
 105
 106       Append_To (Stmts,
 107         Make_If_Statement (Loc,
 108
 109           Condition =>
 110             Make_Or_Else (Loc,
 111               Left_Opnd =>
 112                 Make_Op_Eq (Loc,
 113                   Left_Opnd =>
 114                     Make_Identifier (Loc, Name_uC),
 115                   Right_Opnd =>
 116                     New_Reference_To (RTE (RE_POK_Procedure), Loc)),
 117               Right_Opnd =>
 118                 Make_Or_Else (Loc,
 119                   Left_Opnd =>
 120                     Make_Op_Eq (Loc,
 121                       Left_Opnd =>
 122                         Make_Identifier (Loc, Name_uC),
 123                       Right_Opnd =>
 124                         New_Reference_To (RTE (
 125                           RE_POK_Protected_Procedure), Loc)),
 126                   Right_Opnd =>
 127                     Make_Op_Eq (Loc,
 128                       Left_Opnd =>
 129                         Make_Identifier (Loc, Name_uC),
 130                       Right_Opnd =>
 131                         New_Reference_To (RTE (
 132                           RE_POK_Task_Procedure), Loc)))),
 133
 134           Then_Statements =>
 135             New_List (
 136               Make_Assignment_Statement (Loc,
 137                 Name       => Make_Identifier (Loc, Name_uF),
 138                 Expression => New_Reference_To (Standard_True, Loc)),
 139               Make_Simple_Return_Statement (Loc))));
 140    end Build_Common_Dispatching_Select_Statements;
 141
 142    -------------------------
 143    -- Build_CW_Membership --
 144    -------------------------
 145
 146    procedure Build_CW_Membership
 147      (Loc          : Source_Ptr;
 148       Obj_Tag_Node : in out Node_Id;
 149       Typ_Tag_Node : Node_Id;
 150       Related_Nod  : Node_Id;
 151       New_Node     : out Node_Id)
 152    is
 153       Tag_Addr : constant Entity_Id := Make_Defining_Identifier (Loc,
 154                                          New_Internal_Name ('D'));
 155       Obj_TSD  : constant Entity_Id := Make_Defining_Identifier (Loc,
 156                                          New_Internal_Name ('D'));
 157       Typ_TSD  : constant Entity_Id := Make_Defining_Identifier (Loc,
 158                                          New_Internal_Name ('D'));
 159       Index    : constant Entity_Id := Make_Defining_Identifier (Loc,
 160                                          New_Internal_Name ('D'));
 161
 162    begin
 163       --  Generate:
 164
 165       --    Tag_Addr : constant Tag := Address!(Obj_Tag);
 166       --    Obj_TSD  : constant Type_Specific_Data_Ptr
 167       --                          := Build_TSD (Tag_Addr);
 168       --    Typ_TSD  : constant Type_Specific_Data_Ptr
 169       --                          := Build_TSD (Address!(Typ_Tag));
 170       --    Index    : constant Integer := Obj_TSD.Idepth - Typ_TSD.Idepth
 171       --    Index > 0 and then Obj_TSD.Tags_Table (Index) = Typ'Tag
 172
 173       Insert_Action (Related_Nod,
 174         Make_Object_Declaration (Loc,
 175           Defining_Identifier => Tag_Addr,
 176           Constant_Present    => True,
 177           Object_Definition   => New_Reference_To (RTE (RE_Address), Loc),
 178           Expression          => Unchecked_Convert_To
 179                                    (RTE (RE_Address), Obj_Tag_Node)));
 180
 181       --  Unchecked_Convert_To relocates Obj_Tag_Node and therefore we must
 182       --  update it.
 183
 184       Obj_Tag_Node := Expression (Expression (Parent (Tag_Addr)));
 185
 186       Insert_Action (Related_Nod,
 187         Make_Object_Declaration (Loc,
 188           Defining_Identifier => Obj_TSD,
 189           Constant_Present    => True,
 190           Object_Definition   => New_Reference_To
 191                                    (RTE (RE_Type_Specific_Data_Ptr), Loc),
 192           Expression => Build_TSD (Loc, New_Reference_To (Tag_Addr, Loc))));
 193
 194       Insert_Action (Related_Nod,
 195         Make_Object_Declaration (Loc,
 196           Defining_Identifier => Typ_TSD,
 197           Constant_Present    => True,
 198           Object_Definition   => New_Reference_To
 199                                    (RTE (RE_Type_Specific_Data_Ptr), Loc),
 200           Expression => Build_TSD (Loc,
 201                           Unchecked_Convert_To (RTE (RE_Address),
 202                             Typ_Tag_Node))));
 203
 204       Insert_Action (Related_Nod,
 205         Make_Object_Declaration (Loc,
 206           Defining_Identifier => Index,
 207           Constant_Present    => True,
 208           Object_Definition   => New_Occurrence_Of (Standard_Integer, Loc),
 209           Expression =>
 210             Make_Op_Subtract (Loc,
 211               Left_Opnd =>
 212                 Make_Selected_Component (Loc,
 213                   Prefix        => New_Reference_To (Obj_TSD, Loc),
 214                   Selector_Name =>
 215                      New_Reference_To
 216                        (RTE_Record_Component (RE_Idepth), Loc)),
 217
 218                Right_Opnd =>
 219                  Make_Selected_Component (Loc,
 220                    Prefix        => New_Reference_To (Typ_TSD, Loc),
 221                    Selector_Name =>
 222                      New_Reference_To
 223                        (RTE_Record_Component (RE_Idepth), Loc)))));
 224
 225       New_Node :=
 226         Make_And_Then (Loc,
 227           Left_Opnd =>
 228             Make_Op_Ge (Loc,
 229               Left_Opnd  => New_Occurrence_Of (Index, Loc),
 230               Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
 231
 232           Right_Opnd =>
 233             Make_Op_Eq (Loc,
 234               Left_Opnd =>
 235                 Make_Indexed_Component (Loc,
 236                   Prefix =>
 237                     Make_Selected_Component (Loc,
 238                       Prefix        => New_Reference_To (Obj_TSD, Loc),
 239                       Selector_Name =>
 240                         New_Reference_To
 241                           (RTE_Record_Component (RE_Tags_Table), Loc)),
 242                   Expressions =>
 243                     New_List (New_Occurrence_Of (Index, Loc))),
 244
 245               Right_Opnd => Typ_Tag_Node));
 246    end Build_CW_Membership;
 247
 248    --------------
 249    -- Build_DT --
 250    --------------
 251
 252    function Build_DT
 253      (Loc      : Source_Ptr;
 254       Tag_Node : Node_Id) return Node_Id
 255    is
 256    begin
 257       return
 258         Make_Function_Call (Loc,
 259           Name => New_Reference_To (RTE (RE_DT), Loc),
 260           Parameter_Associations => New_List (
 261             Unchecked_Convert_To (RTE (RE_Tag), Tag_Node)));
 262    end Build_DT;
 263
 264    ----------------------------
 265    -- Build_Get_Access_Level --
 266    ----------------------------
 267
 268    function Build_Get_Access_Level
 269      (Loc      : Source_Ptr;
 270       Tag_Node : Node_Id) return Node_Id
 271    is
 272    begin
 273       return
 274         Make_Selected_Component (Loc,
 275           Prefix =>
 276             Build_TSD (Loc,
 277               Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
 278           Selector_Name =>
 279             New_Reference_To
 280               (RTE_Record_Component (RE_Access_Level), Loc));
 281    end Build_Get_Access_Level;
 282
 283    ------------------------------------------
 284    -- Build_Get_Predefined_Prim_Op_Address --
 285    ------------------------------------------
 286
 287    procedure Build_Get_Predefined_Prim_Op_Address
 288      (Loc      : Source_Ptr;
 289       Position : Uint;
 290       Tag_Node : in out Node_Id;
 291       New_Node : out Node_Id)
 292    is
 293       Ctrl_Tag : Node_Id;
 294
 295    begin
 296       Ctrl_Tag := Unchecked_Convert_To (RTE (RE_Address), Tag_Node);
 297
 298       --  Unchecked_Convert_To relocates the controlling tag node and therefore
 299       --  we must update it.
 300
 301       Tag_Node := Expression (Ctrl_Tag);
 302
 303       --  Build code that retrieves the address of the dispatch table
 304       --  containing the predefined Ada primitives:
 305       --
 306       --  Generate:
 307       --    To_Predef_Prims_Table_Ptr
 308       --     (To_Addr_Ptr (To_Address (Tag) - Predef_Prims_Offset).all);
 309
 310       New_Node :=
 311         Make_Indexed_Component (Loc,
 312           Prefix =>
 313             Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 314               Make_Explicit_Dereference (Loc,
 315                 Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 316                   Make_Function_Call (Loc,
 317                     Name =>
 318                       Make_Expanded_Name (Loc,
 319                         Chars => Name_Op_Subtract,
 320                         Prefix =>
 321                           New_Reference_To
 322                             (RTU_Entity (System_Storage_Elements), Loc),
 323                         Selector_Name =>
 324                           Make_Identifier (Loc,
 325                             Chars => Name_Op_Subtract)),
 326                     Parameter_Associations => New_List (
 327                       Ctrl_Tag,
 328                       New_Reference_To (RTE (RE_DT_Predef_Prims_Offset),
 329                                         Loc)))))),
 330           Expressions =>
 331             New_List (Make_Integer_Literal (Loc, Position)));
 332    end Build_Get_Predefined_Prim_Op_Address;
 333
 334    -------------------------
 335    -- Build_Inherit_Prims --
 336    -------------------------
 337
 338    function Build_Inherit_Prims
 339      (Loc          : Source_Ptr;
 340       Typ          : Entity_Id;
 341       Old_Tag_Node : Node_Id;
 342       New_Tag_Node : Node_Id;
 343       Num_Prims    : Nat) return Node_Id
 344    is
 345    begin
 346       if RTE_Available (RE_DT) then
 347          return
 348            Make_Assignment_Statement (Loc,
 349              Name =>
 350                Make_Slice (Loc,
 351                  Prefix =>
 352                    Make_Selected_Component (Loc,
 353                      Prefix =>
 354                        Build_DT (Loc, New_Tag_Node),
 355                      Selector_Name =>
 356                        New_Reference_To
 357                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
 358                  Discrete_Range =>
 359                    Make_Range (Loc,
 360                    Low_Bound  => Make_Integer_Literal (Loc, 1),
 361                    High_Bound => Make_Integer_Literal (Loc, Num_Prims))),
 362
 363              Expression =>
 364                Make_Slice (Loc,
 365                  Prefix =>
 366                    Make_Selected_Component (Loc,
 367                      Prefix =>
 368                        Build_DT (Loc, Old_Tag_Node),
 369                      Selector_Name =>
 370                        New_Reference_To
 371                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
 372                  Discrete_Range =>
 373                    Make_Range (Loc,
 374                      Low_Bound  => Make_Integer_Literal (Loc, 1),
 375                      High_Bound => Make_Integer_Literal (Loc, Num_Prims))));
 376       else
 377          return
 378            Make_Assignment_Statement (Loc,
 379              Name =>
 380                Make_Slice (Loc,
 381                  Prefix =>
 382                    Unchecked_Convert_To
 383                      (Node (Last_Elmt (Access_Disp_Table (Typ))),
 384                       New_Tag_Node),
 385                  Discrete_Range =>
 386                    Make_Range (Loc,
 387                    Low_Bound  => Make_Integer_Literal (Loc, 1),
 388                    High_Bound => Make_Integer_Literal (Loc, Num_Prims))),
 389
 390              Expression =>
 391                Make_Slice (Loc,
 392                  Prefix =>
 393                    Unchecked_Convert_To
 394                      (Node (Last_Elmt (Access_Disp_Table (Typ))),
 395                       Old_Tag_Node),
 396                  Discrete_Range =>
 397                    Make_Range (Loc,
 398                      Low_Bound  => Make_Integer_Literal (Loc, 1),
 399                      High_Bound => Make_Integer_Literal (Loc, Num_Prims))));
 400       end if;
 401    end Build_Inherit_Prims;
 402
 403    -------------------------------
 404    -- Build_Get_Prim_Op_Address --
 405    -------------------------------
 406
 407    procedure Build_Get_Prim_Op_Address
 408      (Loc      : Source_Ptr;
 409       Typ      : Entity_Id;
 410       Position : Uint;
 411       Tag_Node : in out Node_Id;
 412       New_Node : out Node_Id)
 413    is
 414       New_Prefix : Node_Id;
 415
 416    begin
 417       pragma Assert
 418         (Position <= DT_Entry_Count (First_Tag_Component (Typ)));
 419
 420       --  At the end of the Access_Disp_Table list we have the type
 421       --  declaration required to convert the tag into a pointer to
 422       --  the prims_ptr table (see Freeze_Record_Type).
 423
 424       New_Prefix :=
 425         Unchecked_Convert_To
 426           (Node (Last_Elmt (Access_Disp_Table (Typ))), Tag_Node);
 427
 428       --  Unchecked_Convert_To relocates the controlling tag node and therefore
 429       --  we must update it.
 430
 431       Tag_Node := Expression (New_Prefix);
 432
 433       New_Node :=
 434         Make_Indexed_Component (Loc,
 435           Prefix      => New_Prefix,
 436           Expressions => New_List (Make_Integer_Literal (Loc, Position)));
 437    end Build_Get_Prim_Op_Address;
 438
 439    -----------------------------
 440    -- Build_Get_Transportable --
 441    -----------------------------
 442
 443    function Build_Get_Transportable
 444      (Loc      : Source_Ptr;
 445       Tag_Node : Node_Id) return Node_Id
 446    is
 447    begin
 448       return
 449         Make_Selected_Component (Loc,
 450           Prefix =>
 451             Build_TSD (Loc,
 452               Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
 453           Selector_Name =>
 454             New_Reference_To
 455               (RTE_Record_Component (RE_Transportable), Loc));
 456    end Build_Get_Transportable;
 457
 458    ------------------------------------
 459    -- Build_Inherit_Predefined_Prims --
 460    ------------------------------------
 461
 462    function Build_Inherit_Predefined_Prims
 463      (Loc          : Source_Ptr;
 464       Old_Tag_Node : Node_Id;
 465       New_Tag_Node : Node_Id) return Node_Id
 466    is
 467    begin
 468       return
 469         Make_Assignment_Statement (Loc,
 470           Name =>
 471             Make_Slice (Loc,
 472               Prefix =>
 473                 Make_Explicit_Dereference (Loc,
 474                   Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 475                     Make_Explicit_Dereference (Loc,
 476                       Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 477                         New_Tag_Node)))),
 478               Discrete_Range => Make_Range (Loc,
 479                 Make_Integer_Literal (Loc, Uint_1),
 480                 New_Reference_To (RTE (RE_Max_Predef_Prims), Loc))),
 481
 482           Expression =>
 483             Make_Slice (Loc,
 484               Prefix =>
 485                 Make_Explicit_Dereference (Loc,
 486                   Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 487                     Make_Explicit_Dereference (Loc,
 488                       Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 489                         Old_Tag_Node)))),
 490               Discrete_Range =>
 491                 Make_Range (Loc,
 492                   Make_Integer_Literal (Loc, 1),
 493                   New_Reference_To (RTE (RE_Max_Predef_Prims), Loc))));
 494    end Build_Inherit_Predefined_Prims;
 495
 496    -------------------------
 497    -- Build_Offset_To_Top --
 498    -------------------------
 499
 500    function Build_Offset_To_Top
 501      (Loc       : Source_Ptr;
 502       This_Node : Node_Id) return Node_Id
 503    is
 504       Tag_Node : Node_Id;
 505
 506    begin
 507       Tag_Node :=
 508         Make_Explicit_Dereference (Loc,
 509           Unchecked_Convert_To (RTE (RE_Tag_Ptr), This_Node));
 510
 511       return
 512         Make_Explicit_Dereference (Loc,
 513           Unchecked_Convert_To (RTE (RE_Offset_To_Top_Ptr),
 514             Make_Function_Call (Loc,
 515               Name =>
 516                 Make_Expanded_Name (Loc,
 517                   Chars => Name_Op_Subtract,
 518                   Prefix => New_Reference_To
 519                              (RTU_Entity (System_Storage_Elements), Loc),
 520                   Selector_Name => Make_Identifier (Loc,
 521                                      Chars => Name_Op_Subtract)),
 522               Parameter_Associations => New_List (
 523                 Unchecked_Convert_To (RTE (RE_Address), Tag_Node),
 524                 New_Reference_To (RTE (RE_DT_Offset_To_Top_Offset),
 525                                   Loc)))));
 526    end Build_Offset_To_Top;
 527
 528    ------------------------------------------
 529    -- Build_Set_Predefined_Prim_Op_Address --
 530    ------------------------------------------
 531
 532    function Build_Set_Predefined_Prim_Op_Address
 533      (Loc          : Source_Ptr;
 534       Tag_Node     : Node_Id;
 535       Position     : Uint;
 536       Address_Node : Node_Id) return Node_Id
 537    is
 538    begin
 539       return
 540          Make_Assignment_Statement (Loc,
 541            Name =>
 542              Make_Indexed_Component (Loc,
 543                Prefix =>
 544                  Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 545                    Make_Explicit_Dereference (Loc,
 546                      Unchecked_Convert_To (RTE (RE_Addr_Ptr), Tag_Node))),
 547                Expressions =>
 548                  New_List (Make_Integer_Literal (Loc, Position))),
 549
 550            Expression => Address_Node);
 551    end Build_Set_Predefined_Prim_Op_Address;
 552
 553    -------------------------------
 554    -- Build_Set_Prim_Op_Address --
 555    -------------------------------
 556
 557    function Build_Set_Prim_Op_Address
 558      (Loc          : Source_Ptr;
 559       Typ          : Entity_Id;
 560       Tag_Node     : Node_Id;
 561       Position     : Uint;
 562       Address_Node : Node_Id) return Node_Id
 563    is
 564       Ctrl_Tag : Node_Id := Tag_Node;
 565       New_Node : Node_Id;
 566
 567    begin
 568       Build_Get_Prim_Op_Address (Loc, Typ, Position, Ctrl_Tag, New_Node);
 569
 570       return
 571         Make_Assignment_Statement (Loc,
 572           Name       => New_Node,
 573           Expression => Address_Node);
 574    end Build_Set_Prim_Op_Address;
 575
 576    -----------------------------
 577    -- Build_Set_Size_Function --
 578    -----------------------------
 579
 580    function Build_Set_Size_Function
 581      (Loc       : Source_Ptr;
 582       Tag_Node  : Node_Id;
 583       Size_Func : Entity_Id) return Node_Id is
 584    begin
 585       pragma Assert (Chars (Size_Func) = Name_uSize
 586         and then RTE_Record_Component_Available (RE_Size_Func));
 587       return
 588         Make_Assignment_Statement (Loc,
 589           Name =>
 590             Make_Selected_Component (Loc,
 591               Prefix =>
 592                 Build_TSD (Loc,
 593                   Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
 594               Selector_Name =>
 595                 New_Reference_To
 596                   (RTE_Record_Component (RE_Size_Func), Loc)),
 597           Expression =>
 598             Unchecked_Convert_To (RTE (RE_Size_Ptr),
 599               Make_Attribute_Reference (Loc,
 600                 Prefix => New_Reference_To (Size_Func, Loc),
 601                 Attribute_Name => Name_Unrestricted_Access)));
 602    end Build_Set_Size_Function;
 603
 604    ------------------------------------
 605    -- Build_Set_Static_Offset_To_Top --
 606    ------------------------------------
 607
 608    function Build_Set_Static_Offset_To_Top
 609      (Loc          : Source_Ptr;
 610       Iface_Tag    : Node_Id;
 611       Offset_Value : Node_Id) return Node_Id is
 612    begin
 613       return
 614         Make_Assignment_Statement (Loc,
 615           Make_Explicit_Dereference (Loc,
 616             Unchecked_Convert_To (RTE (RE_Offset_To_Top_Ptr),
 617               Make_Function_Call (Loc,
 618                 Name =>
 619                   Make_Expanded_Name (Loc,
 620                     Chars => Name_Op_Subtract,
 621                     Prefix => New_Reference_To
 622                                (RTU_Entity (System_Storage_Elements), Loc),
 623                     Selector_Name => Make_Identifier (Loc,
 624                                        Chars => Name_Op_Subtract)),
 625                 Parameter_Associations => New_List (
 626                   Unchecked_Convert_To (RTE (RE_Address), Iface_Tag),
 627                   New_Reference_To (RTE (RE_DT_Offset_To_Top_Offset),
 628                                     Loc))))),
 629           Offset_Value);
 630    end Build_Set_Static_Offset_To_Top;
 631
 632    ---------------
 633    -- Build_TSD --
 634    ---------------
 635
 636    function Build_TSD
 637      (Loc           : Source_Ptr;
 638       Tag_Node_Addr : Node_Id) return Node_Id is
 639    begin
 640       return
 641         Unchecked_Convert_To (RTE (RE_Type_Specific_Data_Ptr),
 642           Make_Explicit_Dereference (Loc,
 643             Prefix => Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 644               Make_Function_Call (Loc,
 645                 Name =>
 646                   Make_Expanded_Name (Loc,
 647                     Chars => Name_Op_Subtract,
 648                     Prefix =>
 649                       New_Reference_To
 650                         (RTU_Entity (System_Storage_Elements), Loc),
 651                     Selector_Name =>
 652                       Make_Identifier (Loc,
 653                         Chars => Name_Op_Subtract)),
 654
 655                 Parameter_Associations => New_List (
 656                   Tag_Node_Addr,
 657                   New_Reference_To
 658                     (RTE (RE_DT_Typeinfo_Ptr_Size), Loc))))));
 659    end Build_TSD;
 660
 661 end Exp_Atag;