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_Temporary (Loc, 'D', Obj_Tag_Node);
 154       Obj_TSD  : constant Entity_Id := Make_Temporary (Loc, 'D');
 155       Typ_TSD  : constant Entity_Id := Make_Temporary (Loc, 'D');
 156       Index    : constant Entity_Id := Make_Temporary (Loc, 'D');
 157
 158    begin
 159       --  Generate:
 160
 161       --    Tag_Addr : constant Tag := Address!(Obj_Tag);
 162       --    Obj_TSD  : constant Type_Specific_Data_Ptr
 163       --                          := Build_TSD (Tag_Addr);
 164       --    Typ_TSD  : constant Type_Specific_Data_Ptr
 165       --                          := Build_TSD (Address!(Typ_Tag));
 166       --    Index    : constant Integer := Obj_TSD.Idepth - Typ_TSD.Idepth
 167       --    Index > 0 and then Obj_TSD.Tags_Table (Index) = Typ'Tag
 168
 169       Insert_Action (Related_Nod,
 170         Make_Object_Declaration (Loc,
 171           Defining_Identifier => Tag_Addr,
 172           Constant_Present    => True,
 173           Object_Definition   => New_Reference_To (RTE (RE_Address), Loc),
 174           Expression          => Unchecked_Convert_To
 175                                    (RTE (RE_Address), Obj_Tag_Node)));
 176
 177       --  Unchecked_Convert_To relocates Obj_Tag_Node and therefore we must
 178       --  update it.
 179
 180       Obj_Tag_Node := Expression (Expression (Parent (Tag_Addr)));
 181
 182       Insert_Action (Related_Nod,
 183         Make_Object_Declaration (Loc,
 184           Defining_Identifier => Obj_TSD,
 185           Constant_Present    => True,
 186           Object_Definition   => New_Reference_To
 187                                    (RTE (RE_Type_Specific_Data_Ptr), Loc),
 188           Expression => Build_TSD (Loc, New_Reference_To (Tag_Addr, Loc))));
 189
 190       Insert_Action (Related_Nod,
 191         Make_Object_Declaration (Loc,
 192           Defining_Identifier => Typ_TSD,
 193           Constant_Present    => True,
 194           Object_Definition   => New_Reference_To
 195                                    (RTE (RE_Type_Specific_Data_Ptr), Loc),
 196           Expression => Build_TSD (Loc,
 197                           Unchecked_Convert_To (RTE (RE_Address),
 198                             Typ_Tag_Node))));
 199
 200       Insert_Action (Related_Nod,
 201         Make_Object_Declaration (Loc,
 202           Defining_Identifier => Index,
 203           Constant_Present    => True,
 204           Object_Definition   => New_Occurrence_Of (Standard_Integer, Loc),
 205           Expression =>
 206             Make_Op_Subtract (Loc,
 207               Left_Opnd =>
 208                 Make_Selected_Component (Loc,
 209                   Prefix        => New_Reference_To (Obj_TSD, Loc),
 210                   Selector_Name =>
 211                      New_Reference_To
 212                        (RTE_Record_Component (RE_Idepth), Loc)),
 213
 214                Right_Opnd =>
 215                  Make_Selected_Component (Loc,
 216                    Prefix        => New_Reference_To (Typ_TSD, Loc),
 217                    Selector_Name =>
 218                      New_Reference_To
 219                        (RTE_Record_Component (RE_Idepth), Loc)))));
 220
 221       New_Node :=
 222         Make_And_Then (Loc,
 223           Left_Opnd =>
 224             Make_Op_Ge (Loc,
 225               Left_Opnd  => New_Occurrence_Of (Index, Loc),
 226               Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
 227
 228           Right_Opnd =>
 229             Make_Op_Eq (Loc,
 230               Left_Opnd =>
 231                 Make_Indexed_Component (Loc,
 232                   Prefix =>
 233                     Make_Selected_Component (Loc,
 234                       Prefix        => New_Reference_To (Obj_TSD, Loc),
 235                       Selector_Name =>
 236                         New_Reference_To
 237                           (RTE_Record_Component (RE_Tags_Table), Loc)),
 238                   Expressions =>
 239                     New_List (New_Occurrence_Of (Index, Loc))),
 240
 241               Right_Opnd => Typ_Tag_Node));
 242    end Build_CW_Membership;
 243
 244    --------------
 245    -- Build_DT --
 246    --------------
 247
 248    function Build_DT
 249      (Loc      : Source_Ptr;
 250       Tag_Node : Node_Id) return Node_Id
 251    is
 252    begin
 253       return
 254         Make_Function_Call (Loc,
 255           Name => New_Reference_To (RTE (RE_DT), Loc),
 256           Parameter_Associations => New_List (
 257             Unchecked_Convert_To (RTE (RE_Tag), Tag_Node)));
 258    end Build_DT;
 259
 260    ----------------------------
 261    -- Build_Get_Access_Level --
 262    ----------------------------
 263
 264    function Build_Get_Access_Level
 265      (Loc      : Source_Ptr;
 266       Tag_Node : Node_Id) return Node_Id
 267    is
 268    begin
 269       return
 270         Make_Selected_Component (Loc,
 271           Prefix =>
 272             Build_TSD (Loc,
 273               Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
 274           Selector_Name =>
 275             New_Reference_To
 276               (RTE_Record_Component (RE_Access_Level), Loc));
 277    end Build_Get_Access_Level;
 278
 279    ------------------------------------------
 280    -- Build_Get_Predefined_Prim_Op_Address --
 281    ------------------------------------------
 282
 283    procedure Build_Get_Predefined_Prim_Op_Address
 284      (Loc      : Source_Ptr;
 285       Position : Uint;
 286       Tag_Node : in out Node_Id;
 287       New_Node : out Node_Id)
 288    is
 289       Ctrl_Tag : Node_Id;
 290
 291    begin
 292       Ctrl_Tag := Unchecked_Convert_To (RTE (RE_Address), Tag_Node);
 293
 294       --  Unchecked_Convert_To relocates the controlling tag node and therefore
 295       --  we must update it.
 296
 297       Tag_Node := Expression (Ctrl_Tag);
 298
 299       --  Build code that retrieves the address of the dispatch table
 300       --  containing the predefined Ada primitives:
 301       --
 302       --  Generate:
 303       --    To_Predef_Prims_Table_Ptr
 304       --     (To_Addr_Ptr (To_Address (Tag) - Predef_Prims_Offset).all);
 305
 306       New_Node :=
 307         Make_Indexed_Component (Loc,
 308           Prefix =>
 309             Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 310               Make_Explicit_Dereference (Loc,
 311                 Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 312                   Make_Function_Call (Loc,
 313                     Name =>
 314                       Make_Expanded_Name (Loc,
 315                         Chars => Name_Op_Subtract,
 316                         Prefix =>
 317                           New_Reference_To
 318                             (RTU_Entity (System_Storage_Elements), Loc),
 319                         Selector_Name =>
 320                           Make_Identifier (Loc,
 321                             Chars => Name_Op_Subtract)),
 322                     Parameter_Associations => New_List (
 323                       Ctrl_Tag,
 324                       New_Reference_To (RTE (RE_DT_Predef_Prims_Offset),
 325                                         Loc)))))),
 326           Expressions =>
 327             New_List (Make_Integer_Literal (Loc, Position)));
 328    end Build_Get_Predefined_Prim_Op_Address;
 329
 330    -------------------------
 331    -- Build_Inherit_Prims --
 332    -------------------------
 333
 334    function Build_Inherit_Prims
 335      (Loc          : Source_Ptr;
 336       Typ          : Entity_Id;
 337       Old_Tag_Node : Node_Id;
 338       New_Tag_Node : Node_Id;
 339       Num_Prims    : Nat) return Node_Id
 340    is
 341    begin
 342       if RTE_Available (RE_DT) then
 343          return
 344            Make_Assignment_Statement (Loc,
 345              Name =>
 346                Make_Slice (Loc,
 347                  Prefix =>
 348                    Make_Selected_Component (Loc,
 349                      Prefix =>
 350                        Build_DT (Loc, New_Tag_Node),
 351                      Selector_Name =>
 352                        New_Reference_To
 353                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
 354                  Discrete_Range =>
 355                    Make_Range (Loc,
 356                    Low_Bound  => Make_Integer_Literal (Loc, 1),
 357                    High_Bound => Make_Integer_Literal (Loc, Num_Prims))),
 358
 359              Expression =>
 360                Make_Slice (Loc,
 361                  Prefix =>
 362                    Make_Selected_Component (Loc,
 363                      Prefix =>
 364                        Build_DT (Loc, Old_Tag_Node),
 365                      Selector_Name =>
 366                        New_Reference_To
 367                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
 368                  Discrete_Range =>
 369                    Make_Range (Loc,
 370                      Low_Bound  => Make_Integer_Literal (Loc, 1),
 371                      High_Bound => Make_Integer_Literal (Loc, Num_Prims))));
 372       else
 373          return
 374            Make_Assignment_Statement (Loc,
 375              Name =>
 376                Make_Slice (Loc,
 377                  Prefix =>
 378                    Unchecked_Convert_To
 379                      (Node (Last_Elmt (Access_Disp_Table (Typ))),
 380                       New_Tag_Node),
 381                  Discrete_Range =>
 382                    Make_Range (Loc,
 383                    Low_Bound  => Make_Integer_Literal (Loc, 1),
 384                    High_Bound => Make_Integer_Literal (Loc, Num_Prims))),
 385
 386              Expression =>
 387                Make_Slice (Loc,
 388                  Prefix =>
 389                    Unchecked_Convert_To
 390                      (Node (Last_Elmt (Access_Disp_Table (Typ))),
 391                       Old_Tag_Node),
 392                  Discrete_Range =>
 393                    Make_Range (Loc,
 394                      Low_Bound  => Make_Integer_Literal (Loc, 1),
 395                      High_Bound => Make_Integer_Literal (Loc, Num_Prims))));
 396       end if;
 397    end Build_Inherit_Prims;
 398
 399    -------------------------------
 400    -- Build_Get_Prim_Op_Address --
 401    -------------------------------
 402
 403    procedure Build_Get_Prim_Op_Address
 404      (Loc      : Source_Ptr;
 405       Typ      : Entity_Id;
 406       Position : Uint;
 407       Tag_Node : in out Node_Id;
 408       New_Node : out Node_Id)
 409    is
 410       New_Prefix : Node_Id;
 411
 412    begin
 413       pragma Assert
 414         (Position <= DT_Entry_Count (First_Tag_Component (Typ)));
 415
 416       --  At the end of the Access_Disp_Table list we have the type
 417       --  declaration required to convert the tag into a pointer to
 418       --  the prims_ptr table (see Freeze_Record_Type).
 419
 420       New_Prefix :=
 421         Unchecked_Convert_To
 422           (Node (Last_Elmt (Access_Disp_Table (Typ))), Tag_Node);
 423
 424       --  Unchecked_Convert_To relocates the controlling tag node and therefore
 425       --  we must update it.
 426
 427       Tag_Node := Expression (New_Prefix);
 428
 429       New_Node :=
 430         Make_Indexed_Component (Loc,
 431           Prefix      => New_Prefix,
 432           Expressions => New_List (Make_Integer_Literal (Loc, Position)));
 433    end Build_Get_Prim_Op_Address;
 434
 435    -----------------------------
 436    -- Build_Get_Transportable --
 437    -----------------------------
 438
 439    function Build_Get_Transportable
 440      (Loc      : Source_Ptr;
 441       Tag_Node : Node_Id) return Node_Id
 442    is
 443    begin
 444       return
 445         Make_Selected_Component (Loc,
 446           Prefix =>
 447             Build_TSD (Loc,
 448               Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
 449           Selector_Name =>
 450             New_Reference_To
 451               (RTE_Record_Component (RE_Transportable), Loc));
 452    end Build_Get_Transportable;
 453
 454    ------------------------------------
 455    -- Build_Inherit_Predefined_Prims --
 456    ------------------------------------
 457
 458    function Build_Inherit_Predefined_Prims
 459      (Loc          : Source_Ptr;
 460       Old_Tag_Node : Node_Id;
 461       New_Tag_Node : Node_Id) return Node_Id
 462    is
 463    begin
 464       return
 465         Make_Assignment_Statement (Loc,
 466           Name =>
 467             Make_Slice (Loc,
 468               Prefix =>
 469                 Make_Explicit_Dereference (Loc,
 470                   Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 471                     Make_Explicit_Dereference (Loc,
 472                       Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 473                         New_Tag_Node)))),
 474               Discrete_Range => Make_Range (Loc,
 475                 Make_Integer_Literal (Loc, Uint_1),
 476                 New_Reference_To (RTE (RE_Max_Predef_Prims), Loc))),
 477
 478           Expression =>
 479             Make_Slice (Loc,
 480               Prefix =>
 481                 Make_Explicit_Dereference (Loc,
 482                   Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 483                     Make_Explicit_Dereference (Loc,
 484                       Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 485                         Old_Tag_Node)))),
 486               Discrete_Range =>
 487                 Make_Range (Loc,
 488                   Make_Integer_Literal (Loc, 1),
 489                   New_Reference_To (RTE (RE_Max_Predef_Prims), Loc))));
 490    end Build_Inherit_Predefined_Prims;
 491
 492    -------------------------
 493    -- Build_Offset_To_Top --
 494    -------------------------
 495
 496    function Build_Offset_To_Top
 497      (Loc       : Source_Ptr;
 498       This_Node : Node_Id) return Node_Id
 499    is
 500       Tag_Node : Node_Id;
 501
 502    begin
 503       Tag_Node :=
 504         Make_Explicit_Dereference (Loc,
 505           Unchecked_Convert_To (RTE (RE_Tag_Ptr), This_Node));
 506
 507       return
 508         Make_Explicit_Dereference (Loc,
 509           Unchecked_Convert_To (RTE (RE_Offset_To_Top_Ptr),
 510             Make_Function_Call (Loc,
 511               Name =>
 512                 Make_Expanded_Name (Loc,
 513                   Chars => Name_Op_Subtract,
 514                   Prefix => New_Reference_To
 515                              (RTU_Entity (System_Storage_Elements), Loc),
 516                   Selector_Name => Make_Identifier (Loc,
 517                                      Chars => Name_Op_Subtract)),
 518               Parameter_Associations => New_List (
 519                 Unchecked_Convert_To (RTE (RE_Address), Tag_Node),
 520                 New_Reference_To (RTE (RE_DT_Offset_To_Top_Offset),
 521                                   Loc)))));
 522    end Build_Offset_To_Top;
 523
 524    ------------------------------------------
 525    -- Build_Set_Predefined_Prim_Op_Address --
 526    ------------------------------------------
 527
 528    function Build_Set_Predefined_Prim_Op_Address
 529      (Loc          : Source_Ptr;
 530       Tag_Node     : Node_Id;
 531       Position     : Uint;
 532       Address_Node : Node_Id) return Node_Id
 533    is
 534    begin
 535       return
 536          Make_Assignment_Statement (Loc,
 537            Name =>
 538              Make_Indexed_Component (Loc,
 539                Prefix =>
 540                  Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
 541                    Make_Explicit_Dereference (Loc,
 542                      Unchecked_Convert_To (RTE (RE_Addr_Ptr), Tag_Node))),
 543                Expressions =>
 544                  New_List (Make_Integer_Literal (Loc, Position))),
 545
 546            Expression => Address_Node);
 547    end Build_Set_Predefined_Prim_Op_Address;
 548
 549    -------------------------------
 550    -- Build_Set_Prim_Op_Address --
 551    -------------------------------
 552
 553    function Build_Set_Prim_Op_Address
 554      (Loc          : Source_Ptr;
 555       Typ          : Entity_Id;
 556       Tag_Node     : Node_Id;
 557       Position     : Uint;
 558       Address_Node : Node_Id) return Node_Id
 559    is
 560       Ctrl_Tag : Node_Id := Tag_Node;
 561       New_Node : Node_Id;
 562
 563    begin
 564       Build_Get_Prim_Op_Address (Loc, Typ, Position, Ctrl_Tag, New_Node);
 565
 566       return
 567         Make_Assignment_Statement (Loc,
 568           Name       => New_Node,
 569           Expression => Address_Node);
 570    end Build_Set_Prim_Op_Address;
 571
 572    -----------------------------
 573    -- Build_Set_Size_Function --
 574    -----------------------------
 575
 576    function Build_Set_Size_Function
 577      (Loc       : Source_Ptr;
 578       Tag_Node  : Node_Id;
 579       Size_Func : Entity_Id) return Node_Id is
 580    begin
 581       pragma Assert (Chars (Size_Func) = Name_uSize
 582         and then RTE_Record_Component_Available (RE_Size_Func));
 583       return
 584         Make_Assignment_Statement (Loc,
 585           Name =>
 586             Make_Selected_Component (Loc,
 587               Prefix =>
 588                 Build_TSD (Loc,
 589                   Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
 590               Selector_Name =>
 591                 New_Reference_To
 592                   (RTE_Record_Component (RE_Size_Func), Loc)),
 593           Expression =>
 594             Unchecked_Convert_To (RTE (RE_Size_Ptr),
 595               Make_Attribute_Reference (Loc,
 596                 Prefix => New_Reference_To (Size_Func, Loc),
 597                 Attribute_Name => Name_Unrestricted_Access)));
 598    end Build_Set_Size_Function;
 599
 600    ------------------------------------
 601    -- Build_Set_Static_Offset_To_Top --
 602    ------------------------------------
 603
 604    function Build_Set_Static_Offset_To_Top
 605      (Loc          : Source_Ptr;
 606       Iface_Tag    : Node_Id;
 607       Offset_Value : Node_Id) return Node_Id is
 608    begin
 609       return
 610         Make_Assignment_Statement (Loc,
 611           Make_Explicit_Dereference (Loc,
 612             Unchecked_Convert_To (RTE (RE_Offset_To_Top_Ptr),
 613               Make_Function_Call (Loc,
 614                 Name =>
 615                   Make_Expanded_Name (Loc,
 616                     Chars => Name_Op_Subtract,
 617                     Prefix => New_Reference_To
 618                                (RTU_Entity (System_Storage_Elements), Loc),
 619                     Selector_Name => Make_Identifier (Loc,
 620                                        Chars => Name_Op_Subtract)),
 621                 Parameter_Associations => New_List (
 622                   Unchecked_Convert_To (RTE (RE_Address), Iface_Tag),
 623                   New_Reference_To (RTE (RE_DT_Offset_To_Top_Offset),
 624                                     Loc))))),
 625           Offset_Value);
 626    end Build_Set_Static_Offset_To_Top;
 627
 628    ---------------
 629    -- Build_TSD --
 630    ---------------
 631
 632    function Build_TSD
 633      (Loc           : Source_Ptr;
 634       Tag_Node_Addr : Node_Id) return Node_Id is
 635    begin
 636       return
 637         Unchecked_Convert_To (RTE (RE_Type_Specific_Data_Ptr),
 638           Make_Explicit_Dereference (Loc,
 639             Prefix => Unchecked_Convert_To (RTE (RE_Addr_Ptr),
 640               Make_Function_Call (Loc,
 641                 Name =>
 642                   Make_Expanded_Name (Loc,
 643                     Chars => Name_Op_Subtract,
 644                     Prefix =>
 645                       New_Reference_To
 646                         (RTU_Entity (System_Storage_Elements), Loc),
 647                     Selector_Name =>
 648                       Make_Identifier (Loc,
 649                         Chars => Name_Op_Subtract)),
 650
 651                 Parameter_Associations => New_List (
 652                   Tag_Node_Addr,
 653                   New_Reference_To
 654                     (RTE (RE_DT_Typeinfo_Ptr_Size), Loc))))));
 655    end Build_TSD;
 656
 657 end Exp_Atag;