home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / a-gtran3.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  100KB  |  2,878 lines
  1. /****************************************************************************/
  2. /*                                                                          */
  3. /*                         GNAT COMPILER COMPONENTS                         */
  4. /*                                                                          */
  5. /*                             A - G T R A N 3                              */
  6. /*                                                                          */
  7. /*                          C Implementation File                           */
  8. /*                                                                          */
  9. /*                            $Revision: 1.293 $                            */
  10. /*                                                                          */
  11. /*        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        */
  12. /*                                                                          */
  13. /* GNAT is free software;  you can  redistribute it  and/or modify it under */
  14. /* terms of the  GNU General Public License as published  by the Free Soft- */
  15. /* ware  Foundation;  either version 2,  or (at your option) any later ver- */
  16. /* sion.  GNAT is distributed in the hope that it will be useful, but WITH- */
  17. /* OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY */
  18. /* or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License */
  19. /* for  more details.  You should have  received  a copy of the GNU General */
  20. /* Public License  distributed with GNAT;  see file COPYING.  If not, write */
  21. /* to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
  22. /*                                                                          */
  23. /****************************************************************************/
  24.  
  25. #include <ctype.h>
  26. #include "config.h"
  27. #include "tree.h"
  28. #include "obstack.h"
  29. #include "flags.h"
  30. #include "convert.h"
  31.  
  32. #include "a-ada.h"
  33. #include "a-types.h"
  34. #include "a-atree.h"
  35. #include "a-nlists.h"
  36. #include "a-elists.h"
  37. #include "a-sinfo.h"
  38. #include "a-einfo.h"
  39. #include "a-namet.h"
  40. #include "a-snames.h"
  41. #include "a-string.h"
  42. #include "a-uintp.h"
  43. #include "a-trans.h"
  44. #include "a-trans3.h"
  45. #include "a-trans4.h"
  46. #include "a-gtran3.h"
  47. #include "a-misc.h"
  48. #include "a-rtree.h"
  49.  
  50. static tree maybe_placeholder        PROTO((tree));
  51. static tree elaborate_expression    PROTO((Node_Id, Entity_Id, char *,
  52.                            int, int));
  53. static tree gnat_to_gnu_field        PROTO((Entity_Id, tree, int, int));
  54. static tree components_to_record    PROTO((tree, Node_Id, tree, int,
  55.                            int, int, int));
  56. static tree create_enum_initializer    PROTO((Entity_Id, tree));
  57. static int validate_size        PROTO((Uint, tree, Entity_Id, int));
  58. static int validate_alignment        PROTO((Node_Id, int));
  59. static void compute_qualified_name    PROTO((Entity_Id));
  60.  
  61. /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
  62.    GCC type corresponding to that entity.  GNAT_ENTITY is assumed to
  63.    refer to an Ada type.  */
  64.  
  65. tree
  66. gnat_to_gnu_type (gnat_entity)
  67.      Entity_Id gnat_entity;
  68. {
  69.   tree gnu_decl;
  70.  
  71.   /* Convert the ada entity type into a GCC TYPE_DECL node.  */
  72.   gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
  73.   if (TREE_CODE (gnu_decl) != TYPE_DECL)
  74.     gigi_abort (101);
  75.  
  76.   return TREE_TYPE (gnu_decl);
  77. }
  78.  
  79. /* These two variables are used to defer recursively expanding incomplete
  80.    types while we are processing a record or subprogram type.  */
  81.  
  82. static int defer_incomplete_level = 0;
  83. static struct incomplete
  84. {
  85.   struct incomplete *next;
  86.   tree old_type;
  87.   Entity_Id full_type;
  88. } *defer_incomplete_list = 0;
  89.  
  90. /* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
  91.    entity, this routine returns the equivalent GCC tree for that entity
  92.    (an ..._DECL node) and associates the ..._DECL node with the input GNAT
  93.    defining identifier.
  94.  
  95.    If GNAT_ENTITY is a variable or a constant declaration, GNU_EXPR gives its
  96.    initial value (in GCC tree form). This is optional for variables.
  97.    For renamed entities, GNU_EXPR gives the object being renamed.
  98.  
  99.    DEFINITION is nonzero if this call is intended for a definition.  This is
  100.    used for separate compilation where it necessary to know whether an
  101.    external declaration or a definition should be created if the GCC equivalent
  102.    was not created previously.  The value of 1 is normally used for a non-zero
  103.    DEFINITION, but a value of 2 is used in special circumstances, defined in
  104.    the code.  */
  105.  
  106. tree
  107. gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
  108.      Entity_Id gnat_entity;
  109.      tree gnu_expr;
  110.      int definition;
  111. {
  112.   char *entity_name;
  113.   tree gnu_type;
  114.   /* Contains the gnu XXXX_DECL tree node which is equivalent to the input
  115.      GNAT tree. This node will be associated with the GNAT node by calling
  116.      the save_gnu_tree routine at the end of the `switch' statement.  */
  117.   tree gnu_decl = 0;
  118.   /* Nonzero if we have already saved gnu_decl as a gnat association.  */
  119.   int saved = 0;
  120.   /* Nonzero if we were already in permanent allocation.  */
  121.   int was_permanent = ! allocation_temporary_p ();
  122.   /* Nonzero if we were in momentary allocation.  */
  123.   int was_momentary;
  124.   /* Nonzero if we incremented defer_incomplete_level.  */
  125.   int this_deferred = 0;
  126.   Entity_Kind kind = Ekind (gnat_entity);
  127.  
  128.   /* If this is entity 0, something went badly wrong.  */
  129.   if (gnat_entity == 0)
  130.     gigi_abort (102);
  131.  
  132.   /* If we've already processed this entity, return what we got last time.
  133.      If we are defining the node, we should not have already processed it.
  134.      In that case, we will abort below when we try to save a new GCC tree for
  135.      this object.
  136.  
  137.      We make an exception here for subprograms since we may have processed
  138.      both the spec and body, depending on the circumstances.  This is a
  139.      bit of a kludge, but we are only using the kludge to disable an error
  140.      check, so it's not too bad.
  141.  
  142.      We also need to handle the case of getting a dummy type when a
  143.      Full_View exists.  */
  144.  
  145.   if ((! definition || kind == E_Function || kind == E_Procedure)
  146.       && present_gnu_tree (gnat_entity))
  147.     {
  148.       gnu_decl = get_gnu_tree (gnat_entity);
  149.  
  150.       if (TREE_CODE (gnu_decl) == TYPE_DECL
  151.       && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
  152.       && IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
  153.       && Present (Full_View (gnat_entity)))
  154.     {
  155.       gnu_decl = get_gnu_tree (Full_View (gnat_entity));
  156.       save_gnu_tree (gnat_entity, NULL_TREE, 0);
  157.       save_gnu_tree (gnat_entity, gnu_decl, 0);
  158.     }
  159.  
  160.       return gnu_decl;
  161.     }
  162.  
  163.   /* Get the name of the entity and set up the line number and filename of
  164.      the original definition for use in any decl we make.  */
  165.   entity_name = Get_Name_String (Chars (gnat_entity));
  166.   set_lineno (gnat_entity, 0);
  167.  
  168.   /* If we are not defining this node, it is external and must be
  169.      permanently allocated.  If we are not already in permanent
  170.      allocation, go there now.  Likewise if it is imported.  */
  171.   if ((! definition || Is_Imported (gnat_entity)) && ! was_permanent) 
  172.     {
  173.       push_obstacks_nochange ();
  174.       end_temporary_allocation ();
  175.  
  176.       if (Is_Public (gnat_entity))
  177.     /* When computing sizes, treat us as being at global level.  */
  178.     force_global++;
  179.     }
  180.  
  181.   /* Make sure objects we allocate aren't in the momentary obstack.  */
  182.   was_momentary = suspend_momentary ();
  183.  
  184.   switch (kind)
  185.     {
  186.     case E_Constant:
  187.       /* If this is a use of a deferred constant, get its full
  188.      declaration.  */
  189.       if (! definition && Present (Full_View (gnat_entity)))
  190.     {
  191.       gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
  192.                      gnu_expr, definition);
  193.       saved = 1;
  194.       break;
  195.     }
  196.  
  197.       /* If we have an external constant that we are not defining,
  198.      get the expression that is was defined to represent.  We
  199.      may throw that expression away later if it is not a
  200.      constant.  */
  201.       if (! definition && Present (Expression (Parent (gnat_entity)))
  202.       && ! Cannot_Be_Constant (Expression (Parent (gnat_entity))))
  203.     gnu_expr = gnat_to_gnu (Expression (Parent (gnat_entity)));
  204.  
  205.       /* Ignore deferred constant definitions; they are processed fully in the
  206.      front-end.  For deferred constant references, get the full
  207.          definition. On  the other hand,  constants that are renamings
  208.          are handled like variable renamings  */
  209.       if (definition && gnu_expr == 0
  210.       && No (Renamed_Object (gnat_entity)))
  211.     return error_mark_node;
  212.       else if (! definition && IN (Ekind (gnat_entity),
  213.                    Incomplete_Or_Private_Kind)
  214.            && Present (Full_View (gnat_entity)))
  215.     {
  216.       gnu_decl =  gnat_to_gnu_entity (Full_View (gnat_entity),
  217.                       NULL_TREE, 0);
  218.       saved = 1;
  219.       break;
  220.     }
  221.  
  222.       goto object;
  223.  
  224.     case E_Discriminant:
  225.     case E_Component:
  226.       /* If the variable is an inherited record component (in the case of
  227.      extended record types) just return the inherited entity, which
  228.      must be a FIELD_DECL.  */
  229.       if (Present (Original_Record_Component (gnat_entity))
  230.       && Original_Record_Component (gnat_entity) != gnat_entity)
  231.     {
  232.       gnu_decl
  233.         = gnat_to_gnu_entity (Original_Record_Component (gnat_entity),
  234.                   gnu_expr, definition);
  235.       saved = 1;
  236.       break;
  237.     }
  238.  
  239.       /* Otherwise, if we are not defining this and we have no GCC type
  240.      for the containing record, make one for it.  Then we should
  241.      have made our own equivalent.  Otherwise, abort.  */
  242.       else if (! definition && ! present_gnu_tree (Scope (gnat_entity)))
  243.     {
  244.       gnat_to_gnu_entity (Scope (gnat_entity), NULL_TREE, 0);
  245.       return get_gnu_tree (gnat_entity);
  246.     }
  247.  
  248.       else
  249.     gigi_abort (103);
  250.  
  251.     case E_Loop_Parameter:
  252.     case E_Out_Parameter:
  253.     case E_Exception:
  254.     case E_Variable:
  255.  
  256.       /* Simple variables, loop variables, OUT parameters, and exceptions.  */
  257.     object:
  258.       {
  259.     tree gnu_type;
  260.     int used_by_ref = 0;
  261.     int const_flag
  262.       = (kind == E_Constant && ! Is_Aliased (gnat_entity)
  263.          && ! Is_Aliased (Etype (gnat_entity))
  264.          && ((Present (Expression (Parent (gnat_entity)))
  265.           && ! Cannot_Be_Constant (Expression (Parent (gnat_entity))))
  266.          || (Present (Renamed_Object (gnat_entity))
  267.              && ! Cannot_Be_Constant (Renamed_Object (gnat_entity)))));
  268.  
  269.     tree gnu_size = NULL_TREE;
  270.     char *ext_name = NULL;
  271.     int size;
  272.  
  273.     /* If GNU_EXPR may be in the momentary obstack, make sure we don't
  274.        free it if this is a constant or a renaming.  */
  275.     if (was_momentary && gnu_expr != 0
  276.         && (const_flag || Present (Renamed_Object (gnat_entity))))
  277.       preserve_momentary ();
  278.  
  279.     if (Present (Renamed_Object (gnat_entity))
  280.         && ! definition)
  281.       gnu_expr = gnat_to_gnu (Renamed_Object (gnat_entity));
  282.  
  283.     /* Get the type after elaborating the renamed object.  */
  284.     gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  285.  
  286.     /* If we get here, it means we have not yet done anything with this
  287.        entity.  If we are not defining it here, it must be external,
  288.        otherwise we should have defined it already.  Also, reject
  289.        non-renamed objects whose types are unconstrained arrays or 
  290.        any object whose type is a dummy type or VOID_TYPE. */
  291.  
  292.     if ((! definition && ! Is_Public (gnat_entity))
  293.         || (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
  294.         && No (Renamed_Object (gnat_entity)))
  295.         || TYPE_IS_DUMMY_P (gnu_type)
  296.         || TREE_CODE (gnu_type) == VOID_TYPE)
  297.       gigi_abort (104);
  298.  
  299.     /* Make a volatile version of this object's type if we are to
  300.        make the object volatile.  */
  301.     if (Is_Volatile (gnat_entity) && ! TYPE_VOLATILE (gnu_type))
  302.       gnu_type = build_type_variant (gnu_type, 0, 1);
  303.  
  304.     /* See if this is a renaming.  If it is, see what we are renaming.
  305.        If what we are renaming is a decl, just return that decl for
  306.        us as well.  If the renamed object is a constant, we are a
  307.        constant as well. Otherwise, make this into a constant pointer to
  308.        the object we are to rename.  An initializer is invalid here.
  309.  
  310.        However, if this is a constant and the "renamed object" is a
  311.        constant, just treat this as that constant also.  */
  312.  
  313.     if (Present (Renamed_Object (gnat_entity))
  314.         && ! (const_flag && TREE_CONSTANT (gnu_expr)))
  315.       {
  316.         if (TREE_CODE_CLASS (TREE_CODE (gnu_expr)) == 'd')
  317.           {
  318.         gnu_decl = gnu_expr;
  319.         break;
  320.           }
  321.         else if (TREE_CODE_CLASS (TREE_CODE (gnu_expr)) == 'c'
  322.              || TREE_CODE (gnu_expr) == CALL_EXPR)
  323.           const_flag = 1;
  324.         else
  325.           {
  326.         const_flag = 1;
  327.         gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
  328.         gnu_type = build_pointer_type (gnu_type);
  329.         used_by_ref = 1;
  330.           }
  331.       }
  332.  
  333.     /* If this is an aliased object whose nominal subtype is unconstrained,
  334.        make the object a record that contains both the template and
  335.        the object and set up an initializer for the object.  */
  336.     else if (Is_Aliased (gnat_entity)
  337.          && Is_Array_Type (Etype (gnat_entity))
  338.          && Has_U_Nominal_Subtype (gnat_entity))
  339.       {
  340.         tree gnu_fat
  341.           = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
  342.         tree gnu_temp_type
  343.           = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_fat))));
  344.         tree gnu_temp = build_template (gnu_temp_type, gnu_type,
  345.                         NULL_TREE);
  346.         tree gnu_record_type = make_node (RECORD_TYPE);
  347.         tree gnu_temp_field
  348.           = create_field_decl ("BOUNDS", gnu_temp_type,
  349.                    gnu_record_type, 0, -1, 0);
  350.         tree gnu_array_field
  351.           = create_field_decl ("ARRAY", gnu_type,
  352.                    gnu_record_type, 0, -1, 0);
  353.  
  354.         TYPE_NAME (gnu_record_type) = get_identifier (entity_name);
  355.         finish_record_type (gnu_record_type,
  356.                 chainon (chainon (NULL_TREE, gnu_temp_field),
  357.                      gnu_array_field),
  358.                 0, 0);
  359.         TYPE_CONTAINS_TEMPLATE_P (gnu_record_type) = 1;
  360.  
  361.  
  362.         if (gnu_expr)
  363.           gnu_expr
  364.         = build_constructor (gnu_record_type,
  365.                      tree_cons (gnu_temp_field, gnu_temp,
  366.                         tree_cons (gnu_array_field,
  367.                                convert (gnu_type,
  368.                                     gnu_expr),
  369.                                NULL_TREE)));
  370.         gnu_type = gnu_record_type;
  371.       }
  372.  
  373.     /* If we are defining the object, see if it has a Size value and
  374.        validate it if so.  */
  375.     if (definition && Has_Size_Clause (gnat_entity)
  376.         && (0 != (size = validate_size (Esize (gnat_entity), gnu_type,
  377.                         gnat_entity, 0))))
  378.       gnu_size = size_int (size);
  379.  
  380.     /* If we are defining the object and it has an Address clause we must
  381.        get the address expression from the saved GCC tree for the
  382.        object if the object has a Freeze_Node.  Otherwise, we elaborate
  383.        the address expression here since the front-end has guaranteed
  384.        in that case that the elaboration has no effects.  Note that
  385.        only the latter mechanism is currently in use.  */
  386.     if (definition && Present (Address_Clause (gnat_entity)))
  387.       {
  388.         tree gnu_address
  389.           = (present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity)
  390.         : gnat_to_gnu (Expression (Address_Clause (gnat_entity))));
  391.  
  392.         save_gnu_tree (gnat_entity, NULL_TREE, 0);
  393.  
  394.         if (gnu_size)
  395.           {
  396.         post_error ("both SIZE and ADDRESS specified for &",
  397.                 gnat_entity);
  398.         gnu_size = 0;
  399.           }
  400.  
  401.         gnu_type = build_pointer_type (gnu_type);
  402.         gnu_address = convert (gnu_type, gnu_address);
  403.         used_by_ref = 1;
  404.         const_flag = ! Is_Public (gnat_entity);
  405.  
  406.         /* If we don't have an initializing expression for the underlying
  407.            variable, the initializing expression for the pointer is the
  408.            specified address.  Otherwise, we have to make a COMPOUND_EXPR
  409.            to assign both the address and the initial value.  */
  410.         if (gnu_expr == 0)
  411.           gnu_expr = gnu_address;
  412.         else
  413.           gnu_expr
  414.         = build (COMPOUND_EXPR, gnu_type,
  415.              build_binary_op
  416.              (MODIFY_EXPR, NULL_TREE,
  417.               build_unary_op (INDIRECT_REF, NULL_TREE,
  418.                       gnu_address),
  419.               gnu_expr),
  420.              gnu_address);
  421.       }
  422.  
  423.     /* If it has an address clause and we are not defining it, mark it
  424.        as an indirect object.  */
  425.     if (! definition && Present (Address_Clause (gnat_entity)))
  426.       {
  427.         gnu_type = build_pointer_type (gnu_type);
  428.         used_by_ref = 1;
  429.         const_flag = 0;
  430.       }
  431.  
  432.     /* If the size of this object has not been specified but there is
  433.        an initial value that has a constant size, use it.  */
  434.     if (gnu_size == 0 && gnu_expr != 0
  435.         && TYPE_SIZE (TREE_TYPE (gnu_expr)) != 0
  436.         && TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_expr))) == INTEGER_CST)
  437.       gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr));
  438.  
  439.     /* If this object has self-referential size, it must be a
  440.        record with a default value.  We are supposed to allocate an
  441.        object of the maximum size in this case.  Note that the
  442.        resulting size may still be a variable, so this may end up with
  443.        an indirect allocation.  */
  444.  
  445.     if (TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST
  446.         && contains_placeholder_p (TYPE_SIZE (gnu_type)))
  447.       gnu_size = max_size (TYPE_SIZE (gnu_type), 1);
  448.  
  449.     /* If we are at top level and this object is of variable size,
  450.        make the actual type a hidden pointer to the real type and
  451.        make the initializer be a memory allocation and initialization.
  452.        Likewise for objects we aren't defining (presumed to be
  453.        external references from other packages), but there we do
  454.        not set up an initialization.  */
  455.  
  456.     if ((global_bindings_p () || ! definition)
  457.         && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST
  458.         && ! (gnu_size != 0 && TREE_CODE (gnu_size) == INTEGER_CST))
  459.       {
  460.         gnu_type = build_pointer_type (gnu_type);
  461.         used_by_ref = 1;
  462.  
  463.         if (definition)
  464.           gnu_expr = build_allocator (TREE_TYPE (gnu_type),
  465.                       gnu_expr, gnu_type, 0, 0);
  466.         else
  467.           gnu_expr = 0;
  468.       }
  469.  
  470.     /* If this is a pointer and it does not have an initializing
  471.        expression, initialize it to NULL.  */
  472.     if ((TREE_CODE (gnu_type) == POINTER_TYPE
  473.          || TYPE_FAT_POINTER_P (gnu_type))
  474.         && gnu_expr == 0)
  475.       gnu_expr = integer_zero_node;
  476.  
  477.     if (gnu_expr)
  478.       gnu_expr = convert (gnu_type, gnu_expr);
  479.  
  480.     if (Present (Interface_Name (gnat_entity))
  481.         || (Is_Public (gnat_entity) && ! Is_Imported (gnat_entity)))
  482.       ext_name = create_concat_name (gnat_entity, NULL_PTR);
  483.  
  484.     /* If the size is zero bytes, make it one byte since some linkers
  485.        have trouble with zero-sized objects.  */
  486.     if ((gnu_size != 0 && integer_zerop (gnu_size))
  487.         || integer_zerop (TYPE_SIZE (gnu_type)))
  488.       gnu_size = size_int (BITS_PER_UNIT);
  489.  
  490.     gnu_decl
  491.       = create_var_decl (entity_name, ext_name, gnu_type, gnu_expr,
  492.                  gnu_size,
  493.                  (Has_Alignment_Clause (gnat_entity)
  494.                   ? (validate_alignment
  495.                  (Expression (Alignment_Clause (gnat_entity)),
  496.                   TYPE_ALIGN (gnu_type)))
  497.                   : 0),
  498.                  const_flag, Is_Public (gnat_entity), 
  499.                  Is_Imported (gnat_entity) || !definition,
  500.                  kind == E_Exception);
  501.  
  502.     DECL_BY_REF_P (gnu_decl) = used_by_ref;
  503.     DECL_POINTS_TO_READONLY_P (gnu_decl)
  504.       = used_by_ref && kind == E_Constant;
  505.  
  506.     /* If this is an exported constant and we're not making a VAR_DECL
  507.        for it, make one just for export use.  */
  508.     if (definition && Is_Exported (gnat_entity)
  509.         && TREE_CODE (gnu_decl) == CONST_DECL && ! used_by_ref)
  510.       create_var_decl (entity_name, ext_name, gnu_type, gnu_expr,
  511.                gnu_size,
  512.                (Has_Alignment_Clause (gnat_entity)
  513.                 ? (validate_alignment
  514.                    (Expression (Alignment_Clause (gnat_entity)),
  515.                 TYPE_ALIGN (gnu_type)))
  516.                 : 0),
  517.                0, 1, 0, 0);
  518.  
  519.     /* If this is declared in a block that contains an block with an
  520.        exception handler, we must force this variable in memory to
  521.        suppress an invalid optimization.  */
  522.     if (Has_Nested_Block_With_Handler (Scope (gnat_entity)))
  523.       mark_addressable (gnu_decl);
  524.       }
  525.       break;
  526.  
  527.     case E_Named_Integer:
  528.     case E_Named_Real:
  529.       /* These should not be present in any part of the tree we look at.  */
  530.       gigi_abort (106);
  531.  
  532.     case E_Void:
  533.       /* Return a TYPE_DECL for "void" that we previously made.  */
  534.       gnu_decl = void_type_decl_node;
  535.       break;
  536.  
  537.     case E_Enumeration_Type:
  538.       /* A special case, for the types Character and Wide_Character in
  539.          Standard, we do not list all the literals. So if the literals
  540.          are not specified, make this an unsigned type.  */
  541.       if (No (First_Literal (gnat_entity)))
  542.     {
  543.       gnu_type = make_unsigned_type (UI_To_Int (Esize (gnat_entity)));
  544.       break;
  545.     }
  546.  
  547.       /* Normal case of non-character type, or non-Standard character type */
  548.       {
  549.     /* Here we have a list of enumeral constants in First_Literal.
  550.        We make a CONST_DECL for each and build into GNU_LITERAL_LIST
  551.        the list to be places into TYPE_FIELDS.  Each node in the list
  552.        is a TREE_LIST node whose TREE_VALUE is the literal name
  553.        and whose TREE_PURPOSE is the value of the literal.
  554.  
  555.        Esize contains the number of bits needed to represent the enumeral
  556.        type, Type_Low_Bound also points to the first literal and
  557.        Type_High_Bound points to the last literal.  */
  558.  
  559.     Entity_Id gnat_literal;
  560.     tree gnu_literal_list = NULL_TREE;
  561.  
  562.     /* Make a signed type if the representation of the first literal
  563.        is negative; otherwise make an unsigned type.  */
  564.     if (tree_int_cst_lt (UI_To_gnu
  565.                  (Enumeration_Rep (First_Literal (gnat_entity)),
  566.                   integer_type_node),
  567.                  integer_zero_node))
  568.       gnu_type = make_signed_type (UI_To_Int (Esize (gnat_entity)));
  569.     else
  570.       gnu_type = make_unsigned_type (UI_To_Int (Esize (gnat_entity)));
  571.  
  572.     TREE_SET_CODE (gnu_type, ENUMERAL_TYPE);
  573.  
  574.     for (gnat_literal = First_Literal (gnat_entity);
  575.          Present (gnat_literal);
  576.          gnat_literal = Next_Literal (gnat_literal))
  577.       {
  578.         tree gnu_value = UI_To_gnu (Enumeration_Rep (gnat_literal),
  579.                     gnu_type);
  580.         tree gnu_literal
  581.           = create_var_decl (Get_Name_String (Chars (gnat_literal)),
  582.                  0, gnu_type, gnu_value,
  583.                  NULL_TREE, 0,
  584.                  1, 0, 0, 0);
  585.  
  586.         save_gnu_tree (gnat_literal, gnu_literal, 0);
  587.         gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
  588.                       gnu_value, gnu_literal_list);
  589.       }
  590.  
  591.     TYPE_FIELDS (gnu_type) = nreverse (gnu_literal_list);
  592.  
  593.     /* We have to be very careful here that we don't get an infinite
  594.        recursion when we get the bounds of this type, since those bounds
  595.        are objects of this type.  So set up a temporary definition now
  596.        and update the precise type later.   */
  597.     gnu_decl = create_type_decl (entity_name, gnu_type);
  598.     TYPE_STUB_DECL (gnu_type) = gnu_decl;
  599.     save_gnu_tree (gnat_entity, gnu_decl, 0);
  600.     saved = 1;
  601.  
  602.     TYPE_MIN_VALUE (gnu_type) = gnat_to_gnu (Type_Low_Bound (gnat_entity));
  603.     TYPE_MAX_VALUE (gnu_type)
  604.       = gnat_to_gnu (Type_High_Bound (gnat_entity));
  605.  
  606.     rest_of_type_compilation (gnu_type, global_bindings_p ());
  607.  
  608.     /* If we have an enumeration table and we are defining this
  609.        type, declare the enumeration table.  */
  610.     if (definition && Present (Lit_Name_Table (gnat_entity)))
  611.       gnat_to_gnu_entity
  612.         (Lit_Name_Table (gnat_entity),
  613.          create_enum_initializer
  614.          (gnat_entity,
  615.           gnat_to_gnu_type (Etype (Lit_Name_Table (gnat_entity)))),
  616.          1);
  617.       }
  618.       break;
  619.  
  620.     case E_Signed_Integer_Type:
  621.     case E_Ordinary_Fixed_Point_Type:
  622.     case E_Decimal_Fixed_Point_Type:
  623.       /* For integer types, just make a signed type the appropriate number
  624.      of bits.  */
  625.       if (Esize (gnat_entity) == 0)
  626.     gigi_abort (107);
  627.  
  628.       gnu_type = make_signed_type (UI_To_Int (Esize (gnat_entity)));
  629.       break;
  630.  
  631.     case E_Modular_Integer_Type:
  632.       /* For modular types, make the unsigned type of the proper number of
  633.      bits and then set up the modulus, if required.  */
  634.       {
  635.     int esize;
  636.     enum machine_mode mode;
  637.     tree gnu_modulus;
  638.     tree gnu_high = 0;
  639.  
  640.     if (Esize (gnat_entity) == 0)
  641.       gigi_abort (108);
  642.  
  643.     /* Find the smallest mode at least ESIZE bits wide and make a class
  644.        using that mode.  */
  645.  
  646.     esize = UI_To_Int (Esize (gnat_entity));
  647.     for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT);
  648.          GET_MODE_BITSIZE (mode) < esize;
  649.          mode = GET_MODE_WIDER_MODE (mode))
  650.       ;
  651.  
  652.     gnu_type = make_unsigned_type (GET_MODE_BITSIZE (mode));
  653.  
  654.     /* Get the modulus in this type.  If it overflows, assume it is because
  655.        it is equal to 2**Esize.  Note that there is no overflow checking
  656.        done on unsigned type, so we detect the overflow by looking for
  657.        a modulus of zero, which is otherwise invalid.  */
  658.     gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
  659.  
  660.     if (! integer_zerop (gnu_modulus))
  661.       {
  662.         TYPE_MODULAR_P (gnu_type) = 1;
  663.         TYPE_MODULUS (gnu_type) = gnu_modulus;
  664.         gnu_high = fold (build (MINUS_EXPR, gnu_type, gnu_modulus,
  665.                     convert (gnu_type, integer_one_node)));
  666.       }
  667.  
  668.     /* If we have to set TYPE_PRECISION different from its natural value,
  669.        make a subtype to do do.  Likewise if there is a modulus and
  670.        it is not one greater than TYPE_MAX_VALUE.  */
  671.     if (TYPE_PRECISION (gnu_type) != esize
  672.         || (TYPE_MODULAR_P (gnu_type)
  673.         && ! tree_int_cst_equal (TYPE_MAX_VALUE (gnu_type), gnu_high)))
  674.       {
  675.         tree gnu_subtype = make_node (INTEGER_TYPE);
  676.  
  677.         TREE_TYPE (gnu_subtype) = gnu_type;
  678.         TYPE_MIN_VALUE (gnu_subtype) = TYPE_MIN_VALUE (gnu_type);
  679.         TYPE_MAX_VALUE (gnu_subtype)
  680.           = TYPE_MODULAR_P (gnu_type)
  681.         ? gnu_high : TYPE_MAX_VALUE (gnu_type);
  682.         TYPE_PRECISION (gnu_subtype) = esize;
  683.         TREE_UNSIGNED (gnu_subtype) = 1;
  684.         TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
  685.         layout_type (gnu_subtype);
  686.  
  687.         gnu_type = gnu_subtype;
  688.       }
  689.       }
  690.       break;
  691.  
  692.     case E_Signed_Integer_Subtype:
  693.     case E_Enumeration_Subtype:
  694.     case E_Modular_Integer_Subtype:
  695.     case E_Ordinary_Fixed_Point_Subtype:
  696.     case E_Decimal_Fixed_Point_Subtype:
  697.       /* For integral subtypes, we make a new INTEGER_TYPE.  Note
  698.      that we do not want to call build_range_type since we would
  699.      like each subtype node to be distinct.  This will be important
  700.      when memory aliasing is implemented.
  701.  
  702.      The TREE_TYPE field of the INTEGER_TYPE we make points to the
  703.      parent type; this fact is used by the arithmetic conversion
  704.      functions.  */
  705.  
  706.       gnu_type = make_node (INTEGER_TYPE);
  707.       TREE_TYPE (gnu_type) = gnat_to_gnu_type (Etype (gnat_entity));
  708.       TYPE_PRECISION (gnu_type) = UI_To_Int (Esize (gnat_entity));
  709.  
  710.       TYPE_MIN_VALUE (gnu_type)
  711.     = convert (TREE_TYPE (gnu_type),
  712.            elaborate_expression (Type_Low_Bound (gnat_entity),
  713.                      gnat_entity, "L", definition, 1));
  714.  
  715.       TYPE_MAX_VALUE (gnu_type)
  716.     = convert (TREE_TYPE (gnu_type),
  717.            elaborate_expression (Type_High_Bound (gnat_entity),
  718.                      gnat_entity, "U", definition, 1));
  719.  
  720.       /* This shold be an unsigned type if the lower bound is constant
  721.      and non-negative or if the base type is unsigned; a signed type
  722.      otherwise.    */
  723.       TREE_UNSIGNED (gnu_type)
  724.     = (TREE_UNSIGNED (TREE_TYPE (gnu_type))
  725.        || (TREE_CODE (TYPE_MIN_VALUE (gnu_type)) == INTEGER_CST
  726.            && TREE_INT_CST_HIGH (TYPE_MIN_VALUE (gnu_type)) >= 0));
  727.  
  728.       layout_type (gnu_type);
  729.       break;
  730.  
  731.     case E_Floating_Point_Type:
  732.       if (Esize (gnat_entity) == 0)
  733.     gigi_abort (109);
  734.  
  735.       gnu_type = make_node (REAL_TYPE);
  736.       TYPE_PRECISION (gnu_type) = UI_To_Int (Esize (gnat_entity));
  737.       layout_type (gnu_type);
  738.  
  739.       /* The type of the Low and High bounds can be our type if this is
  740.      a type from Standard, so complete the type first, then set the
  741.      bounds.  */
  742.       gnu_decl = create_type_decl (entity_name, gnu_type);
  743.       save_gnu_tree (gnat_entity, gnu_decl, 0);
  744.       saved = 1;
  745.  
  746.       TYPE_MIN_VALUE (gnu_type)
  747.     = convert (gnu_type,
  748.            elaborate_expression (Type_Low_Bound (gnat_entity),
  749.                      gnat_entity, "L", definition, 1));
  750.  
  751.       TYPE_MAX_VALUE (gnu_type)
  752.     = convert (gnu_type,
  753.            elaborate_expression (Type_High_Bound (gnat_entity),
  754.                      gnat_entity, "U", definition, 1));
  755.  
  756.  
  757.       break;
  758.  
  759.     case E_Floating_Point_Subtype:
  760.       gnu_type = make_node (REAL_TYPE);
  761.       TREE_TYPE (gnu_type) = gnat_to_gnu_type (Etype (gnat_entity));
  762.       TYPE_PRECISION (gnu_type) = UI_To_Int (Esize (gnat_entity));
  763.  
  764.       TYPE_MIN_VALUE (gnu_type)
  765.     = convert (TREE_TYPE (gnu_type),
  766.            elaborate_expression (Type_Low_Bound (gnat_entity),
  767.                      gnat_entity, "L", definition, 1));
  768.  
  769.       TYPE_MAX_VALUE (gnu_type)
  770.     = convert (TREE_TYPE (gnu_type),
  771.            elaborate_expression (Type_High_Bound (gnat_entity),
  772.                      gnat_entity, "U", definition, 1));
  773.  
  774.       layout_type (gnu_type);
  775.       break;
  776.  
  777.       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  778.       break;
  779.  
  780.     case E_Exception_Type:
  781.       /* This is just a character.  */
  782.       gnu_type = char_type_node;
  783.       break;
  784.  
  785.       /* Array and String Types and Subtypes
  786.  
  787.      Unconstrained array types are represented by E_Array_Type and
  788.      constrained array types are represented by E_Array_Subtype.  There
  789.      are no actual objects of an unconstrained array type; all we have
  790.      are pointers to that type.
  791.  
  792.      The following fields are defined on array types and subtypes:
  793.  
  794.         Component_Type     Component type of the array.
  795.         Number_Dimensions  Number of dimensions (an int).
  796.         First_Index       Type of first index.  */
  797.  
  798.     case E_String_Type:
  799.     case E_Array_Type:
  800.       {
  801.     tree gnu_template_fields = NULL_TREE;
  802.     tree gnu_template_type = make_node (RECORD_TYPE);
  803.     tree gnu_ptr_template = build_pointer_type (gnu_template_type);
  804.     tree gnu_fat_type = make_node (RECORD_TYPE);
  805.     int ndim = Number_Dimensions (gnat_entity);
  806.     int firstdim
  807.       = (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0;
  808.     int nextdim
  809.       = (Convention (gnat_entity) == Convention_Fortran) ? - 1 : 1;
  810.     tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree *));
  811.     int index;
  812.     Entity_Id gnat_ind_subtype;
  813.     tree gnu_template_reference;
  814.     tree tem;
  815.  
  816.     TYPE_NAME (gnu_template_type) = get_identifier ("BOUNDS");
  817.     TYPE_NAME (gnu_fat_type) = get_identifier (entity_name);
  818.     TREE_READONLY (gnu_template_type) = 1;
  819.  
  820.     /* Make a node for the array.  If we are not defining the array
  821.        suppress expanding incomplete types and save the node as the type
  822.        for GNAT_ENTITY.  */
  823.     gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE);
  824.     if (! definition)
  825.       {
  826.         defer_incomplete_level++;
  827.         this_deferred = 1;
  828.         gnu_decl = create_type_decl (entity_name, gnu_type);
  829.         save_gnu_tree (gnat_entity, gnu_decl, 0);
  830.         saved = 1;
  831.       }
  832.  
  833.     /* Build the fat pointer type.  Use a "void *" object instead of
  834.        a pointer to the array type since we don't have the array type
  835.        yet (it will reference the fat pointer via the bounds).  */
  836.     tem = chainon (chainon (NULL_TREE,
  837.                 create_field_decl ("P_ARRAY",
  838.                            ptr_void_type_node,
  839.                            gnu_fat_type, 0, -1, 0)),
  840.                create_field_decl ("P_BOUNDS",
  841.                       gnu_ptr_template,
  842.                       gnu_fat_type, 0, -1, 0));
  843.  
  844.     /* Make sure we can put this into a register.  */
  845.     TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
  846.     finish_record_type (gnu_fat_type, tem, 0, 1);
  847.  
  848.     /* Build a reference to the template from a PLACEHOLDER_EXPR that
  849.        is the fat pointer.  This will be used to access the individual
  850.        fields once we build them.  */
  851.     tem = build (COMPONENT_REF, gnu_ptr_template,
  852.              build (PLACEHOLDER_EXPR, gnu_fat_type),
  853.              TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
  854.     TREE_READONLY (tem) = 1;
  855.  
  856.     gnu_template_reference
  857.       = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
  858.  
  859.     /* Now create the GCC type for each index and add the fields for
  860.        that index to the template.  */
  861.     for (index = firstdim, gnat_ind_subtype = First_Index (gnat_entity);
  862.          index < ndim && index >= 0;
  863.          index += nextdim,
  864.          gnat_ind_subtype = Next_Index (gnat_ind_subtype))
  865.       {
  866.         char field_name[10];
  867.         tree gnu_ind_subtype
  868.           = gnat_to_gnu_type (Base_Type (Etype (gnat_ind_subtype)));
  869.         tree gnu_min_field, gnu_max_field, gnu_min, gnu_max;
  870.  
  871.         /* Make the FIELD_DECLs for the minimum and maximum of this
  872.            type and then make extractions of that field from the
  873.            template.  */
  874.         sprintf (field_name, "LB%d", index);
  875.         gnu_min_field = create_field_decl (field_name, gnu_ind_subtype,
  876.                            gnu_template_type, 0, -1, 0);
  877.         field_name[0] = 'U';
  878.         gnu_max_field = create_field_decl (field_name, gnu_ind_subtype,
  879.                            gnu_template_type, 0, -1, 0);
  880.  
  881.         gnu_template_fields
  882.           = chainon (chainon (gnu_template_fields, gnu_min_field),
  883.              gnu_max_field);
  884.  
  885.         /* We can't use build_component_ref here since the template
  886.            type isn't complete yet.  */
  887.         gnu_min = build (COMPONENT_REF, gnu_ind_subtype,
  888.                  gnu_template_reference, gnu_min_field);
  889.         gnu_max = build (COMPONENT_REF, gnu_ind_subtype,
  890.                  gnu_template_reference, gnu_max_field);
  891.         TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
  892.  
  893.         /* Make a range type with the new ranges, but using
  894.            the Ada subtype.  Then we convert to sizetype.  */
  895.         gnu_index_types[index]
  896.           = create_index_type (convert (sizetype, gnu_min),
  897.                    convert (sizetype, gnu_max),
  898.                    build_range_type (gnu_ind_subtype,
  899.                              gnu_min, gnu_max));
  900.       }
  901.  
  902.     /* Install all the fields into the template.  */
  903.     finish_record_type (gnu_template_type, gnu_template_fields, 0, 0);
  904.     TREE_READONLY (gnu_template_type) = 1;
  905.  
  906.     /* Now make the array of arrays and update the pointer to the array
  907.        in the fat pointer.  Note that it is the first field.  */
  908.  
  909.     tem = gnat_to_gnu_type (Component_Type (gnat_entity));
  910.  
  911.     /* If the component type is a RECORD_TYPE that has a self-referential
  912.        size, make a new RECORD_TYPE whose size is the maximum.  */
  913.     if (TREE_CODE (tem) == RECORD_TYPE
  914.         && TREE_CODE (TYPE_SIZE (tem)) != INTEGER_CST
  915.         && contains_placeholder_p (TYPE_SIZE (tem)))
  916.       {
  917.         tem = gnat_substitute_in_type (tem, NULL_TREE, NULL_TREE);
  918.         TYPE_SIZE (tem) = max_size (TYPE_SIZE (tem), 1);
  919.         TYPE_COMPONENT_MAX_TYPE_P (tem) = 1;
  920.       }
  921.  
  922.     if (Has_Volatile_Components (gnat_entity))
  923.       tem = build_type_variant (tem, 0, 1);
  924.  
  925.     for (index = ndim - 1; index >= 0; index--)
  926.       {
  927.         tem = build_array_type (tem, gnu_index_types[index]);
  928.         TYPE_MULTI_ARRAY_P (tem) = (index > 0);
  929.       }
  930.  
  931.     TYPE_ALIGN_OK_P (tem) = Is_Packed (gnat_entity);
  932.     TYPE_CONVENTION_FORTRAN_P (tem)
  933.       = (Convention (gnat_entity) == Convention_Fortran);
  934.     TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
  935.     TYPE_FAT_POINTER_P (gnu_fat_type) = 1;
  936.     rest_of_type_compilation (gnu_fat_type, global_bindings_p ());
  937.  
  938.     /* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the
  939.        corresponding fat pointer.  */
  940.     TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_fat_type;
  941.     TYPE_MODE (gnu_type) = BLKmode;
  942.     TYPE_ALIGN (gnu_type) = TYPE_ALIGN (tem);
  943.     TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type) = gnu_type;
  944.       }
  945.       break;
  946.  
  947.     case E_String_Subtype:
  948.     case E_Array_Subtype:
  949.       /* This is the actual data type for array variables.  Multidimensional
  950.      arrays are implemented in the gnu tree as arrays of arrays.  Note
  951.      that for the moment arrays which have sparse enumeration subtypes as
  952.      index components create sparse arrays, which is obviously space
  953.      inefficient but so much easier to code for now.
  954.  
  955.      Also note that the subtype never refers to the unconstrained
  956.      array type, which is somewhat at variance with Ada semantics.
  957.  
  958.      First check to see if this is simply a renaming of the array
  959.      type.  If so, the result is the array type.  */
  960.       if (! Is_Constrained (gnat_entity))
  961.     gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  962.       else if (Present (Packed_Array_Type (gnat_entity)))
  963.     {
  964.       gnu_type = gnat_to_gnu_type (Packed_Array_Type (gnat_entity));
  965.  
  966.       /* We need to point the type we just made to our index type so
  967.          the actual bounds can be put into a template.  For now,
  968.          only bother with this for one dimension.  */
  969.       if (Number_Dimensions (gnat_entity) != 1)
  970.         gigi_abort (105);
  971.  
  972.       TYPE_ACTUAL_BOUNDS (gnu_type)
  973.         = gnat_to_gnu_type (Etype (First_Index (gnat_entity)));
  974.     }
  975.       else
  976.     {
  977.       int index;
  978.       int array_dim = Number_Dimensions (gnat_entity);
  979.       int first_dim
  980.         = ((Convention (gnat_entity) == Convention_Fortran)
  981.            ? array_dim - 1 : 0);
  982.       int next_dim
  983.         = (Convention (gnat_entity) == Convention_Fortran) ? -1 : 1;
  984.       Entity_Id gnat_ind_subtype;
  985.       tree *gnu_index_type = (tree *) alloca (array_dim * sizeof (tree *));
  986.  
  987.       /* First create the gnu types for each index.  */
  988.  
  989.       for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity);
  990.            index < array_dim && index >= 0;
  991.            index += next_dim,
  992.            gnat_ind_subtype = Next_Index (gnat_ind_subtype))
  993.         {
  994.           tree gnu_index_subtype
  995.         = gnat_to_gnu_type (Etype (gnat_ind_subtype));
  996.           tree gnu_min
  997.         = convert (sizetype, TYPE_MIN_VALUE (gnu_index_subtype));
  998.           tree gnu_max
  999.         = convert (sizetype, TYPE_MAX_VALUE (gnu_index_subtype));
  1000.  
  1001.           gnu_index_type[index]
  1002.         = create_index_type (gnu_min,
  1003.                      size_binop (MAX_EXPR, gnu_max,
  1004.                          size_binop (MINUS_EXPR,
  1005.                                  gnu_min,
  1006.                                  size_int (1))),
  1007.                      gnu_index_subtype);
  1008.         }
  1009.  
  1010.       /* Then flatten: create the array of arrays.  */
  1011.  
  1012.       gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity));
  1013.       if (Has_Volatile_Components (Base_Type (gnat_entity)))
  1014.         gnu_type = build_type_variant (gnu_type, 0, 1);
  1015.  
  1016.       /* If the component type is a RECORD_TYPE that has a self-referential
  1017.          size, make a new RECORD_TYPE whose size is the maximum.  */
  1018.       if (TREE_CODE (gnu_type) == RECORD_TYPE
  1019.           && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST
  1020.           && contains_placeholder_p (TYPE_SIZE (gnu_type)))
  1021.         {
  1022.           gnu_type
  1023.         = gnat_substitute_in_type (gnu_type, NULL_TREE, NULL_TREE);
  1024.           TYPE_SIZE (gnu_type) = max_size (TYPE_SIZE (gnu_type), 1);
  1025.           TYPE_COMPONENT_MAX_TYPE_P (gnu_type) = 1;
  1026.         }
  1027.  
  1028.       for (index = array_dim - 1; index >= 0; index --)
  1029.         {
  1030.           gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
  1031.           TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
  1032.         }
  1033.  
  1034.       TYPE_CONVENTION_FORTRAN_P (gnu_type)
  1035.         = (Convention (gnat_entity) == Convention_Fortran);
  1036.     }
  1037.       break;
  1038.  
  1039.     case E_String_Literal_Subtype:
  1040.       /* Create the type for a string literal. */
  1041.       {
  1042.     tree gnu_string_type = gnat_to_gnu_type (Etype (gnat_entity));
  1043.     tree gnu_string_array_type
  1044.       = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_string_type))));
  1045.     tree gnu_string_index_type
  1046.       = TREE_TYPE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_string_array_type)));
  1047.     tree gnu_lower_type
  1048.       = gnat_to_gnu_type (Etype (First_Index (Etype (gnat_entity))));
  1049.     tree gnu_lower_bound
  1050.       = convert (integer_type_node,
  1051.              TYPE_MIN_VALUE (gnu_lower_type));
  1052.     int length = UI_To_Int (String_Literal_Length (gnat_entity));
  1053.     tree gnu_upper_bound
  1054.       = fold (build (PLUS_EXPR, integer_type_node,
  1055.              fold (build (MINUS_EXPR, integer_type_node,
  1056.                       build_int_2 (length, 0),
  1057.                       integer_one_node)),
  1058.              gnu_lower_bound));
  1059.     tree gnu_range_type
  1060.       = build_range_type (gnu_string_index_type,
  1061.                   convert (gnu_string_index_type,
  1062.                        gnu_lower_bound),
  1063.                   convert (gnu_string_index_type,
  1064.                        gnu_upper_bound));
  1065.     tree gnu_index_type
  1066.       = create_index_type (convert (sizetype,
  1067.                     TYPE_MIN_VALUE (gnu_range_type)),
  1068.                    convert (sizetype,
  1069.                     TYPE_MAX_VALUE (gnu_range_type)),
  1070.                    gnu_range_type);
  1071.  
  1072.     gnu_type
  1073.       = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
  1074.                   gnu_index_type);
  1075.       }
  1076.       break;
  1077.  
  1078.     case E_Enum_Table_Type:
  1079.       /* Create the type for an enumeration literal table.  */
  1080.       {
  1081.     tree gnu_high_bound = gnat_to_gnu (Table_High_Bound (gnat_entity));
  1082.     tree gnu_range_type
  1083.       = build_range_type (TREE_TYPE (gnu_high_bound),
  1084.                   convert (TREE_TYPE (gnu_high_bound),
  1085.                        integer_zero_node),
  1086.                   gnu_high_bound);
  1087.     tree gnu_index_type
  1088.       = create_index_type (convert (sizetype,
  1089.                      TYPE_MIN_VALUE (gnu_range_type)),
  1090.                 convert (sizetype,
  1091.                      TYPE_MAX_VALUE (gnu_range_type)),
  1092.                    gnu_range_type);
  1093.  
  1094.     gnu_type
  1095.       = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
  1096.                   gnu_index_type);
  1097.       }
  1098.       break;
  1099.  
  1100.     /* Record Types and Subtypes
  1101.  
  1102.        The following fields are defined on record types:
  1103.  
  1104.         Has_Discriminants    True if the record has discriminants
  1105.         First_Discriminant    Points to head of list of discriminants
  1106.         First_Entity        Points to head of list of fields
  1107.         Is_Tagged_Type        True if the record is tagged
  1108.  
  1109.        Implementation of Ada records and discriminated records:
  1110.  
  1111.        A record type definition is transformed into the equivalent of a C
  1112.        struct definition.  The fields that are the discriminants which are
  1113.        found in the Full_Type_Declaration node and the elements of the
  1114.        Component_List found in the Record_Type_Definition node.  The
  1115.        Component_List can be a recursive structure since each Variant of
  1116.        the Variant_Part of the Component_List has a Component_List.
  1117.  
  1118.        Processing of a record type definition comprises starting the list of
  1119.        field declarations here from the discriminants and the calling the
  1120.        function components_to_record to add the rest of the fields from the
  1121.        component list and return the gnu type node. The function
  1122.        components_to_record will call itself recursively as it traverses
  1123.        the tree.  */
  1124.  
  1125.     case E_Record_Type:
  1126.       {
  1127.     Entity_Id gnat_impl_type;
  1128.         Node_Id full_definition = Parent (gnat_entity);
  1129.         Node_Id record_definition = Type_Definition (full_definition);
  1130.     Entity_Id gnat_field;
  1131.         tree gnu_field;
  1132.     char *field_id;
  1133.     tree gnu_field_type;
  1134.     tree gnu_field_list = NULL_TREE;
  1135.     int packed = Is_Packed (gnat_entity);
  1136.     int has_rep = Has_Specified_Layout (gnat_entity);
  1137.  
  1138.     /* If this is a record extension, go a level further to find the
  1139.        record definition */
  1140.     if (Nkind (record_definition) == N_Derived_Type_Definition)
  1141.       record_definition = Record_Extension_Part (record_definition);
  1142.  
  1143.     /* Make a node for the record.  If we are not defining the record,
  1144.        suppress expanding incomplete types and save the node as the type
  1145.        for GNAT_ENTITY.  */
  1146.     gnu_type = make_node (RECORD_TYPE);
  1147.     TYPE_NAME (gnu_type) = get_identifier (entity_name);
  1148.     if (! definition)
  1149.       {
  1150.         defer_incomplete_level++;
  1151.         this_deferred = 1;
  1152.         gnu_decl = create_type_decl (entity_name, gnu_type);
  1153.         save_gnu_tree (gnat_entity, gnu_decl, 0);
  1154.         saved = 1;
  1155.       }
  1156.  
  1157.     /* If both a size and rep clause was specified, put the size in
  1158.        the record type now so that it can get the proper mode.
  1159.        It's validity will have already been checked in this case.  */
  1160.     if (has_rep && Has_Size_Clause (gnat_entity)
  1161.         && UI_Is_In_Int_Range (Esize (gnat_entity)))
  1162.       TYPE_SIZE (gnu_type) = size_int (UI_To_Int (Esize (gnat_entity)));
  1163.  
  1164.     /* Likewise for alignment.  */
  1165.     if (has_rep && Has_Alignment_Clause (gnat_entity))
  1166.       TYPE_ALIGN (gnu_type)
  1167.         = validate_alignment (Expression (Alignment_Clause (gnat_entity)),
  1168.                   0);
  1169.  
  1170.     /* Add the fields for the discriminants into the record.  */
  1171.         if (Has_Discriminants (gnat_entity))
  1172.           {
  1173.         for (gnat_field = First_Discriminant (gnat_entity);
  1174.          Present (gnat_field);
  1175.          gnat_field = Next_Discriminant (gnat_field))
  1176.           {
  1177.         gnu_field = gnat_to_gnu_field (gnat_field, gnu_type,
  1178.                            packed, has_rep);
  1179.         DECL_DISCRIMINANT_P (gnu_field) = 1;
  1180.  
  1181.         /* Associate the FIELD_DECL node just created with the
  1182.            corresponding gnat defining identifier.  */
  1183.         save_gnu_tree (gnat_field, gnu_field, 0);
  1184.  
  1185.         gnu_field_list = chainon (gnu_field, gnu_field_list);
  1186.           }
  1187.       }
  1188.  
  1189.     /* Add the listed fields into the record and finish up.  */
  1190.     components_to_record (gnu_type, Component_List (record_definition),
  1191.                   gnu_field_list, packed, definition, has_rep, 1);
  1192.  
  1193.     TYPE_HAS_REP_CLAUSE_P (gnu_type) = has_rep;
  1194.  
  1195.     /* If it is a tagged record force the type to BLKmode to insure
  1196.        that these objects will always be placed in memory.
  1197.  
  1198.        ??? This is probably wrong and we need to understand
  1199.        precisely how we are using these types.  */
  1200.         if (Is_Tagged_Type (gnat_entity))
  1201.       TYPE_MODE (gnu_type) = BLKmode;
  1202.       }
  1203.       break;
  1204.  
  1205.     case E_Record_Subtype:
  1206.     case E_Private_Subtype:
  1207.     case E_Limited_Private_Subtype:
  1208.     case E_Record_Subtype_With_Private:
  1209.  
  1210.       /* Create the gnu subtype from the gnu type by calling
  1211.      substitute_in_type for each discriminant expresion.  This function
  1212.      returns a new tree from the type tree by substituting the discriminant
  1213.      expression for the subtype for the occurences of the discriminant in
  1214.      the base type definition.  We don't see any difference between
  1215.      private and nonprivate type here since derivations from types should
  1216.      have been deferred until the completion of the private type.  */
  1217.       {
  1218.     Node_Id gnat_discriminant_expr;
  1219.     Entity_Id gnat_field;
  1220.  
  1221.     if (! definition)
  1222.       defer_incomplete_level++, this_deferred = 1;
  1223.  
  1224.     gnu_type = TREE_TYPE (gnat_to_gnu_entity (Base_Type (gnat_entity),
  1225.                           NULL_TREE, 0));
  1226.  
  1227.     /* If the above call defined this entity (rare, but possible),
  1228.        we are done.  */
  1229.     if (present_gnu_tree (gnat_entity))
  1230.       {
  1231.         gnu_decl = get_gnu_tree (gnat_entity);
  1232.         saved = 1;
  1233.         break;
  1234.       }
  1235.  
  1236.     if (Is_Constrained (gnat_entity)
  1237.            && Present (Discriminant_Constraint (gnat_entity)))
  1238.       for (gnat_field
  1239.            = First_Discriminant (Underlying_Type (Base_Type (gnat_entity))),
  1240.            gnat_discriminant_expr
  1241.            = First_Elmt (Discriminant_Constraint (gnat_entity));
  1242.            Present (gnat_field);
  1243.            gnat_field = Next_Discriminant (gnat_field),
  1244.            gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
  1245.         /* ??? For now, ignore access discriminants.  */
  1246.         if (Nkind (Id_Of (gnat_discriminant_expr)) != N_Attribute_Reference
  1247.         || (Get_Attribute_Id (Attribute_Name (Id_Of (gnat_discriminant_expr)))
  1248.             != Attr_Access))
  1249.           gnu_type
  1250.         = gnat_substitute_in_type
  1251.           (gnu_type, get_gnu_tree (gnat_field),
  1252.            elaborate_expression (Id_Of (gnat_discriminant_expr),
  1253.                      gnat_entity,
  1254.                      Get_Name_String (Chars (gnat_field)),
  1255.                      definition, 1));
  1256.       }
  1257.       break;
  1258.  
  1259.     case E_Access_Type:
  1260.     case E_Anonymous_Access_Type:
  1261.     case E_Access_Subprogram_Type:
  1262.     case E_Allocator_Type:
  1263.     case E_General_Access_Type:
  1264.       {
  1265.     Entity_Id gnat_desig_type = Directly_Designated_Type (gnat_entity);
  1266.  
  1267.     /* if we have a pointer to a class type and the type itself is
  1268.        incomplete, we need the same mechanism as for incomplete types */
  1269.  
  1270.     if (Is_Class_Wide_Type (gnat_desig_type)
  1271.         && (IN (Ekind (Etype (gnat_desig_type)),
  1272.             Incomplete_Or_Private_Kind)))
  1273.       gnat_desig_type = Etype (gnat_desig_type);
  1274.  
  1275.     /* If we are pointing to an incomplete type whose completion is an
  1276.        unconstrained array, make a fat pointer type instead of a pointer
  1277.        to VOID.  The two types in our fields will be pointers to VOID and
  1278.        will be replaced in update_pointer_to.  Similiarly, if the type
  1279.        itself is a dummy type or an unconstrained array.  */
  1280.  
  1281.     if ((IN (Ekind (gnat_desig_type), Incomplete_Or_Private_Kind)
  1282.          && Present (Full_View (gnat_desig_type))
  1283.          && Is_Array_Type (Full_View (gnat_desig_type))
  1284.          && ! Is_Constrained (Full_View (gnat_desig_type)))
  1285.         || (present_gnu_tree (gnat_desig_type)
  1286.         && TYPE_IS_DUMMY_P (TREE_TYPE (get_gnu_tree (gnat_desig_type)))
  1287.         && Is_Array_Type (gnat_desig_type)
  1288.         && ! Is_Constrained (gnat_desig_type)))
  1289.       {
  1290.         tree gnu_old = gnat_to_gnu_type (gnat_desig_type);
  1291.         tree fields;
  1292.  
  1293.         /* If the call above got something that has a pointer, that
  1294.            pointer is our type.  This could have happened either
  1295.            because the type was elaborated or because somebody
  1296.            else executed the code below.  */
  1297.         gnu_type = TYPE_POINTER_TO (gnu_old);
  1298.         if (gnu_type != 0)
  1299.           break;
  1300.  
  1301.         gnu_type = make_node (RECORD_TYPE);
  1302.         TYPE_NAME (gnu_type) = get_identifier (entity_name);
  1303.         TYPE_UNCONSTRAINED_ARRAY (gnu_type) = gnu_old;
  1304.         TYPE_POINTER_TO (gnu_old) = gnu_type;
  1305.  
  1306.         fields = chainon (chainon (NULL_TREE,
  1307.                        create_field_decl ("P_ARRAY",
  1308.                               ptr_void_type_node,
  1309.                               gnu_type, 0, -1, 0)),
  1310.                   create_field_decl ("P_BOUNDS",
  1311.                          ptr_void_type_node,
  1312.                          gnu_type, 0, -1, 0));
  1313.  
  1314.         /* Make sure we can place this into a register.  */
  1315.         TYPE_ALIGN (gnu_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
  1316.         finish_record_type (gnu_type, fields, 0, 1);
  1317.         TYPE_FAT_POINTER_P (gnu_type) = 1;
  1318.       }
  1319.  
  1320.     /* Get the type of the thing we are to point to and build a pointer
  1321.        to it.  If it is a reference to an incomplete or private type with a
  1322.        full view that is a record, make a dummy type node and get the
  1323.        actual type later when we have verified it is safe.  We must be sure
  1324.        we elaborate the full view if it is an unconstrained array.  */
  1325.     else if (! definition
  1326.          && ! present_gnu_tree (gnat_desig_type)
  1327.          && IN (Ekind (gnat_desig_type), Incomplete_Or_Private_Kind)
  1328.          && Present (Full_View (gnat_desig_type))
  1329.          && ! present_gnu_tree (Full_View (gnat_desig_type))
  1330.          && Is_Record_Type (Full_View (gnat_desig_type)))
  1331.       gnu_type = build_pointer_type (make_dummy_type (gnat_desig_type));
  1332.     else if (gnat_desig_type == gnat_entity)
  1333.       {
  1334.         gnu_type = build_pointer_type (make_node (VOID_TYPE));
  1335.         TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
  1336.       }
  1337.     else
  1338.       gnu_type = build_pointer_type (gnat_to_gnu_type (gnat_desig_type));
  1339.  
  1340.     /* It is possible that the above call to gnat_to_gnu_type resolved our
  1341.        type.  If so, just return it.  */
  1342.     if (present_gnu_tree (gnat_entity))
  1343.       {
  1344.         gnu_decl = get_gnu_tree (gnat_entity);
  1345.         saved = 1;
  1346.         break;
  1347.       }
  1348.  
  1349.     /* If this is a reference (not a definition) to an incomplete
  1350.        type, save our current definition, evaluate the actual type,
  1351.        and replace the tentative type we made with the actual one.
  1352.        If we are to defer actually looking up the actual type, make an
  1353.        entry in the deferred list.  */
  1354.  
  1355.     if (! definition
  1356.         && (IN (Ekind (gnat_desig_type), Incomplete_Or_Private_Kind))
  1357.         && Present (Full_View (gnat_desig_type)))
  1358.       {
  1359.         tree gnu_old_type
  1360.           = TYPE_FAT_POINTER_P (gnu_type)
  1361.         ? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type);
  1362.  
  1363.         gnu_decl = create_type_decl (entity_name, gnu_type);
  1364.         save_gnu_tree (gnat_entity, gnu_decl, 0);
  1365.         saved = 1;
  1366.  
  1367.         if (defer_incomplete_level == 0)
  1368.           update_pointer_to
  1369.         (gnu_old_type, gnat_to_gnu_type (Full_View (gnat_desig_type)));
  1370.         else
  1371.           {
  1372.         struct incomplete *p
  1373.           = (struct incomplete *) oballoc (sizeof (struct incomplete));
  1374.  
  1375.         p->old_type = gnu_old_type;
  1376.         p->full_type = Full_View (gnat_desig_type);
  1377.         p->next = defer_incomplete_list;
  1378.         defer_incomplete_list = p;
  1379.           }
  1380.       }
  1381.       }
  1382.       break;
  1383.  
  1384.     case E_Access_Subtype:
  1385.       /* We treat this as identical to its base type; any constraint is
  1386.      meaningful only to the front end.  */
  1387.       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  1388.       break;
  1389.  
  1390.     /* Subprogram Entities
  1391.  
  1392.        The following access functions are defined for subprograms (functions
  1393.        or procedures):
  1394.  
  1395.         First_Formal    The first formal parameter.
  1396.         Is_Imported     Indicates that the subprogram has appeared in
  1397.                 an INTERFACE or IMPORT pragma. For now we
  1398.                 assume that the external language is C.
  1399.         Is_Inlined      True if the subprogram is to be inlined.
  1400.  
  1401.        In addition for function subprograms we have:
  1402.  
  1403.         Etype           Return type of the function.
  1404.  
  1405.        Each parameter is first checked by calling pass_by_ref on its type to
  1406.        determine if it is passed by reference.  For parameters which are copied
  1407.        in, if they are Ada IN OUT or OUT parameters, their return value becomes
  1408.        part of a record which becomes the return type of the function (C
  1409.        function - note that this applies only to Ada procedures so there is no
  1410.        Ada return type). Additional code to store back the parameters will be
  1411.        generated on the caller side.  This transformation is done here, not in
  1412.        the front-end.
  1413.  
  1414.        The intended result of the transformation can be seen from the
  1415.        equivalent source rewritings that follow:
  1416.  
  1417.                                                    struct temp {int a,b};
  1418.        procedure P (A,B: IN OUT ...) is            temp P (int A,B) {
  1419.         ..                                            ..
  1420.        end P;                                        return {A,B};
  1421.                                                    }
  1422.                               procedure call
  1423.  
  1424.                                               {
  1425.                                                   temp t;
  1426.        P(X,Y);                                    t = P(X,Y);
  1427.                                                   X = t.a , Y = t.b;
  1428.                                               }
  1429.  
  1430.        For subprogram types we need to perform mainly the same conversions to
  1431.        GCC form that are needed for procedures and function declarations.  The
  1432.        only difference is that at the end, we make a type declaration instead
  1433.        of a function declaration.  */
  1434.  
  1435.     case E_Subprogram_Type:
  1436.     case E_Function:
  1437.     case E_Procedure:
  1438.       {
  1439.     /* The first GCC parameter declaration (a PARM_DECL node).  The
  1440.        PARM_DECL nodes are chained through the TREE_CHAIN field, so this
  1441.        actually is the head of this parameter list.  */
  1442.     tree gnu_param_list = NULL_TREE;
  1443.     /* The type returned by a function. If the subprogram is a procedure
  1444.        this type should be void_type_node.  */
  1445.     tree gnu_return_type = void_type_node;
  1446.         /* List of fields in return type of procedure with copy in copy out
  1447.        parameters.  */
  1448.         tree gnu_field_list = NULL_TREE;
  1449.     /* Non-null for subprograms containing  parameters passed by copy in
  1450.        copy out (Ada IN OUT or OUT parameters not passed by reference),
  1451.        in which case it is the list of nodes used to specify the values of
  1452.        the in out/out parameters that are returned as a record upon
  1453.        procedure return.  The TREE_PURPOSE of an element of this list is
  1454.        a field of the record and the TREE_VALUE is the PARM_DECL
  1455.        corresponding to that field.  This list will be saved in the
  1456.        TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create.  */
  1457.     tree gnu_return_list = NULL_TREE;
  1458.     Entity_Id gnat_param;
  1459.     int inline_flag = Is_Inlined (gnat_entity);
  1460.     int public_flag = Is_Public (gnat_entity);
  1461.     int extern_flag
  1462.       = ((Is_Public (gnat_entity) && !definition)
  1463.          || Is_Imported (gnat_entity));
  1464.     int pure_flag = Is_Pure (gnat_entity);
  1465.     int returns_by_ref = 0;
  1466.     int returns_unconstrained = 0;
  1467.     char *ext_name = NULL;
  1468.     int copy_in_copy_out_flag;
  1469.     int has_copy_in_out = 0;
  1470.     tree machine_attr = NULL_TREE;
  1471.  
  1472.     if (kind == E_Subprogram_Type && ! definition)
  1473.       /* A parameter may refer to this type, so defer completion
  1474.          of any incomplete types.  */
  1475.       defer_incomplete_level++, this_deferred = 1;
  1476.  
  1477.     /* If the subprogram has an alias, it is probably inherited, so
  1478.        we can use the original one */
  1479.     if (Present (Alias (gnat_entity)))
  1480.       {
  1481.         gnu_decl = gnat_to_gnu_entity (Alias (gnat_entity),
  1482.                        gnu_expr, 0);
  1483.         break;
  1484.       }
  1485.  
  1486.     if (kind == E_Function || kind == E_Subprogram_Type)
  1487.       gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity));
  1488.  
  1489.     /* If this function returns by reference, make the actual
  1490.        return type of this function the pointer and mark the decl.  */
  1491.     if (Returns_By_Ref (gnat_entity))
  1492.       {
  1493.         returns_by_ref = 1;
  1494.  
  1495.         if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
  1496.           gnu_return_type = TREE_TYPE (gnu_return_type);
  1497.         else
  1498.           gnu_return_type = build_pointer_type (gnu_return_type);
  1499.       }
  1500.  
  1501.     /* If we are supposed to return an unconstrained array,
  1502.        actually return a fat pointer and make a note of that.  Return
  1503.        a pointer to an unconstrained record of variable size.  */
  1504.     else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
  1505.       {
  1506.         gnu_return_type = TREE_TYPE (gnu_return_type);
  1507.         returns_unconstrained = 1;
  1508.       }
  1509.     else if ((TREE_CODE (TYPE_SIZE (gnu_return_type)) != INTEGER_CST
  1510.           && (1
  1511.              /* For now, treat any variable-sized object as if it
  1512.             were unconstrained.  */
  1513.              || contains_placeholder_p (TYPE_SIZE (gnu_return_type))))
  1514.          /* For now, treat all functions potentially dispatching 
  1515.             return or returning a class-wide as function
  1516.             returning unconstrained.  */
  1517.          || Is_Tagged_Type (Etype (gnat_entity)))
  1518.       {
  1519.         gnu_return_type = build_pointer_type (gnu_return_type);
  1520.         returns_unconstrained = 1;
  1521.       }
  1522.  
  1523.     /* Look at all our parameters and get the type of
  1524.        each.  While doing this, build a copy-out structure if
  1525.        we need one.  */
  1526.  
  1527.     for (gnat_param = First_Formal (gnat_entity);
  1528.          Present (gnat_param);
  1529.          gnat_param = Next_Formal (gnat_param))
  1530.       {
  1531.         char *param_name = Get_Name_String (Chars (gnat_param));
  1532.         tree gnu_param_type = gnat_to_gnu_type (Etype (gnat_param));
  1533.         tree gnu_param, gnu_field;
  1534.         int by_ref_p = 0;
  1535.         int by_component_ptr_p = 0;
  1536.  
  1537.         /* For foreign conventions, pass arrays as a pointer to the
  1538.            underlying type.  First check for unconstrained
  1539.            array and get the underlying array.  Then get the
  1540.            component type and build a pointer to it.  */
  1541.         if (Has_Foreign_Convention (gnat_entity)
  1542.         && TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE)
  1543.           gnu_param_type
  1544.         = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type))));
  1545.  
  1546.         if (Has_Foreign_Convention (gnat_entity)
  1547.         && TREE_CODE (gnu_param_type) == ARRAY_TYPE)
  1548.           {
  1549.         /* Strip off any multi-dimensional entries, then strip
  1550.            off the last array to get the component type.  */
  1551.         while (TREE_CODE (TREE_TYPE (gnu_param_type)) == ARRAY_TYPE
  1552.                && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_param_type)))
  1553.           gnu_param_type = TREE_TYPE (gnu_param_type);
  1554.  
  1555.         by_component_ptr_p = 1;
  1556.         gnu_param_type = TREE_TYPE (gnu_param_type);
  1557.  
  1558.         if (Ekind (gnat_param) == E_In_Parameter)
  1559.           gnu_param_type
  1560.             = build_type_variant (gnu_param_type, 1,
  1561.                       TYPE_VOLATILE (gnu_param_type));
  1562.  
  1563.         gnu_param_type = build_pointer_type (gnu_param_type);
  1564.         copy_in_copy_out_flag = 0;
  1565.           }
  1566.  
  1567.             else if (pass_by_ref (gnu_param_type)
  1568.              /* We do not follow the implementation advice of
  1569.             passing all records by reference for foreign
  1570.             conventions functions, but only do so for OUT or IN OUT
  1571.             parameters.  However, we pass scalars by reference
  1572.             for Fortran.  */
  1573.              || (Has_Foreign_Convention (gnat_entity)
  1574.              && Ekind (gnat_param) != E_In_Parameter)
  1575.              || (Convention (gnat_entity) == Convention_Fortran
  1576.              && (INTEGRAL_TYPE_P (gnu_param_type)
  1577.                  || FLOAT_TYPE_P (gnu_param_type))))
  1578.           {
  1579.         /* If this is an IN parameter it is read-only, so make
  1580.            a variant of the type that is read-only.
  1581.  
  1582.            ??? However, if this is an unconstrained array, that
  1583.            type can be very complex.  So skip it for now. 
  1584.            Likewise for any other self-referential type.  */
  1585.         if (Ekind (gnat_param) == E_In_Parameter
  1586.             && TREE_CODE (gnu_param_type) != UNCONSTRAINED_ARRAY_TYPE
  1587.             && ! (TYPE_SIZE (gnu_param_type) != 0
  1588.               && (TREE_CODE (TYPE_SIZE (gnu_param_type))
  1589.                   != INTEGER_CST)
  1590.               && (contains_placeholder_p
  1591.                   (TYPE_SIZE (gnu_param_type)))))
  1592.           gnu_param_type
  1593.             = build_type_variant (gnu_param_type, 1,
  1594.                       TYPE_VOLATILE (gnu_param_type));
  1595.  
  1596.         /* All parameters are passed by value by GCC. So to pass a
  1597.            parameter by reference we need to pass a pointer to it.  */
  1598.         gnu_param_type = build_pointer_type (gnu_param_type);
  1599.         copy_in_copy_out_flag = 0;
  1600.         by_ref_p = 1;
  1601.           }
  1602.             else
  1603.           copy_in_copy_out_flag = (Ekind (gnat_param) != E_In_Parameter);
  1604.  
  1605.         /* If this is an OUT parameter that isn't passed by reference
  1606.            and isn't a pointer, we don't make a PARM_DECL for it.
  1607.            Instead, it will be a VAR_DECL created when we process the
  1608.            procedure.  */
  1609.         if (Ekind (gnat_param) == E_Out_Parameter && ! by_ref_p
  1610.         && TREE_CODE (gnu_param_type) != POINTER_TYPE)
  1611.           gnu_param = 0;
  1612.         else
  1613.           {
  1614.         gnu_param
  1615.           = create_param_decl
  1616.             (param_name, gnu_param_type,
  1617.              by_ref_p || by_component_ptr_p
  1618.              || Ekind (gnat_param) == E_In_Parameter);
  1619.  
  1620.         DECL_BY_REF_P (gnu_param) = by_ref_p;
  1621.         DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr_p;
  1622.         DECL_POINTS_TO_READONLY_P (gnu_param)
  1623.           = (Ekind (gnat_param) == E_In_Parameter
  1624.              && (by_ref_p || by_component_ptr_p));
  1625.         save_gnu_tree (gnat_param, gnu_param, 0);
  1626.         gnu_param_list = chainon (gnu_param, gnu_param_list);
  1627.  
  1628.         /* If a parameter is a pointer, this function may modify
  1629.            memory through it and thus shouldn't be considered
  1630.            a pure function.  */
  1631.         if (TREE_CODE (gnu_param_type) == POINTER_TYPE)
  1632.           pure_flag = 0;
  1633.           }
  1634.  
  1635.             if (copy_in_copy_out_flag)
  1636.           {
  1637.         if (! has_copy_in_out)
  1638.           {
  1639.             if (TREE_CODE (gnu_return_type) != VOID_TYPE)
  1640.               gigi_abort (111);
  1641.  
  1642.             gnu_return_type = make_node (RECORD_TYPE);
  1643.             TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
  1644.             has_copy_in_out = 1;
  1645.           }
  1646.  
  1647.         gnu_field = create_field_decl (param_name, gnu_param_type,
  1648.                            gnu_return_type, 0, -1, 0);
  1649.         gnu_field_list = chainon (gnu_field, gnu_field_list);
  1650.         gnu_return_list = tree_cons (gnu_field, gnu_param,
  1651.                          gnu_return_list);
  1652.           }
  1653.       }
  1654.  
  1655.     if (gnu_field_list != 0)
  1656.       finish_record_type (gnu_return_type, nreverse (gnu_field_list),
  1657.                   0, 0);
  1658.  
  1659.     /* If we have a CICO list but it has only one entry, we convert
  1660.        this function into a function that simply returns that one
  1661.        object.  */
  1662.     if (list_length (gnu_return_list) == 1)
  1663.       gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
  1664.  
  1665.     /* Both lists ware built in reverse.  */
  1666.     gnu_param_list = nreverse (gnu_param_list);
  1667.     gnu_return_list = nreverse (gnu_return_list);
  1668.  
  1669.     gnu_type
  1670.       = create_subprog_type (gnu_return_type, gnu_param_list,
  1671.                  gnu_return_list, returns_unconstrained,
  1672.                  returns_by_ref);
  1673.  
  1674.     /* Top-level or external functions need to have an assembler name.
  1675.        This is passed to create_subprog_decl through the ext_name argument.
  1676.        For Pragma Interface subprograms with no Pragma Interface_Name, the
  1677.        simple name already in entity_name is correct, and this is what is
  1678.        gotten when ext_name is NULL.  If Interface_Name is specified, then
  1679.        the name is extracted from the N_String_Literal node containing the
  1680.        string specified in the Pragma.  If there is no Pragma Interface,
  1681.        then the Ada fully qualified name is created. */
  1682.  
  1683.     if (Present (Interface_Name (gnat_entity))
  1684.         || ! Is_Imported (gnat_entity))
  1685.       ext_name = create_concat_name (gnat_entity, NULL_PTR);
  1686.  
  1687.         if (kind == E_Subprogram_Type)
  1688.           gnu_decl = create_type_decl (entity_name, gnu_type);
  1689.         else
  1690.         {
  1691.           if (Has_Machine_Attribute (gnat_entity))
  1692.             machine_attr = maybe_machine_attribute (gnat_entity);
  1693.       gnu_decl = create_subprog_decl (entity_name, ext_name, gnu_type,
  1694.                         gnu_param_list, inline_flag,
  1695.                       public_flag, extern_flag, pure_flag,
  1696.                       machine_attr);
  1697.         }
  1698.       }
  1699.       break;
  1700.  
  1701.     case E_Incomplete_Type:
  1702.     case E_Private_Type:
  1703.     case E_Limited_Private_Type:
  1704.     case E_Limited_Type:
  1705.     case E_Record_Type_With_Private:
  1706.  
  1707.       /* If this type does not have a full view in the unit we are
  1708.      compiling, then just get the type from its Etype.  */
  1709.       if (No (Full_View (gnat_entity)))
  1710.     {
  1711.       /* If this is an incomplete type with no full view, it must
  1712.          be a Taft Amendement type, so just return a dummy type.  */
  1713.       if (kind == E_Incomplete_Type)
  1714.         gnu_type = make_dummy_type (gnat_entity);
  1715.       else
  1716.         gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  1717.  
  1718.       break;
  1719.     }
  1720.  
  1721.       /* Otherwise, if we are not defining the type now, get the
  1722.      type from the full view.  */
  1723.       else if (! definition)
  1724.     {
  1725.       gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
  1726.                      NULL_TREE, 0);
  1727.       saved = 1;
  1728.       break;
  1729.     }
  1730.  
  1731.       /* For incomplete types, make a dummy type entry which will be
  1732.      replaced later.  */
  1733.       gnu_type = make_dummy_type (gnat_entity);
  1734.  
  1735.       /* Save this type as the full declaration's type so we can do any needed
  1736.      updates when we see it.  */
  1737.       gnu_decl = create_type_decl (entity_name, gnu_type);
  1738.       save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
  1739.       break;
  1740.  
  1741.     case E_Class_Wide_Type:
  1742.       /* We consider a class wide type as the Root type of the Class.
  1743.          This is a simple way to implement view-conversion. */
  1744.       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  1745.       break;
  1746.  
  1747.     case E_Class_Wide_Subtype:
  1748.       /* a class wide subtype is a class wide type with a particular size
  1749.          (it is used  to allocate class-wide object as a copy of another
  1750.          object). The front-end provides a record equivalent type for it in
  1751.          field Equivalent_Type */
  1752.  
  1753.       if (Present (Equivalent_Type (gnat_entity)))
  1754.     /* in this case the class wide subtype is a class wide type with a
  1755.        particular size (it is used to allocate class-wide object as a copy
  1756.        of another object). The front-end provides a record equivalent type
  1757.        for it in field Equivalent_Type */
  1758.     gnu_type = gnat_to_gnu_type (Equivalent_Type (gnat_entity));
  1759.  
  1760.       else
  1761.     /* if no Equivalent type is provided, the class wide subtype is just a
  1762.        renaming of the base class wide type */
  1763.     gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
  1764.  
  1765.       break;
  1766.  
  1767.     case E_Task_Type:
  1768.     case E_Task_Subtype:
  1769.     case E_Protected_Type:
  1770.     case E_Protected_Subtype:
  1771.       gnu_type = gnat_to_gnu_type (Corresponding_Record_Type (gnat_entity));
  1772.       break;
  1773.  
  1774.     case E_Label:
  1775.       gnu_decl = create_label_decl (entity_name);
  1776.       break;
  1777.  
  1778.     case E_Block:
  1779.     case E_Loop:
  1780.       /* Nothing at all to do here, so just return an ERROR_MARK and claim
  1781.      we've already saved it, so we don't try to.  */
  1782.       gnu_decl = error_mark_node;
  1783.       saved = 1;
  1784.       break;
  1785.  
  1786.     default:
  1787.       gigi_abort (113);
  1788.     }
  1789.  
  1790.   if (gnu_decl == 0 && IN (kind, Type_Kind))
  1791.     {
  1792.       TYPE_ALIGN_OK_P (gnu_type)
  1793.     = Is_Tagged_Type (gnat_entity) || Is_Packed (gnat_entity);
  1794.  
  1795.       gnu_type = build_type_variant (gnu_type, 0, Is_Volatile (gnat_entity));
  1796.       gnu_decl = create_type_decl (entity_name, gnu_type);
  1797.  
  1798.       /* Set alignment for the type, if specified.  If this is an unconstrained
  1799.      array, the alignment refers to the inner array.  */
  1800.       if (Has_Alignment_Clause (gnat_entity))
  1801.     {
  1802.       tree gnu_adjust_type
  1803.         = (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
  1804.            ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_type))))
  1805.            : gnu_type);
  1806.  
  1807.       TYPE_ALIGN (gnu_adjust_type)
  1808.         = validate_alignment (Expression (Alignment_Clause (gnat_entity)),
  1809.                   TYPE_ALIGN (gnu_adjust_type));
  1810.     }
  1811.     }
  1812.  
  1813. #ifdef DECL_ARTIFICIAL
  1814.   if (! Comes_From_Source (gnat_entity)
  1815.       && TREE_CODE_CLASS (TREE_CODE (gnu_decl)) == 'd')
  1816.     DECL_ARTIFICIAL (gnu_decl) = 1;
  1817. #endif
  1818.  
  1819.   /* If we haven't already, associate the ..._DECL node that we just made with
  1820.      the input GNAT entity node. */
  1821.   if (! saved)
  1822.     save_gnu_tree (gnat_entity, gnu_decl, 0);
  1823.  
  1824.   /* If we deferred it, re-enable processing of incomplete types.  If there
  1825.      were no other disables and we have some to process, do so.  */
  1826.   if (this_deferred && --defer_incomplete_level == 0
  1827.       && defer_incomplete_list != 0)
  1828.     {
  1829.       struct incomplete *p = defer_incomplete_list;
  1830.  
  1831.       defer_incomplete_list = 0;
  1832.       for (; p; p = p->next)
  1833.     update_pointer_to (p->old_type, gnat_to_gnu_type (p->full_type));
  1834.     }
  1835.  
  1836.   /* Restore our previous allocation, if not previously permanent and we
  1837.      changed it.  */
  1838.   if ((! definition || Is_Imported (gnat_entity)) && ! was_permanent)
  1839.     {
  1840.       pop_obstacks ();
  1841.  
  1842.       if (Is_Public (gnat_entity))
  1843.     force_global--;
  1844.     }
  1845.  
  1846.   resume_momentary (was_momentary);
  1847.  
  1848.   return gnu_decl;
  1849. }
  1850.  
  1851. /* Given GNAT_ENTITY, elaborate all expressions that are required to
  1852.    be elaborated at the point of its definition, but do nothing else.  */
  1853.  
  1854. void
  1855. elaborate_entity (gnat_entity)
  1856.      Entity_Id gnat_entity;
  1857. {
  1858.   switch (Ekind (gnat_entity))
  1859.     {
  1860.     case E_Signed_Integer_Subtype:
  1861.     case E_Modular_Integer_Subtype:
  1862.     case E_Enumeration_Subtype:
  1863.     case E_Ordinary_Fixed_Point_Subtype:
  1864.     case E_Decimal_Fixed_Point_Subtype:
  1865.     case E_Floating_Point_Subtype:
  1866.       elaborate_expression (Type_Low_Bound (gnat_entity), gnat_entity,
  1867.                 "L", 1, 0);
  1868.       elaborate_expression (Type_High_Bound (gnat_entity), gnat_entity,
  1869.                 "U", 1, 0);
  1870.       break;
  1871.  
  1872.     case E_Record_Type:
  1873.       {
  1874.         Node_Id full_definition = Parent (gnat_entity);
  1875.     Node_Id record_definition = Type_Definition (full_definition);
  1876.     Entity_Id gnat_impl_type;
  1877.  
  1878.     /* If this is a record extension, go a level further to find the
  1879.        record definition */
  1880.     if (Nkind (record_definition) == N_Derived_Type_Definition)
  1881.       record_definition = Record_Extension_Part (record_definition);
  1882.       }
  1883.       break;
  1884.  
  1885.     case E_Record_Subtype:
  1886.     case E_Private_Subtype:
  1887.     case E_Limited_Private_Subtype:
  1888.     case E_Record_Subtype_With_Private:
  1889.       if (Is_Constrained (gnat_entity)
  1890.       && Present (Discriminant_Constraint (gnat_entity)))
  1891.     {
  1892.       Node_Id gnat_discriminant_expr;
  1893.       Entity_Id gnat_field;
  1894.  
  1895.       for (gnat_field = First_Discriminant (Base_Type (gnat_entity)),
  1896.            gnat_discriminant_expr
  1897.            = First_Elmt (Discriminant_Constraint (gnat_entity));
  1898.            Present (gnat_field);
  1899.            gnat_field = Next_Discriminant (gnat_field),
  1900.            gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
  1901.         elaborate_expression (Id_Of (gnat_discriminant_expr),
  1902.                   gnat_entity,
  1903.                   Get_Name_String (Chars (gnat_field)), 1, 0);
  1904.     }
  1905.       break;
  1906.  
  1907.     }
  1908. }
  1909.  
  1910. /* Make a dummy type corresponding to GNAT_TYPE.  */
  1911.  
  1912. tree
  1913. make_dummy_type (gnat_type)
  1914.      Entity_Id gnat_type;
  1915. {
  1916.   Entity_Id gnat_underlying = Underlying_Type (Base_Type (gnat_type));
  1917.   tree gnu_type;
  1918.  
  1919.   /* If there is an underlying type and it is a record, make this a
  1920.      RECORD_TYPE; else make it a VOID_TYPE.  */
  1921.   if (Present (gnat_underlying) && Is_Record_Type (gnat_underlying))
  1922.     gnu_type = make_node (RECORD_TYPE);
  1923.   else
  1924.     gnu_type = make_node (VOID_TYPE);
  1925.  
  1926.   TYPE_NAME (gnu_type) = get_identifier (Get_Name_String (Chars (gnat_type)));
  1927.   if (TREE_CODE (gnu_type) == RECORD_TYPE)
  1928.     TYPE_STUB_DECL (gnu_type)
  1929.       = pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
  1930.  
  1931.   TYPE_DUMMY_P (gnu_type) = 1;
  1932.  
  1933.   return gnu_type;
  1934. }
  1935.  
  1936. /* Given GNAT_ENTITY of kind E_Function or E_Procedure, modify the declaration
  1937.    to include the attribute, if it is valid for this configuration. */
  1938.  
  1939. tree
  1940. maybe_machine_attribute (gnat_entity)
  1941.      Entity_Id gnat_entity;
  1942. {
  1943.   Entity_Id maybe_pragma_node = Machine_Attribute (gnat_entity);
  1944.   List_Id args = Pragma_Argument_Associations (maybe_pragma_node);
  1945.   Node_Id arg_attribute_name = First (args);
  1946.   Node_Id arg_entity = Next (arg_attribute_name);
  1947.   String_Id gnat_string = Expr_Value_S (Expression (arg_attribute_name));
  1948.   int length = String_Length (gnat_string);
  1949.   char *string = (char*) alloca (length + 1);
  1950.   int i;
  1951.  
  1952.   for (i = 0; i < length; i++)
  1953.     string[i] = Get_String_Char (gnat_string, i + 1);
  1954.  
  1955.   string[i] = 0;
  1956.  
  1957.   return tree_cons (get_identifier (string), NULL_TREE, NULL_TREE);
  1958. }
  1959.  
  1960. /* EXP may be a FIELD_DECL.  If so, make the appropriate COMPONENT_REF
  1961.    involving a PLACEHOLDER_EXPR.
  1962.  
  1963.    This function must be called whenever we have something that is allowed to
  1964.    be a discriminant.  */
  1965.  
  1966. static tree
  1967. maybe_placeholder (exp)
  1968.      tree exp;
  1969. {
  1970.   if (TREE_CODE (exp) == FIELD_DECL)
  1971.     return build (COMPONENT_REF, TREE_TYPE (exp),
  1972.           build (PLACEHOLDER_EXPR, DECL_CONTEXT (exp)),
  1973.           exp);
  1974.  
  1975.   return exp;
  1976. }
  1977.  
  1978. /* Called when we need to protect a variable object using a save_expr.  */
  1979.  
  1980. tree
  1981. maybe_variable (operand)
  1982.      tree operand;
  1983. {
  1984.   if (TREE_CODE (operand) == INTEGER_CST)
  1985.     return operand;
  1986.   else if (TREE_CODE (operand) == UNCONSTRAINED_ARRAY_REF)
  1987.     return build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (operand),
  1988.            variable_size (TREE_OPERAND (operand, 0)));
  1989.   else
  1990.     return variable_size (operand);
  1991. }
  1992.  
  1993. /* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a
  1994.    type definition (either a bound or a discriminant value) for GNAT_ENTITY,
  1995.    return the GCC tree to use for that expression.  NAME is the qualification
  1996.    to use if an external name is appropriate and DEFINITION is nonzero
  1997.    if this is a definition of GNAT_ENTITY.  If NEED_VALUE is nonzero, we
  1998.    need a result.  Otherwise, we are just elaborating this for
  1999.    side-effects.  */
  2000.  
  2001. static tree
  2002. elaborate_expression (gnat_expr, gnat_entity, name, definition, need_value)
  2003.      Node_Id gnat_expr;
  2004.      Entity_Id gnat_entity;
  2005.      char *name;
  2006.      int definition;
  2007.      int need_value;
  2008. {
  2009.   tree gnu_expr;
  2010.  
  2011.   /* If we already elaborated this expression (e.g., it was involved
  2012.      in the definition of a private type), use the old value.  */
  2013.   if (present_gnu_tree (gnat_expr))
  2014.     return get_gnu_tree (gnat_expr);
  2015.  
  2016.   /* If we don't need a value and this is static or a discriment, we
  2017.      don't need to do anything.  */
  2018.   else if (! need_value
  2019.       && (Is_Static_Expression (gnat_expr)
  2020.       || (Nkind (gnat_expr) == N_Identifier
  2021.           && Ekind (Entity (gnat_expr)) == E_Discriminant)))
  2022.     return 0;
  2023.  
  2024.   /* Otherwise, convert this tree to its GCC equivalant, handling any
  2025.      references to a discriminant.  */
  2026.   gnu_expr = maybe_placeholder (gnat_to_gnu (gnat_expr));
  2027.  
  2028.   /* If this entity is defined at top level and a bound or discriminant
  2029.      value isn't a constant or a reference to a discriminant, replace the
  2030.      bound by a variable that will be initialized to contain the bound when
  2031.      the package containing the definition is elaborated.  Note that we rely
  2032.      here on the fact that an expression cannot contain both the discriminant
  2033.      and some other variable.  */
  2034.  
  2035.   if ((Is_Public (gnat_entity) || global_bindings_p ())
  2036.       && ! TREE_CONSTANT (gnu_expr) && ! contains_placeholder_p (gnu_expr))
  2037.     gnu_expr = create_var_decl (create_concat_name (gnat_entity, name),
  2038.                 NULL_PTR, TREE_TYPE (gnu_expr), gnu_expr,
  2039.                 NULL_TREE, 0,
  2040.                 0, Is_Public (gnat_entity),
  2041.                 ! definition, 0);
  2042.   else
  2043.     gnu_expr = maybe_variable (gnu_expr);
  2044.  
  2045.   /* Save the expression in case we try to elaborate this entity again.
  2046.      Since this is not a DECL, don't check it.  If this is a constant,
  2047.      don't save it since GNAT_EXPR might be used more than once.  Also,
  2048.      don't save if it's a discriminant.  */
  2049.   if (! TREE_CONSTANT (gnu_expr) && ! contains_placeholder_p (gnu_expr))
  2050.     save_gnu_tree (gnat_expr, gnu_expr, 1);
  2051.  
  2052.   return gnu_expr;
  2053. }
  2054.  
  2055. /* Given a GNU tree and a GNAT list of choices, generate an expression to test
  2056.    the value passed against the list of choices.  */
  2057.  
  2058. tree
  2059. choices_to_gnu (operand, choices)
  2060.      tree operand;
  2061.      Node_Id choices;
  2062. {
  2063.   Node_Id choice;
  2064.   tree result = integer_zero_node;
  2065.   tree this_test, low, high;
  2066.  
  2067.   for (choice = First (choices); Present (choice); choice = Next (choice))
  2068.     {
  2069.       switch (Nkind (choice))
  2070.     {
  2071.     case N_Range:
  2072.       low = gnat_to_gnu (Low_Bound (choice));
  2073.       high = gnat_to_gnu (High_Bound (choice));
  2074.  
  2075.       /* There's no good type to use here, so we might as well use
  2076.          integer_type_node.  */
  2077.       this_test
  2078.         = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
  2079.                    build_binary_op (GE_EXPR, integer_type_node,
  2080.                         operand, low),
  2081.                    build_binary_op (LE_EXPR, integer_type_node,
  2082.                         operand, high));
  2083.       break;
  2084.  
  2085.     case N_Identifier:
  2086.         case N_Expanded_Name:
  2087.       /* This represents either a subtype range, an enumeration
  2088.          literal. or a constant  Ekind says which.  If an enumeration 
  2089.              literal or constant, fall through to the next case.  */
  2090.       if (Ekind (Entity (choice)) != E_Enumeration_Literal
  2091.               && Ekind (Entity (choice)) != E_Constant)
  2092.         {
  2093.           tree type = gnat_to_gnu_type (Entity (choice));
  2094.  
  2095.           low = TYPE_MIN_VALUE (type);
  2096.           high = TYPE_MAX_VALUE (type);
  2097.  
  2098.           this_test
  2099.         = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
  2100.                    build_binary_op (GE_EXPR, integer_type_node,
  2101.                             operand, low),
  2102.                    build_binary_op (LE_EXPR, integer_type_node,
  2103.                             operand, high));
  2104.           break;
  2105.         }
  2106.       /* ... fall through ... */
  2107.     case N_Character_Literal:
  2108.     case N_Integer_Literal:
  2109.       this_test = build_binary_op (EQ_EXPR, integer_type_node, operand,
  2110.                        gnat_to_gnu (choice));
  2111.       break;
  2112.  
  2113.     case N_Others_Choice:
  2114.       this_test = integer_one_node;
  2115.       break;
  2116.  
  2117.     default:
  2118.       gigi_abort (114);
  2119.     }
  2120.  
  2121.       result = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
  2122.                 result, this_test);
  2123.     }
  2124.  
  2125.   return result;
  2126. }
  2127.  
  2128. /* Return a GCC tree for a field corresponding to GNAT_FIELD to be
  2129.    placed in GNU_RECORD_TYPE.
  2130.  
  2131.    PACKED is nonzero if the enclosing record is packed and HAS_REP is
  2132.    nonzero if a record rep clause was specified.  */
  2133.  
  2134. static tree
  2135. gnat_to_gnu_field (gnat_field, gnu_record_type, packed, has_rep)
  2136.      Entity_Id gnat_field;
  2137.      tree gnu_record_type;
  2138.      int packed;
  2139.      int has_rep;
  2140. {
  2141.   char *field_id = Get_Name_String (Chars (gnat_field));
  2142.   tree gnu_field_type;
  2143.   tree gnu_field;
  2144.   int pos = 0;
  2145.   int size = -1;
  2146.  
  2147.   gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
  2148.  
  2149.   if (has_rep)
  2150.     {
  2151.       if (No (Component_First_Bit (gnat_field)))
  2152.     {
  2153.       post_error ("no location specified for &", gnat_field);
  2154.       size = BITS_PER_WORD;
  2155.     }
  2156.       else
  2157.     {
  2158.       pos = UI_To_Int (Component_First_Bit (gnat_field));
  2159.       size = validate_size (Esize (gnat_field), gnu_field_type,
  2160.                 gnat_field, 1);
  2161.  
  2162.       if (size == 0)
  2163.         size = BITS_PER_WORD;
  2164.     }
  2165.     }
  2166.  
  2167.   gnu_field = create_field_decl (field_id, gnu_field_type,
  2168.                  gnu_record_type, packed, size, pos);
  2169.  
  2170.   /* If a rep clause was specified but the position is such that a
  2171.      BLKmode object is not byte-aligned, declare the position invalid.  */
  2172.   if (has_rep && TYPE_MODE (gnu_field_type) == BLKmode
  2173.       && DECL_BIT_FIELD (gnu_field))
  2174.     post_error ("composite objects must start on storage unit boundary",
  2175.         gnat_field);
  2176.  
  2177.   return gnu_field;
  2178. }
  2179.  
  2180. /* Return a GCC tree for a record type given a GNAT Component_List and a chain
  2181.    of GCC trees for fields that are in the record and have already been
  2182.    processed.  When called from gnat_to_gnu_entity during the processing of a
  2183.    record type definition, the GCC nodes for the discriminants will be on
  2184.    the chain.  The other calls to this function are recursive calls from
  2185.    itself for the Component_List of a variant and the chain is empty.
  2186.  
  2187.    PACKED is nonzero if this field is for a record with "pragma pack".
  2188.  
  2189.    HAS_REP is nonzero if this record has a record representation clause.
  2190.  
  2191.    FINISH_RECORD is nonzero if this call will supply all of the remaining
  2192.    fields of the record.
  2193.  
  2194.    The processing of the component list fills in the chain with all of the
  2195.    fields of the record and then the record type is finished (if
  2196.    FINISH_RECORD is nonzero), and the field list is returned.  */
  2197.  
  2198. static tree
  2199. components_to_record (record_type, component_list, gnu_field_list, packed,
  2200.               definition, has_rep, finish_record)
  2201.      tree record_type;
  2202.      Node_Id component_list;
  2203.      tree gnu_field_list;
  2204.      int definition;
  2205.      int has_rep;
  2206.      int finish_record;
  2207. {
  2208.   Entity_Id component_decl;
  2209.   Node_Id variant_part;
  2210.  
  2211.   /* For each variable within each component declaration create a GCC field
  2212.      and add it to the list, skipping any pragmas in the list.  */
  2213.  
  2214.   if (Present (Component_Items (component_list)))
  2215.     for (component_decl = First (Component_Items (component_list));
  2216.      Present (component_decl);
  2217.      component_decl = Next (component_decl))
  2218.       if (Nkind (component_decl) != N_Pragma)
  2219.         {
  2220.       Entity_Id gnat_field = Defining_Identifier (component_decl);
  2221.       tree gnu_field;
  2222.  
  2223.       if (definition)
  2224.         process_implicit_types (component_decl);
  2225.  
  2226.       gnu_field = gnat_to_gnu_field (gnat_field, record_type,
  2227.                      packed, has_rep);
  2228.  
  2229.       /* If this is the _Parent field, we have two things to do.  First, we
  2230.          put the first before any discriminants, instead of after them as
  2231.          is the case for all other fields.  Second, we check for the case
  2232.          where the field is a self-referential type.  If it is, it will be
  2233.          referencing discriminants that appear later in the record and
  2234.          hence depend on its size.  In that case, go back to the base
  2235.          type of the field and replace all discriminants with a reference
  2236.          to the parent within RECORD_TYPE.  */
  2237.       if (Chars (gnat_field) == Name_uParent)
  2238.         {
  2239.           tree gnu_field_type = TREE_TYPE (gnu_field);
  2240.  
  2241.           /* We can't handle this case with record rep clauses, so
  2242.          assume the front end has disallowed it.  */
  2243.           if (has_rep)
  2244.         gigi_abort (115);
  2245.  
  2246.           DECL_PARENT_P (gnu_field) = 1;
  2247.           gnu_field_list = chainon (gnu_field_list, gnu_field);
  2248.  
  2249.           if (! TREE_CONSTANT (TYPE_SIZE (gnu_field_type))
  2250.           && contains_placeholder_p (TYPE_SIZE (gnu_field_type)))
  2251.             {
  2252.           Entity_Id gnat_base_type = Base_Type (Etype (gnat_field));
  2253.           tree gnu_new_type = gnat_to_gnu_type (gnat_base_type);
  2254.           tree gnu_this_parent
  2255.             = build (COMPONENT_REF, NULL_TREE,
  2256.                  build (PLACEHOLDER_EXPR, record_type),
  2257.                  gnu_field);
  2258.           Entity_Id gnat_discrim;
  2259.  
  2260.           for (gnat_discrim = First_Discriminant (gnat_base_type);
  2261.                Present (gnat_discrim);
  2262.                gnat_discrim = Next_Discriminant (gnat_discrim))
  2263.             {
  2264.               tree gnu_discrim = get_gnu_tree (gnat_discrim);
  2265.  
  2266.               gnu_new_type
  2267.             = substitute_in_type
  2268.               (gnu_new_type, gnu_discrim,
  2269.                build (COMPONENT_REF, TREE_TYPE (gnu_discrim),
  2270.                   gnu_this_parent, gnu_discrim));
  2271.             }
  2272.  
  2273.           /* Save the old type of the parent for when we make a subtype
  2274.              of this record type.   Then set the new type for the
  2275.              field.  */
  2276.           TYPE_PARENT_SUBTYPE (record_type) = TREE_TYPE (gnu_field);
  2277.           TREE_TYPE (gnu_field) = TREE_TYPE (gnu_this_parent)
  2278.             = gnu_new_type;
  2279.             }
  2280.         }
  2281.  
  2282.       /* Force the tag in first position, i.e. before any discriminant */
  2283.  
  2284.       else if (Chars (gnat_field) == Name_uTag)
  2285.         {
  2286.           if (has_rep)
  2287.         gigi_abort (116);
  2288.  
  2289.           gnu_field_list = chainon (gnu_field_list, gnu_field);
  2290.         }
  2291.       else
  2292.         gnu_field_list = chainon (gnu_field, gnu_field_list);
  2293.  
  2294.       save_gnu_tree (gnat_field, gnu_field, 0);
  2295.         }
  2296.  
  2297.   /* At the end of the component list there may be a variant part.  If we have
  2298.      a rep clause, we simply add all those fields directly to our record.
  2299.      Otherwise, we create a QUAL_UNION_TYPE for it since the variants are
  2300.      mutually exclusive and should go in the same memory.  To do this we need
  2301.      to treat each  variant as a record whose elements are created from the
  2302.      component list for the variant.  So here we create the records from the
  2303.      lists for the variants and put them all into the QUAL_UNION_TYPE.  */
  2304.  
  2305.   variant_part = Variant_Part (component_list);
  2306.  
  2307.   if (has_rep && Present (variant_part))
  2308.     {
  2309.       Node_Id variant;
  2310.       int first;
  2311.  
  2312.       for (variant = First (Variants (variant_part)); Present (variant);
  2313.        variant = Next (variant))
  2314.     {
  2315.       tree gnu_last = gnu_field_list;
  2316.       tree gnu_temp;
  2317.  
  2318.       gnu_field_list
  2319.         = components_to_record (record_type, Component_List (variant),
  2320.                     gnu_field_list, packed, definition, 1, 0);
  2321.  
  2322.       if (gnu_field_list != gnu_last)
  2323.         for (gnu_temp = gnu_field_list; TREE_CHAIN (gnu_temp) == gnu_last;
  2324.          gnu_temp = TREE_CHAIN (gnu_temp))
  2325.         DECL_FIRST_FIELD_IN_VARIANT_P (gnu_temp) = 1;
  2326.     }
  2327.     }
  2328.   else if (Present (variant_part))
  2329.     {
  2330.       tree gnu_discriminant
  2331.     = maybe_placeholder (gnat_to_gnu (Name (variant_part)));
  2332.       Node_Id variant;
  2333.       tree gnu_field;
  2334.       tree gnu_union_type = make_node (QUAL_UNION_TYPE);
  2335.       tree gnu_union_field;
  2336.       tree gnu_variant_list = NULL_TREE;
  2337.       int var_idx = 0;
  2338.       char var_name[10];
  2339.  
  2340.       for (variant = First (Variants (variant_part)); Present (variant);
  2341.        variant = Next (variant))
  2342.     {
  2343.       tree gnu_variant_type = make_node (RECORD_TYPE);
  2344.  
  2345.       components_to_record (gnu_variant_type, Component_List (variant),
  2346.                 NULL_TREE, packed, definition, has_rep, 1);
  2347.  
  2348.       sprintf (var_name, "V%d", var_idx++);
  2349.       gnu_field = create_field_decl (var_name, gnu_variant_type,
  2350.                      gnu_union_type, packed, -2, 0);
  2351.       DECL_FOR_VARIANT_P (gnu_field) = 1;
  2352.  
  2353.       /* The last choice should always be "Others".  */
  2354.       DECL_QUALIFIER (gnu_field)
  2355.         = (Present (Next (variant))
  2356.            ? choices_to_gnu (gnu_discriminant, Discrete_Choices (variant))
  2357.            : integer_one_node);
  2358.       gnu_variant_list = chainon (gnu_field, gnu_variant_list);
  2359.     }
  2360.  
  2361.       finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
  2362.               has_rep, 0);
  2363.  
  2364.       gnu_union_field
  2365.     = create_field_decl ("VARIANTS", gnu_union_type, record_type,
  2366.                  packed, -1, 0);
  2367.  
  2368.       DECL_FOR_VARIANT_P (gnu_union_field) = 1;
  2369.       gnu_field_list = chainon (gnu_union_field, gnu_field_list);
  2370.     }
  2371.  
  2372.   if (finish_record)
  2373.     finish_record_type (record_type, nreverse (gnu_field_list), has_rep, 0);
  2374.  
  2375.   return gnu_field_list;
  2376. }
  2377.  
  2378. /* Create a CONSTRUCTOR for the enumeration literal table of
  2379.    GNAT_ENUM_TYPE.  The GCC type of the literal table is GNU_TABLE_TYPE.  */
  2380.  
  2381. static tree
  2382. create_enum_initializer (gnat_enum_type, gnu_table_type)
  2383.      Entity_Id gnat_enum_type;
  2384.      tree gnu_table_type;
  2385. {
  2386.   tree gnu_a_string_type = TREE_TYPE (gnu_table_type);
  2387.   tree gnu_char_type
  2388.     = TREE_TYPE (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_a_string_type))));
  2389.   tree gnu_char_domain_type
  2390.     = TYPE_DOMAIN (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_a_string_type))));
  2391.   tree gnu_size_1 = size_int (1);
  2392.   tree gnu_list = NULL_TREE;
  2393.   Entity_Id gnat_literal;
  2394.  
  2395.   /* Make a STRING_CST for each literal and add it to the CONSTRUCTOR.  */
  2396.   for (gnat_literal = First_Literal (gnat_enum_type);
  2397.        Present (gnat_literal);
  2398.        gnat_literal = Next_Literal (gnat_literal))
  2399.     {
  2400.       char *name = Get_Upper_Decoded_Name_String (Chars (gnat_literal));
  2401.       int length = strlen (name);
  2402.       tree gnu_lit_range = build_range_type (gnu_char_domain_type,
  2403.                          convert (gnu_char_domain_type,
  2404.                               integer_one_node),
  2405.                          convert (gnu_char_domain_type,
  2406.                               build_int_2 (length,
  2407.                                    0)));
  2408.       tree gnu_lit_index
  2409.     = create_index_type (convert (sizetype,
  2410.                       TYPE_MIN_VALUE (gnu_lit_range)),
  2411.                  convert (sizetype,
  2412.                       TYPE_MAX_VALUE (gnu_lit_range)),
  2413.                  gnu_lit_range);
  2414.       tree gnu_lit_type = build_array_type (gnu_char_type, gnu_lit_index);
  2415.       tree gnu_literal;
  2416.       tree gnu_temp_type
  2417.     = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_a_string_type))));
  2418.       tree gnu_temp = build_template (gnu_temp_type, gnu_lit_type, NULL_TREE);
  2419.       tree gnu_record_type = make_node (RECORD_TYPE);
  2420.       tree gnu_temp_field
  2421.     = create_field_decl ("BOUNDS", gnu_temp_type,
  2422.                  gnu_record_type, 0, -1, 0);
  2423.       tree gnu_array_field
  2424.     = create_field_decl ("ARRAY", gnu_lit_type, gnu_record_type, 0, -1, 0);
  2425.  
  2426.       finish_record_type (gnu_record_type,
  2427.               chainon (chainon (NULL_TREE, gnu_temp_field),
  2428.                    gnu_array_field),
  2429.               0, 0);
  2430.       TYPE_CONTAINS_TEMPLATE_P (gnu_record_type) = 1;
  2431.  
  2432.       gnu_literal = build_string (length, name);
  2433.       TREE_TYPE (gnu_literal) = gnu_lit_type;
  2434.       gnu_literal
  2435.     = build_constructor (gnu_record_type,
  2436.                  tree_cons (gnu_temp_field, gnu_temp,
  2437.                     tree_cons (gnu_array_field,
  2438.                            gnu_literal, NULL_TREE)));
  2439.       gnu_literal
  2440.     = build_component_ref (gnu_literal, NULL_TREE,
  2441.                    TREE_CHAIN (TYPE_FIELDS (gnu_record_type)));
  2442.  
  2443.       gnu_list = tree_cons (NULL_TREE,
  2444.                 convert (gnu_a_string_type,
  2445.                      build_unary_op (ADDR_EXPR, NULL_TREE,
  2446.                              gnu_literal)),
  2447.                 gnu_list);
  2448.     }
  2449.  
  2450.   return build_constructor (gnu_table_type, nreverse (gnu_list));
  2451. }
  2452.  
  2453. /* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
  2454.    corresponding to GNAT_OBJECT.  If SIZE is valid, return its integer
  2455.    value.  Otherwise return zero.  If FOR_FIELD is nonzero, this is for a
  2456.    bit field, so we can allow non-byte-aligned sizes.  */
  2457.  
  2458. static int
  2459. validate_size (uint_size, gnu_type, gnat_object, for_field)
  2460.      Uint uint_size;
  2461.      tree gnu_type;
  2462.      Entity_Id gnat_object;
  2463.      int for_field;
  2464. {
  2465.   int size;
  2466.   tree type_size = TYPE_SIZE (gnu_type);
  2467.  
  2468.   if (! UI_Is_In_Int_Range (uint_size))
  2469.     {
  2470.       post_error ("specified size of & is too large", gnat_object);
  2471.       return 0;
  2472.     }
  2473.  
  2474.   size = UI_To_Int (uint_size);
  2475.  
  2476.   /* Get the size of the object; if it is a self-referential object,
  2477.      get its maximum size.  Then see if the specified size is big enough,
  2478.      being sure to compare against the precision for integral types.
  2479.      Note that this test also rejects sizes for variable-sized
  2480.      non-self-referential types, which seems correct.  */
  2481.   if (TREE_CODE (type_size) != INTEGER_CST
  2482.       && contains_placeholder_p (type_size))
  2483.     type_size = max_size (type_size, 1);
  2484.  
  2485.   if (! for_field && size % BITS_PER_UNIT != 0)
  2486.     {
  2487.       post_error ("specifed size for & is not a multiple of STORAGE_UNIT",
  2488.           gnat_object);
  2489.       return 0;
  2490.     }
  2491.  
  2492.   /* If this is an integral type, the front-end has verified the size,
  2493.      so we need not do it here (which would entail checking against 
  2494.      the bounds). */
  2495.   if (INTEGRAL_TYPE_P (gnu_type))
  2496.     return size;
  2497.  
  2498.   /* If this is a RECORD_TYPE that consists of just bitfields, we can
  2499.      represent this object in the number of bits that correspond to
  2500.      the highest bit position in use.  */
  2501.   else if (TREE_CODE (gnu_type) == RECORD_TYPE)
  2502.     {
  2503.       tree largest_end = size_zero_node;
  2504.       tree field;
  2505.  
  2506.       for (field = TYPE_FIELDS (gnu_type); field; field = TREE_CHAIN (field))
  2507.     {
  2508.       if (! DECL_BIT_FIELD (field))
  2509.         break;
  2510.  
  2511.       largest_end
  2512.         = size_binop (MAX_EXPR, largest_end,
  2513.               size_binop (MINUS_EXPR,
  2514.                       size_binop (PLUS_EXPR,
  2515.                           DECL_FIELD_BITPOS (field),
  2516.                           DECL_SIZE (field)),
  2517.                       size_one_node));
  2518.     }
  2519.  
  2520.       if (field == 0)
  2521.     type_size = largest_end;
  2522.     }
  2523.  
  2524.   if (TREE_CODE (type_size) != INTEGER_CST
  2525.       || TREE_OVERFLOW (type_size)
  2526.       || TREE_INT_CST_HIGH (type_size) != 0
  2527.       || size < TREE_INT_CST_LOW (type_size))
  2528.     {
  2529.       post_error ("specified size is too small for &", gnat_object);
  2530.       return 0;
  2531.     }
  2532.  
  2533.   return size;
  2534. }     
  2535.  
  2536. /* GNAT_ALIGNMENT is the Expression of an alignment clause that is
  2537.    specified for a type or object of present alignment ALIGN.  If this
  2538.    alignment is valid, return it.  Otherwise, give an error and return
  2539.    ALIGN.  */
  2540.  
  2541. static int
  2542. validate_alignment (gnat_alignment, align)
  2543.      Node_Id gnat_alignment;
  2544.      int align;
  2545. {
  2546.   int new_align;
  2547.  
  2548.   if (! UI_Is_In_Int_Range (Expr_Value (gnat_alignment))
  2549.       || ((new_align = UI_To_Int (Expr_Value (gnat_alignment)))
  2550.            > BIGGEST_ALIGNMENT / BITS_PER_UNIT))
  2551.     post_error ("alignment specified is larger than maximum machine alignment",
  2552.         gnat_alignment);
  2553.   else if (new_align * BITS_PER_UNIT < align)
  2554.     post_error ("alignment is too small", gnat_alignment);
  2555.   else if ((new_align & (new_align - 1)) != 0)
  2556.     post_error ("alignment is not a power of two", gnat_alignment);
  2557.   else
  2558.     align = new_align * BITS_PER_UNIT;
  2559.  
  2560.   return align;
  2561. }
  2562.  
  2563. /* Given a type T, a FIELD_DECL F, and a replacement value R,
  2564.    return a new type with all size expressions that contain F
  2565.    updated by replacing F with R.  This is identical to GCC's
  2566.    substitute_in_type except that it knows about TYPE_INDEX_TYPE.  */
  2567.  
  2568. tree
  2569. gnat_substitute_in_type (t, f, r)
  2570.      tree t, f, r;
  2571. {
  2572.   switch (TREE_CODE (t))
  2573.     {
  2574.     case POINTER_TYPE:
  2575.     case VOID_TYPE:
  2576.       return t;
  2577.  
  2578.     case INTEGER_TYPE:
  2579.     case ENUMERAL_TYPE:
  2580.     case BOOLEAN_TYPE:
  2581.     case CHAR_TYPE:
  2582.       if ((TREE_CODE (TYPE_MIN_VALUE (t)) != INTEGER_CST
  2583.        && contains_placeholder_p (TYPE_MIN_VALUE (t)))
  2584.       || (TREE_CODE (TYPE_MAX_VALUE (t)) != INTEGER_CST
  2585.           && contains_placeholder_p (TYPE_MAX_VALUE (t))))
  2586.     {
  2587.       tree new;
  2588.  
  2589.       new
  2590.         = build_range_type (t,
  2591.                 substitute_in_expr (TYPE_MIN_VALUE (t), f, r),
  2592.                 substitute_in_expr (TYPE_MAX_VALUE (t), f, r));
  2593.  
  2594.       if (TYPE_INDEX_TYPE (t))
  2595.         TYPE_INDEX_TYPE (new)
  2596.           = gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r);
  2597.       return new;
  2598.     }
  2599.  
  2600.       return t;
  2601.  
  2602.     case REAL_TYPE:
  2603.       if ((TYPE_MIN_VALUE (t) != 0
  2604.        && TREE_CODE (TYPE_MIN_VALUE (t)) != REAL_CST
  2605.        && contains_placeholder_p (TYPE_MIN_VALUE (t)))
  2606.       || (TYPE_MAX_VALUE (t) != 0
  2607.           && TREE_CODE (TYPE_MAX_VALUE (t)) != REAL_CST
  2608.           && contains_placeholder_p (TYPE_MAX_VALUE (t))))
  2609.     {
  2610.       t = copy_type (t);
  2611.  
  2612.       if (TYPE_MIN_VALUE (t))
  2613.         TYPE_MIN_VALUE (t) = substitute_in_expr (TYPE_MIN_VALUE (t), f, r);
  2614.       if (TYPE_MAX_VALUE (t))
  2615.         TYPE_MAX_VALUE (t) = substitute_in_expr (TYPE_MAX_VALUE (t), f, r);
  2616.     }
  2617.       return t;
  2618.  
  2619.     case COMPLEX_TYPE:
  2620.       return build_complex_type (gnat_substitute_in_type (TREE_TYPE (t),
  2621.                               f, r));
  2622.  
  2623.     case OFFSET_TYPE:
  2624.     case METHOD_TYPE:
  2625.     case REFERENCE_TYPE:
  2626.     case FILE_TYPE:
  2627.     case SET_TYPE:
  2628.     case FUNCTION_TYPE:
  2629.     case LANG_TYPE:
  2630.       /* Don't know how to do these yet.  */
  2631.       abort ();
  2632.  
  2633.     case ARRAY_TYPE:
  2634.       {
  2635.     tree new
  2636.       = build_array_type (gnat_substitute_in_type (TREE_TYPE (t), f, r),
  2637.                   gnat_substitute_in_type (TYPE_DOMAIN (t), f, r));
  2638.  
  2639.     TYPE_SIZE (new) = 0;
  2640.     TYPE_MULTI_ARRAY_P (new) = TYPE_MULTI_ARRAY_P (t);
  2641.     TYPE_CONVENTION_FORTRAN_P (new) = TYPE_CONVENTION_FORTRAN_P (t);
  2642.     layout_type (new);
  2643.     return new;
  2644.       }
  2645.  
  2646.     case RECORD_TYPE:
  2647.     case UNION_TYPE:
  2648.     case QUAL_UNION_TYPE:
  2649.       if (TYPE_FAT_POINTER_P (t) || TYPE_HAS_REP_CLAUSE_P (t))
  2650.     return t;
  2651.  
  2652.       {
  2653.     tree new = copy_type (t);
  2654.     tree field;
  2655.     tree last_field = 0;
  2656.     tree parent_subtype = 0;
  2657.     tree old_size = TYPE_SIZE (t);
  2658.  
  2659.     /* If we have a parent subtype, substitute into that.  */
  2660.     if (TYPE_PARENT_SUBTYPE (t))
  2661.       parent_subtype = gnat_substitute_in_type (TYPE_PARENT_SUBTYPE (t),
  2662.                             f, r);
  2663.  
  2664.     /* Start out with no fields, make new fields, and chain them
  2665.        in.  */
  2666.  
  2667.     TYPE_FIELDS (new) = 0;
  2668.     TYPE_SIZE (new) = 0;
  2669.  
  2670.     for (field = TYPE_FIELDS (t); field;
  2671.          field = TREE_CHAIN (field))
  2672.       {
  2673.         tree new_field = copy_node (field);
  2674.  
  2675.         /* If this is a PARENT field and the parent subtype now
  2676.            has a non-self-referential length, use it as the type
  2677.            of this field.  Then show we no longer need to
  2678.            worry about a parent subtype.  */
  2679.         if (DECL_PARENT_P (field) && parent_subtype != 0
  2680.         && (TREE_CONSTANT (TYPE_SIZE (parent_subtype))
  2681.             || ! contains_placeholder_p (TYPE_SIZE (parent_subtype))))
  2682.           {
  2683.         TREE_TYPE (new_field) = parent_subtype;
  2684.         parent_subtype = 0;
  2685.           }
  2686.         else
  2687.           TREE_TYPE (new_field)
  2688.         = gnat_substitute_in_type (TREE_TYPE (new_field), f, r);
  2689.  
  2690.         /* If this is a variant field and the type of this field is
  2691.            a UNION_TYPE or RECORD_TYPE with no elements, ignore it.  If
  2692.            the type just has one element, treat that as the field.
  2693.            But don't do this if we are processing a QUAL_UNION_TYPE.  */
  2694.         if (TREE_CODE (t) != QUAL_UNION_TYPE
  2695.         && DECL_FOR_VARIANT_P (new_field)
  2696.         && (TREE_CODE (TREE_TYPE (new_field)) == UNION_TYPE
  2697.             || TREE_CODE (TREE_TYPE (new_field)) == RECORD_TYPE))
  2698.           {
  2699.         if (TYPE_FIELDS (TREE_TYPE (new_field)) == 0)
  2700.           continue;
  2701.  
  2702.         if (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))) == 0)
  2703.           {
  2704.             /* Make sure omitting the union doesn't change
  2705.                the layout.  */
  2706.             DECL_ALIGN (TYPE_FIELDS (TREE_TYPE (new_field)))
  2707.               = DECL_ALIGN (new_field);
  2708.             new_field = TYPE_FIELDS (TREE_TYPE (new_field));
  2709.           }
  2710.           }
  2711.  
  2712.         DECL_CONTEXT (new_field) = new;
  2713.         DECL_SIZE (new_field) = 0;
  2714.  
  2715.         if (TREE_CODE (t) == QUAL_UNION_TYPE)
  2716.           {
  2717.         /* Do the substitution inside the qualifier and if we find
  2718.            that this field will not be present, omit it.  */
  2719.         DECL_QUALIFIER (new_field)
  2720.           = substitute_in_expr (DECL_QUALIFIER (field), f, r);
  2721.         if (integer_zerop (DECL_QUALIFIER (new_field)))
  2722.           continue;
  2723.           }
  2724.  
  2725.         if (last_field == 0)
  2726.           TYPE_FIELDS (new) = new_field;
  2727.         else
  2728.           TREE_CHAIN (last_field) = new_field;
  2729.  
  2730.         last_field = new_field;
  2731.  
  2732.         /* If this is a qualified type and this field will always be
  2733.            present, we are done.  */
  2734.         if (TREE_CODE (t) == QUAL_UNION_TYPE
  2735.         && integer_onep (DECL_QUALIFIER (new_field)))
  2736.           break;
  2737.       }
  2738.  
  2739.     /* If this used to be a qualified union type, but we now know what
  2740.        field will be present, make this a normal union.  */
  2741.     if (TREE_CODE (new) == QUAL_UNION_TYPE
  2742.         && (TYPE_FIELDS (new) == 0
  2743.         || integer_onep (DECL_QUALIFIER (TYPE_FIELDS (new)))))
  2744.       TREE_SET_CODE (new, UNION_TYPE);
  2745.  
  2746.     TYPE_PARENT_SUBTYPE (new) = parent_subtype;
  2747.     layout_type (new);
  2748.  
  2749.     /* If the size was originally a constant but isn't now, use the
  2750.        constant size.  This can happen when we've made a "max_size"
  2751.        type and then called this function with it.  */
  2752.     if (old_size != 0 && TREE_CODE (old_size) == INTEGER_CST
  2753.         && TREE_CODE (TYPE_SIZE (new)) != INTEGER_CST)
  2754.       TYPE_SIZE (new) = old_size;
  2755.  
  2756.     return new;
  2757.       }
  2758.     }
  2759.  
  2760.   return t;
  2761. }
  2762.  
  2763. /* The external name of an entity is the specified Interface_Name, if any.
  2764.    Otherwise it is:
  2765.  
  2766.     The string "_ada_", if the entity is a library subprogram, followed by
  2767.     the name of any enclosing scope (each followed by "__") followed by
  2768.     the name of the entity followed by
  2769.     the string "__" followed by homonym number for overloaded subprograms. */
  2770.  
  2771. static struct obstack ext_name_obstack;
  2772. static char *ext_name_firstobj;
  2773.  
  2774. /* Return a string representing the external name to be used for
  2775.    GNAT_ENTITY.  If STRING is specified, the name is followed by "___"
  2776.    and the specified string.  */
  2777.  
  2778. char *
  2779. create_concat_name (gnat_entity, string)
  2780.      Entity_Id gnat_entity;
  2781.      char *string;
  2782. {
  2783.   /* Initialize the obstack we are using to construct the name.  */
  2784.   if (!ext_name_firstobj)
  2785.     {
  2786.       gcc_obstack_init (&ext_name_obstack);
  2787.       ext_name_firstobj = obstack_alloc (&ext_name_obstack, 1);
  2788.     }
  2789.   else
  2790.     obstack_free (&ext_name_obstack, ext_name_firstobj);
  2791.  
  2792.   /* If this is a child unit, we want the child.  */
  2793.   if (Nkind (gnat_entity) == N_Defining_Program_Unit_Name)
  2794.     gnat_entity = Defining_Identifier (gnat_entity);
  2795.  
  2796.   if ((Ekind (gnat_entity) == E_Procedure || Ekind (gnat_entity) == E_Function
  2797.        || Ekind (gnat_entity) == E_Constant
  2798.        || Ekind (gnat_entity) == E_Variable)
  2799.       && Present (Interface_Name (gnat_entity)))
  2800.     {
  2801.       String_Id gnat_string = Strval (Interface_Name (gnat_entity));
  2802.       int length = String_Length (gnat_string);
  2803.       int i;
  2804.  
  2805.       for (i = 0; i < length; i++)
  2806.     obstack_1grow (&ext_name_obstack,
  2807.                Get_String_Char (gnat_string, i + 1));
  2808.     }
  2809.   else
  2810.     {
  2811.       /* If this is a a main subprogram, we prepend a prefix to avoid clashes
  2812.      with external C names as main or C library names. A main subprogram
  2813.      is recognized by the fact that its scope is Standard */
  2814.       if (No (Scope (Scope (gnat_entity)))
  2815.       && Is_Subprogram (gnat_entity))
  2816.     obstack_grow (&ext_name_obstack, "_ada_", 5);
  2817.  
  2818.       compute_qualified_name (gnat_entity);
  2819.  
  2820.       if (Has_Homonym (gnat_entity))
  2821.     {
  2822.       Entity_Id e;
  2823.       int number;
  2824.         char buf[10];
  2825.  
  2826.       for (e = Homonym (gnat_entity), number = 1;
  2827.            Present (e); e = Homonym (e))
  2828.         if (Scope (e) == Scope (gnat_entity))
  2829.         number ++;
  2830.  
  2831.       sprintf (buf, "%d", number);
  2832.         if (number != 1)
  2833.           {
  2834. #ifdef NO_DOLLAR_IN_LABEL
  2835.         obstack_grow (&ext_name_obstack, "__", 2);
  2836. #else
  2837.         obstack_grow (&ext_name_obstack, "$", 1);
  2838. #endif
  2839.         obstack_grow (&ext_name_obstack, buf, strlen (buf));
  2840.           }
  2841.     }
  2842.     }
  2843.  
  2844.   if (string)
  2845.     {
  2846.       obstack_grow (&ext_name_obstack, "___", 3);
  2847.       obstack_grow (&ext_name_obstack, string, strlen (string));
  2848.     }
  2849.  
  2850.   obstack_1grow (&ext_name_obstack, 0);
  2851.  
  2852.   return (char *) obstack_base (&ext_name_obstack);
  2853. }
  2854.  
  2855. static void
  2856. compute_qualified_name (gnat_entity)
  2857.      Entity_Id gnat_entity;
  2858. {
  2859.   char *name;
  2860.  
  2861.   /* If the entity is a child package, its name is not a Defining_Identifier,
  2862.      but a Defining_Program_Unit_Name, which does not have a chars field.
  2863.      Its simple name is the final identifier, which is the name to use. */
  2864.  
  2865.   if (Nkind (gnat_entity) == N_Defining_Program_Unit_Name)
  2866.     gnat_entity = Defining_Identifier (gnat_entity);
  2867.  
  2868.   if (Scope (Scope (gnat_entity)))
  2869.     {
  2870.       compute_qualified_name (Scope (gnat_entity));
  2871.       obstack_grow (&ext_name_obstack, "__", 2);
  2872.     }
  2873.  
  2874.   /* Now get the name of the entity */
  2875.   name = Get_Name_String (Chars (gnat_entity));
  2876.   obstack_grow (&ext_name_obstack, name, strlen (name));
  2877. }
  2878.