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 / exp_pakd.adb < prev    next >
Text File  |  1996-09-28  |  29KB  |  800 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                             E X P _ P A K D                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.13 $                             --
  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. with Atree;    use Atree;
  26. with Einfo;    use Einfo;
  27. with Exp_Ch4;  use Exp_Ch4;
  28. with Exp_Util; use Exp_Util;
  29. with Freeze;   use Freeze;
  30. with Nlists;   use Nlists;
  31. with Nmake;    use Nmake;
  32. with Rtsfind;  use Rtsfind;
  33. with Sem;      use Sem;
  34. with Sem_Eval; use Sem_Eval;
  35. with Sem_Res;  use Sem_Res;
  36. with Sem_Util; use Sem_Util;
  37. with Sinfo;    use Sinfo;
  38. with Snames;   use Snames;
  39. with Stand;    use Stand;
  40. with Tbuild;   use Tbuild;
  41. with Ttypes;   use Ttypes;
  42. with Uintp;    use Uintp;
  43.  
  44. package body Exp_Pakd is
  45.  
  46.    ---------------------------
  47.    -- Endian Considerations --
  48.    ---------------------------
  49.  
  50.    --  As described in the specification, bit numbering in a packed array
  51.    --  is consistent with bit numbering in a record representation clause,
  52.    --  and hence dependent on the endianness of the machine:
  53.  
  54.    --    For little-endian machines, element zero is at the right hand end
  55.    --    (low order end) of a bit field.
  56.  
  57.    --    For big-endian machines, element zero is at the left hand end
  58.    --    (high order end) of a bit field.
  59.  
  60.    --  The shifts that are used to right justify a field therefore differ
  61.    --  in the two cases. For the little-endian case, we can simply use the
  62.    --  bit number (i.e. the element number * element size) as the count for
  63.    --  a right shift. For the big-endian case, we have to subtract the shift
  64.    --  count from an appropriate constant to use in the right shift. We use
  65.    --  rotates instead of shifts (which is necessary in the store case to
  66.    --  preserve other fields), and we expect that the backend will be able
  67.    --  to change the right rotate into a left rotate, avoiding the subtract,
  68.    --  if the architecture provides such an instruction.
  69.  
  70.    -----------------------
  71.    -- Local Subprograms --
  72.    -----------------------
  73.  
  74.    function Convert_To_PAT_Type (Aexp : Node_Id) return Node_Id;
  75.    --  Given an expression of a packed array type, builds a corresponding
  76.    --  expression whose type is the implementation type used to represent
  77.    --  the packed array. Aexp is analyzed on entry, and on return Aexp
  78.    --  is rewritten (using Rewrite_Substitute_Tree) by this expression.
  79.    --  The value returned is the modified expression (whose Node_Id is
  80.    --  actually the same as Aexp).
  81.  
  82.    procedure Setup_Packed_Array_Reference
  83.      (N     : Node_Id;
  84.       Vsiz  : out Uint;
  85.       Csiz  : out Nat);
  86.    --  This procedure performs common processing on the N_Indexed_Component
  87.    --  parameter given as N, whose prefix is a reference to a packed array.
  88.    --  On return, the indexed component has been modified as follows:
  89.  
  90.    --    The prefix is the object containing the desired bit field. It is
  91.    --    of type Unsigned or Long_Long_Unsigned, and is either the entire
  92.    --    value, for the small static case, or the proper selected word from
  93.    --    the array in the large or dynamic case. This node is analyzed and
  94.    --    resolved on return.
  95.    --
  96.    --    The subscript is a node representing the shift count to be used in
  97.    --    the rotate right instruction that positions the field for access.
  98.    --
  99.    --  The prefix and subscript are analyzed on return. In fact the reason
  100.    --  we return these values by rewriting the indexed component is to keep
  101.    --  everything properly connected to the tree. The remaining parameters
  102.    --  are set as follows on return:
  103.    --
  104.    --    Vsiz is the data size, either Unsigned'Size for the array or the
  105.    --    actual Esize for the static modular type case.
  106.    --
  107.    --    Csiz is the component size (either 1, 2 or 4)
  108.    --
  109.    --  Note: in some cases the call to this routine may generate actions
  110.    --  (for handling multi-use references and the generation of the packed
  111.    --  array type on the fly). Such actions are inserted into the tree
  112.    --  directly using Insert_Action.
  113.  
  114.    -------------------------
  115.    -- Convert_To_PAT_Type --
  116.    -------------------------
  117.  
  118.    --  The PAT is always obtained from the actual subtype
  119.  
  120.    function Convert_To_PAT_Type (Aexp : Entity_Id) return Entity_Id is
  121.       Result : constant Entity_Id := Convert_To_Actual_Subtype (Aexp);
  122.       Act_ST : constant Entity_Id := Etype (Result);
  123.       PAT    : Entity_Id;
  124.       Decl   : Node_Id;
  125.  
  126.    begin
  127.       --  OK, we have the actual subtype. If it already has a packed
  128.       --  array type precalculated, then we can use this type.
  129.  
  130.       if Present (Packed_Array_Type (Act_ST)) then
  131.          PAT := Packed_Array_Type (Act_ST);
  132.  
  133.       --  Otherwise we need to build the packed array type
  134.  
  135.       else
  136.          Expand_Packed_Array_Type (Act_ST, PAT, Decl);
  137.          Insert_Action (Aexp, Decl);
  138.          Insert_Actions (Aexp, Freeze_Entity (PAT, Sloc (Aexp)));
  139.       end if;
  140.  
  141.       --  Finally what we return is the result of doing an unchecked
  142.       --  conversion from the actual subtype to the packed array type
  143.  
  144.       Rewrite_Substitute_Tree (Aexp,
  145.         Unchecked_Convert_To (PAT, Relocate_Node (Aexp)));
  146.  
  147.       Analyze (Aexp);
  148.       Resolve (Aexp, PAT);
  149.       return Aexp;
  150.    end Convert_To_PAT_Type;
  151.  
  152.    ------------------------------------
  153.    -- Expand_Packed_Boolean_Operator --
  154.    ------------------------------------
  155.  
  156.    --  This routine expands "a op b" for the packed cases
  157.  
  158.    procedure Expand_Packed_Boolean_Operator (N : Node_Id) is
  159.       Loc : constant Source_Ptr := Sloc (N);
  160.       Typ : constant Entity_Id  := Etype (N);
  161.       L   : constant Node_Id    := Convert_To_PAT_Type (Left_Opnd  (N));
  162.       R   : constant Node_Id    := Convert_To_PAT_Type (Right_Opnd (N));
  163.       PAT : constant Entity_Id  := Etype (L);
  164.  
  165.    begin
  166.       --  For the modular case, we expand a op b into
  167.  
  168.       --    typ!(pat!(a) op pat!(b))
  169.  
  170.       if Is_Modular_Integer_Type (PAT) then
  171.          declare
  172.             P : Node_Id;
  173.  
  174.          begin
  175.             if Nkind (N) = N_Op_And then
  176.                P := Make_Op_And (Loc, L, R);
  177.             elsif Nkind (N) = N_Op_Or then
  178.                P := Make_Op_And (Loc, L, R);
  179.             else -- Nkind (N) = N_Op_Xor
  180.                P := Make_Op_Xor (Loc, L, R);
  181.             end if;
  182.  
  183.             Rewrite_Substitute_Tree (N, Unchecked_Convert_To (Typ, P));
  184.          end;
  185.  
  186.       --  For the non-modular case, we use Exp_Ch4.Make_Boolean_Array to build
  187.       --  a function that does the necessary loop of operations on the array,
  188.       --  and then replace the operation with a call to this function, doing
  189.       --  the necessary unchecked conversions, and then replace the logical
  190.       --  operation with a call to this function:
  191.  
  192.       --    typ!(func (pat!(a), pat!(b)))
  193.  
  194.       else
  195.          declare
  196.             Func_Body : constant Node_Id   := Make_Boolean_Array_Op (PAT, N);
  197.             Func_Name : constant Entity_Id := Defining_Unit_Name
  198.                                                 (Specification (Func_Body));
  199.  
  200.          begin
  201.             Insert_Action (N, Func_Body);
  202.  
  203.             Rewrite_Substitute_Tree (N,
  204.               Unchecked_Convert_To (Typ,
  205.                 Make_Function_Call (Loc,
  206.                   Name => New_Reference_To (Func_Name, Loc),
  207.                   Parameter_Associations => New_List (L, R))));
  208.          end;
  209.       end if;
  210.  
  211.       Analyze (N);
  212.       Resolve (N, Typ);
  213.    end Expand_Packed_Boolean_Operator;
  214.  
  215.    ------------------------------
  216.    -- Expand_Packed_Array_Type --
  217.    ------------------------------
  218.  
  219.    procedure Expand_Packed_Array_Type
  220.      (Typ  : Entity_Id;
  221.       PAT  : out Entity_Id;
  222.       Decl : out Node_Id)
  223.    is
  224.       Loc      : constant Source_Ptr := Sloc (Typ);
  225.       Base     : constant Entity_Id  := Base_Type (Typ);
  226.       Ctyp     : constant Entity_Id  := Component_Type (Typ);
  227.       Styp     : constant Entity_Id  := Etype (First_Index (Typ));
  228.       Static   : constant Boolean    := Is_OK_Static_Subtype (Styp);
  229.       Lo_Bound : constant Node_Id    := Type_Low_Bound (Styp);
  230.       Hi_Bound : constant Node_Id    := Type_High_Bound (Styp);
  231.       Siz      : Int                 := UI_To_Int (Esize (Ctyp));
  232.       Len_Bits : Uint;
  233.       Bits_U1  : Node_Id;
  234.       PAT_High : Node_Id;
  235.       Der_Tdef : Node_Id;
  236.       Btyp     : RE_Id;
  237.       Fnode    : Node_Id;
  238.       Type_Def : Node_Id;
  239.  
  240.    begin
  241.       pragma Assert (Ekind (Typ) = E_Array_Subtype);
  242.  
  243.       --  Use 4-bit fields for 3-bit quantities
  244.  
  245.       if Siz = 3 then
  246.          Siz := 4;
  247.       end if;
  248.  
  249.       --  The name of the packed array type is
  250.  
  251.       --    tttPx
  252.  
  253.       --  where x is 1,2 or 4 for the component size in bits and ttt is
  254.       --  the name of the parent packed type.
  255.  
  256.       PAT :=
  257.         Make_Defining_Identifier (Loc,
  258.           Chars => New_External_Name (Chars (Typ), 'P', Siz));
  259.  
  260.       if Static then
  261.          Len_Bits :=
  262.            (Expr_Value (Hi_Bound) - Expr_Value (Lo_Bound) + 1) * Siz;
  263.       end if;
  264.  
  265.       --  We are now going to build the Packed_Array_Type. For unconstrained
  266.       --  packed arrays, the corresponding type is simply:
  267.  
  268.       --    type tttPn is new Raw_Bits
  269.  
  270.       if not Is_Constrained (Typ) then
  271.          Der_Tdef :=
  272.            Make_Derived_Type_Definition (Loc,
  273.              Subtype_Indication =>
  274.                New_Occurrence_Of (RTE (RE_Raw_Bits), Loc));
  275.  
  276.       --  If the size is static, and in the range 1 .. Long_Long_Integer'Size
  277.       --  (= Long_Long_Unsigned'Size), we use a subtype of a modular type:
  278.  
  279.       --    type tttPn is new btyp
  280.       --       range 0 .. 2 ** (Esize (Typ) * Siz) - 1;
  281.  
  282.       --  Here Siz is 1, 2 or 4, as computed above and btyp is either Unsigned
  283.       --  or Long_Long_Unsigned, depending on the size.
  284.  
  285.       elsif Static
  286.         and then Len_Bits <= Standard_Long_Long_Integer_Size
  287.       then
  288.          if Len_Bits <= Standard_Integer_Size then
  289.             Btyp := RE_Unsigned;
  290.          else
  291.             Btyp := RE_Long_Long_Unsigned;
  292.          end if;
  293.  
  294.          Der_Tdef :=
  295.            Make_Derived_Type_Definition (Loc,
  296.              Subtype_Indication =>
  297.                Make_Subtype_Indication (Loc,
  298.                  Subtype_Mark => New_Occurrence_Of (RTE (Btyp), Loc),
  299.                  Constraint   =>
  300.                    Make_Range_Constraint (Loc,
  301.                      Range_Expression =>
  302.                        Make_Range (Loc,
  303.                          Low_Bound => Make_Integer_Literal (Loc, Uint_0),
  304.                          High_Bound =>
  305.                            Make_Integer_Literal (Loc,
  306.                              Intval => 2 ** Len_Bits - 1)))));
  307.  
  308.       --  For all other cases, we build an array type:
  309.  
  310.       --    type tttPn is
  311.       --      new System.Raw_Bits (0 .. (Bits + (Usiz - 1)) / Usiz - 1);
  312.  
  313.       --  Usiz is Uns'Size which is the same as Integer'Size, since
  314.       --  that is how the type System.Unsigned is defined. Bits is the
  315.       --  length of the array in bits.
  316.  
  317.       else
  318.          Bits_U1 :=
  319.            Make_Op_Add (Loc,
  320.              Left_Opnd =>
  321.                Make_Op_Multiply (Loc,
  322.                  Left_Opnd  =>
  323.                    Make_Integer_Literal (Loc, UI_From_Int (Siz)),
  324.                  Right_Opnd =>
  325.                    Make_Attribute_Reference (Loc,
  326.                      Attribute_Name => Name_Range_Length,
  327.                      Prefix => New_Occurrence_Of (Styp, Loc))),
  328.              Right_Opnd =>
  329.                Make_Integer_Literal (Loc,
  330.                  Intval => UI_From_Int (Standard_Integer_Size - 1)));
  331.  
  332.          Set_Paren_Count (Bits_U1, 1);
  333.  
  334.          PAT_High :=
  335.            Make_Op_Subtract (Loc,
  336.              Left_Opnd =>
  337.                Make_Op_Divide (Loc,
  338.                  Left_Opnd => Bits_U1,
  339.                  Right_Opnd =>
  340.                    Make_Integer_Literal (Loc,
  341.                      Intval => UI_From_Int (Standard_Integer_Size))),
  342.              Right_Opnd => Make_Integer_Literal (Loc, Uint_1));
  343.  
  344.          Der_Tdef :=
  345.            Make_Derived_Type_Definition (Loc,
  346.              Subtype_Indication =>
  347.                Make_Subtype_Indication (Loc,
  348.                  Subtype_Mark =>
  349.                    New_Occurrence_Of (RTE (RE_Raw_Bits), Loc),
  350.                  Constraint =>
  351.                    Make_Index_Or_Discriminant_Constraint (Loc,
  352.                      Constraints => New_List (
  353.                        Make_Range (Loc,
  354.                          Low_Bound =>
  355.                            Make_Integer_Literal (Loc, Uint_0),
  356.                          High_Bound => PAT_High)))));
  357.       end if;
  358.  
  359.       --  Now we set the full type declaration as the result
  360.  
  361.       Decl :=
  362.         Make_Full_Type_Declaration (Loc,
  363.           Defining_Identifier => PAT,
  364.           Type_Definition => Der_Tdef);
  365.  
  366.    end Expand_Packed_Array_Type;
  367.  
  368.    -------------------------------
  369.    -- Expand_Packed_Element_Get --
  370.    -------------------------------
  371.  
  372.    procedure Expand_Packed_Element_Get (N : Node_Id) is
  373.       Loc     : constant Source_Ptr := Sloc (N);
  374.       Ctyp    : constant Entity_Id  := Component_Type (Etype (Prefix (N)));
  375.       Obj     : Node_Id;
  376.       Shift   : Node_Id;
  377.       Cod     : List_Id;
  378.       Vsiz    : Uint;
  379.       Csiz    : Nat;
  380.  
  381.    begin
  382.       Setup_Packed_Array_Reference (N, Vsiz, Csiz);
  383.       Shift := Relocate_Node (First (Expressions (N)));
  384.       Obj   := Prefix (N);
  385.  
  386.       --  We generate a shift right to position the field, followed
  387.       --  by a masking operation to extract the bit field, and we
  388.       --  finally do a Val operation to convert the result to the
  389.       --  required target type.
  390.  
  391.       Rewrite_Substitute_Tree (N,
  392.         Make_Attribute_Reference (Loc,
  393.           Prefix => New_Reference_To (Ctyp, Loc),
  394.           Attribute_Name => Name_Val,
  395.           Expressions => New_List (
  396.             Make_Op_And (Loc,
  397.               Left_Opnd =>
  398.                 Make_Op_Shift_Right (Loc,
  399.                   Left_Opnd => Obj,
  400.                   Right_Opnd => Shift),
  401.               Right_Opnd => Make_Integer_Literal (Loc, 2 ** Csiz - 1)))));
  402.  
  403.       Analyze (N);
  404.       Resolve (N, Ctyp);
  405.  
  406.    end Expand_Packed_Element_Get;
  407.  
  408.    -------------------------------
  409.    -- Expand_Packed_Element_Set --
  410.    -------------------------------
  411.  
  412.    procedure Expand_Packed_Element_Set (N : Node_Id) is
  413.       Loc    : constant Source_Ptr := Sloc (N);
  414.       Lhs    : constant Node_Id    := Name (N);
  415.       Rhs    : constant Node_Id    := Expression (N);
  416.       Ctyp   : constant Entity_Id  := Etype (Rhs);
  417.       Result : Node_Id;
  418.       Obj    : Node_Id;
  419.       Shift  : Node_Id;
  420.       Vsiz   : Uint;
  421.       Csiz   : Nat;
  422.       Or_Rhs : Node_Id;
  423.  
  424.    begin
  425.       Setup_Packed_Array_Reference (Lhs, Vsiz, Csiz);
  426.       Shift := Relocate_Node (First (Expressions (Lhs)));
  427.       Obj   := Prefix (Lhs);
  428.  
  429.       --  The statement to be generated is:
  430.  
  431.       --    Obj := (((Obj >> Shift) and Mask) or Or_Rhs) << Shift)
  432.  
  433.       --  where >> and << are rotate right and left respectively, and
  434.       --  Mask is a mask that removes the old bits from the value.
  435.  
  436.       --  The right hand side, Or_Rhs must be of Etype (Obj). A special
  437.       --  case arises if what we have now is a Val attribute reference whose
  438.       --  expression type is Etype (Obj). This happens for assignments of
  439.       --  fields from the same array. In this case we get the required right
  440.       --  hand side by simply removing the inner attribute reference.
  441.  
  442.       if Nkind (Rhs) = N_Attribute_Reference
  443.         and then Attribute_Name (Rhs) = Name_Val
  444.         and then Etype (First (Expressions (Rhs))) = Etype (Obj)
  445.       then
  446.          Or_Rhs := First (Expressions (Rhs));
  447.  
  448.       --  Otherwise we get the expression to the right type by taking X'Pos
  449.       --  of the expression, where X is the component type (i.e. Ctyp).
  450.  
  451.       else
  452.          Or_Rhs :=
  453.            Make_Attribute_Reference (Loc,
  454.              Prefix => New_Occurrence_Of (Ctyp, Loc),
  455.              Attribute_Name => Name_Pos,
  456.              Expressions => New_List (Relocate_Node (Rhs)));
  457.       end if;
  458.  
  459.       --  Now do the rewrite
  460.  
  461.       Rewrite_Substitute_Tree (N,
  462.         Make_Assignment_Statement (Loc,
  463.           Name => Duplicate_Subexpr (Obj, True),
  464.           Expression =>
  465.             Make_Op_Rotate_Left (Loc,
  466.  
  467.               Left_Opnd =>
  468.                 Make_Op_Or (Loc,
  469.  
  470.                   Left_Opnd =>
  471.                     Make_Op_And (Loc,
  472.                       Left_Opnd =>
  473.                         Make_Op_Rotate_Right (Loc,
  474.                           Left_Opnd  => Duplicate_Subexpr (Obj, True),
  475.                           Right_Opnd => Duplicate_Subexpr (Shift)),
  476.  
  477.                       Right_Opnd =>
  478.                         Make_Integer_Literal (Loc,
  479.                           Intval => (2 ** Vsiz - 1) - (2 ** Csiz - 1))),
  480.  
  481.                   Right_Opnd => Or_Rhs),
  482.  
  483.               Right_Opnd => Duplicate_Subexpr (Shift))));
  484.  
  485.       Analyze (N);
  486.  
  487.    end Expand_Packed_Element_Set;
  488.  
  489.    -----------------------
  490.    -- Expand_Packed_Not --
  491.    -----------------------
  492.  
  493.    --  Handles expansion of not on packed array types
  494.  
  495.    procedure Expand_Packed_Not (N : Node_Id) is
  496.       Loc  : constant Source_Ptr := Sloc (N);
  497.       Typ  : constant Entity_Id  := Etype (N);
  498.       Opnd : constant Node_Id    := Convert_To_PAT_Type (Right_Opnd (N));
  499.       PAT  : constant Entity_Id  := Etype (Opnd);
  500.       A    : Entity_Id;
  501.       B    : Entity_Id;
  502.       J    : Entity_Id;
  503.       A_J  : Node_Id;
  504.       B_J  : Node_Id;
  505.  
  506.       Func_Name      : Entity_Id;
  507.       Func_Body      : Node_Id;
  508.       Loop_Statement : Node_Id;
  509.       Result         : Node_Id;
  510.       Type_Of_B      : Node_Id;
  511.  
  512.    begin
  513.       --  For the case where the packed array type is a modular type,
  514.       --  not A expands simply into:
  515.  
  516.       --     typ!(PAT!(A) xor mask)
  517.  
  518.       --  where PAT is the packed array type, and mask is a mask of all
  519.       --  one bits of length equal to the size of this packed type.
  520.  
  521.       if not Is_Array_Type (PAT) then
  522.          Rewrite_Substitute_Tree (N,
  523.            Unchecked_Convert_To (Typ,
  524.              Make_Op_Xor (Loc,
  525.                Left_Opnd  => Opnd,
  526.                Right_Opnd =>
  527.                  Make_Integer_Literal (Loc,
  528.                    Intval => 2 ** Esize (PAT) - 1))));
  529.  
  530.       --  For the array case, we build and insert into the tree the following
  531.       --  function definition
  532.  
  533.       --     function Nnnn (A : PAT) is
  534.       --       B : PAT;
  535.       --     begin
  536.       --       for J in A'range loop
  537.       --          B (J) := not A (J);
  538.       --       end loop;
  539.       --       return B;
  540.       --     end Nnnn;
  541.  
  542.       --  We then replace the not operation with a call to this function.
  543.       --  The call does the necessary unchecked conversions to and from PAT
  544.  
  545.       --  Note: above is wrong, does not do the right thing with the last
  546.       --  word, which may be only partially filled. ???
  547.  
  548.       else
  549.          A := Make_Defining_Identifier (Loc, Name_uA);
  550.          B := Make_Defining_Identifier (Loc, Name_uB);
  551.          J := Make_Defining_Identifier (Loc, Name_uJ);
  552.  
  553.          A_J :=
  554.            Make_Indexed_Component (Loc,
  555.              Prefix      => New_Reference_To (A, Loc),
  556.              Expressions => New_List (New_Reference_To (J, Loc)));
  557.  
  558.          B_J :=
  559.            Make_Indexed_Component (Loc,
  560.              Prefix      => New_Reference_To (B, Loc),
  561.              Expressions => New_List (New_Reference_To (J, Loc)));
  562.  
  563.          Loop_Statement :=
  564.            Make_Loop_Statement (Loc,
  565.              Identifier => Empty,
  566.  
  567.              Iteration_Scheme =>
  568.                Make_Iteration_Scheme (Loc,
  569.                  Loop_Parameter_Specification =>
  570.                    Make_Loop_Parameter_Specification (Loc,
  571.                      Defining_Identifier => J,
  572.                      Discrete_Subtype_Definition =>
  573.                        Make_Attribute_Reference (Loc,
  574.                          Prefix => Make_Identifier (Loc, Chars (A)),
  575.                          Attribute_Name => Name_Range))),
  576.  
  577.              Statements => New_List (
  578.                Make_Assignment_Statement (Loc,
  579.                  Name       => B_J,
  580.                  Expression => Make_Op_Not (Loc, A_J))));
  581.  
  582.          Func_Name :=
  583.            Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
  584.  
  585.          Insert_Action (N,
  586.            Make_Subprogram_Body (Loc,
  587.              Specification =>
  588.                Make_Function_Specification (Loc,
  589.                  Defining_Unit_Name => Func_Name,
  590.                  Parameter_Specifications => New_List (
  591.                    Make_Parameter_Specification (Loc,
  592.                      Defining_Identifier => A,
  593.                      Parameter_Type      => New_Reference_To (PAT, Loc))),
  594.                  Subtype_Mark => New_Reference_To (PAT, Loc)),
  595.  
  596.              Declarations => New_List (
  597.                Make_Object_Declaration (Loc,
  598.                  Defining_Identifier => B,
  599.                  Object_Definition   => New_Reference_To (PAT, Loc))),
  600.  
  601.              Handled_Statement_Sequence =>
  602.                Make_Handled_Sequence_Of_Statements (Loc,
  603.                  Statements => New_List (
  604.                    Loop_Statement,
  605.                    Make_Return_Statement (Loc,
  606.                      Expression =>
  607.                        Make_Identifier (Loc, Chars (B)))))));
  608.  
  609.          --  Now we replace the node with a call to this function:
  610.  
  611.          --    typ!(func (pat!(n)))
  612.  
  613.          Rewrite_Substitute_Tree (N,
  614.            Unchecked_Convert_To (Typ,
  615.              Make_Function_Call (Loc,
  616.                Name => New_Reference_To (Func_Name, Loc),
  617.                Parameter_Associations => New_List (Relocate_Node (Opnd)))));
  618.       end if;
  619.  
  620.       Analyze (N);
  621.       Resolve (N, Typ);
  622.  
  623.    end Expand_Packed_Not;
  624.  
  625.    ----------------------------------
  626.    -- Setup_Packed_Array_Reference --
  627.    ----------------------------------
  628.  
  629.    procedure Setup_Packed_Array_Reference
  630.      (N     : Node_Id;
  631.       Vsiz  : out Uint;
  632.       Csiz  : out Nat)
  633.    is
  634.       Loc    : constant Source_Ptr := Sloc (N);
  635.       Atyp   : constant Entity_Id  := Etype (Prefix (N));
  636.       Ctyp   : constant Entity_Id  := Component_Type (Atyp);
  637.       Styp   : constant Entity_Id  := Etype (First_Index (Atyp));
  638.       Sub    : constant Node_Id    := First (Expressions (N));
  639.       Arr    : constant Node_Id    := Convert_To_PAT_Type (Prefix (N));
  640.       PAT    : constant Entity_Id  := Etype (Arr);
  641.       Otyp   : Entity_Id;
  642.       Subscr : Node_Id;
  643.  
  644.    begin
  645.       Csiz := UI_To_Int (Esize (Ctyp));
  646.  
  647.       if Csiz = 4 then
  648.          Csiz := 3;
  649.       end if;
  650.  
  651.       if Is_Array_Type (PAT) then
  652.          Vsiz := Esize (Component_Type (PAT));
  653.          Otyp := Component_Type (PAT);
  654.       else
  655.          Vsiz := Esize (PAT);
  656.          Otyp := PAT;
  657.       end if;
  658.  
  659.       --  Get expression for the subscript value. First, if Do_Range_Check
  660.       --  is set on the subscript, then we must do a range check against the
  661.       --  original bounds (not the bounds of the packed array type). We do
  662.       --  this by introducing a subtype conversion.
  663.  
  664.       if Do_Range_Check (Sub)
  665.         and then Etype (Sub) /= Styp
  666.       then
  667.          Rewrite_Substitute_Tree (Sub, Convert_To (Styp, Sub));
  668.       end if;
  669.  
  670.       --  Next, we want the subscript to be of type Integer, and zero based.
  671.       --  If it is of an integer type now, we just subtract:
  672.  
  673.       --      Integer (subscript) - Integer (Styp'First)
  674.  
  675.       if Is_Integer_Type (Styp) then
  676.          Rewrite_Substitute_Tree (Sub,
  677.            Make_Op_Subtract (Loc,
  678.              Left_Opnd => Convert_To (Standard_Integer, Sub),
  679.              Right_Opnd =>
  680.                Convert_To (Standard_Integer,
  681.                  Make_Attribute_Reference (Loc,
  682.                    Prefix => New_Occurrence_Of (Styp, Loc),
  683.                    Attribute_Name => Name_First))));
  684.  
  685.       --  For the enumeration case, we have to use 'Pos to get the value
  686.       --  to work with before subtracting the lower bound.
  687.  
  688.       --    Integer (Styp'Pos (Sub)) - Integer (Styp'Pos (Styp'First));
  689.  
  690.       else
  691.          pragma Assert (Is_Enumeration_Type (Styp));
  692.  
  693.          Rewrite_Substitute_Tree (Sub,
  694.            Make_Op_Subtract (Loc,
  695.              Left_Opnd => Convert_To (Standard_Integer,
  696.                Make_Attribute_Reference (Loc,
  697.                  Prefix => New_Occurrence_Of (Styp, Loc),
  698.                  Attribute_Name => Name_Pos,
  699.                  Expressions => New_List (Relocate_Node (Sub)))),
  700.  
  701.              Right_Opnd =>
  702.                Convert_To (Standard_Integer,
  703.                  Make_Attribute_Reference (Loc,
  704.                    Prefix => New_Occurrence_Of (Styp, Loc),
  705.                    Attribute_Name => Name_Pos,
  706.                    Expressions => New_List (
  707.                      Make_Attribute_Reference (Loc,
  708.                      Prefix => New_Occurrence_Of (Styp, Loc),
  709.                      Attribute_Name => Name_First))))));
  710.       end if;
  711.  
  712.       --  If the component size is 2 or 4, then the subscript must be
  713.       --  multiplied by the component size to get the shift count.
  714.  
  715.       if Csiz /= 1 then
  716.          Rewrite_Substitute_Tree (Sub,
  717.            Make_Op_Multiply (Loc,
  718.              Left_Opnd => Make_Integer_Literal (Loc, UI_From_Int (Csiz)),
  719.              Right_Opnd => Relocate_Node (Sub)));
  720.       end if;
  721.  
  722.       --  Now we have the shift count within the entire value. In the
  723.       --  following code, we may be doing a Duplicate_Subexpr on the value
  724.       --  which means that it must be analyzed.
  725.  
  726.       Analyze (Sub);
  727.       Resolve (Sub, Standard_Integer);
  728.  
  729.       --  If we have the array case, then this shift count must be broken
  730.       --  down into a word subscript, and a shift within the word.
  731.  
  732.       if Is_Array_Type (PAT) then
  733.  
  734.          --  The shift count within the word is
  735.          --    shift mod Unsigned'Size
  736.  
  737.          Rewrite_Substitute_Tree (Sub,
  738.            Make_Op_Mod (Loc,
  739.              Left_Opnd  => Relocate_Node (Sub),
  740.              Right_Opnd => Make_Integer_Literal (Loc, Vsiz)));
  741.  
  742.          --  The subscript to be used on the PAT array is
  743.          --    shift / Unsigned'Size
  744.  
  745.          Rewrite_Substitute_Tree (Arr,
  746.            Make_Indexed_Component (Loc,
  747.              Prefix => Relocate_Node (Arr),
  748.              Expressions => New_List (
  749.                Make_Op_Divide (Loc,
  750.                  Left_Opnd => Duplicate_Subexpr (Left_Opnd (Sub)),
  751.                  Right_Opnd => Make_Integer_Literal (Loc, Vsiz)))));
  752.  
  753.       --  For the non-array case, the word shift count is already
  754.       --  set, and all we need is the unchecked conversion of the
  755.       --  array to the PAT type.
  756.  
  757.       else
  758.          Rewrite_Substitute_Tree (Arr, Unchecked_Convert_To (PAT, Arr));
  759.       end if;
  760.  
  761.       --  The one remaining step is to modify the shift count for the
  762.       --  big-endian case. Consider the following example in a word
  763.       --  of 32 bits
  764.  
  765.       --     xxxxxxxx  xxxxxxxx  xxxxxxxx  xxxxxxxx  bits of word
  766.       --                   vvvv  vvvvvvvv  vvvvvvvv  bits of value
  767.       --                   9988  77665544  33221100  little-endian numbering
  768.       --                   0011  22334455  66778899  big-endian numbering
  769.  
  770.       --  Here we have the case of 2-bit fields, with an array of ten such
  771.       --  elements stored in a 20-bit field, loaded as a 32-bit word.
  772.  
  773.       --  For the little-endian case, we already have the proper rotate
  774.       --  count set, e.g. for element 2, the shift count is 2*2 = 4.
  775.  
  776.       --  For the big endian case, we have to adjust the shift count,
  777.       --  computing it as N - shift, where N is the number of bits in
  778.       --  the value, and shift is the shift count so far computed.
  779.  
  780.       if Bytes_Big_Endian then
  781.          Rewrite_Substitute_Tree (Sub,
  782.            Make_Op_Subtract (Loc,
  783.              Left_Opnd => Make_Integer_Literal (Loc, Vsiz),
  784.              Right_Opnd => Relocate_Node (Sub)));
  785.       end if;
  786.  
  787.       --  We return both the Object and the Shift count in analyzed form.
  788.       --  Note that the N_Indexed_Component node is destroyed, but that's
  789.       --  fine, because we are going to rewrite it anyway.
  790.  
  791.       Analyze (Arr);
  792.       Resolve (Arr, Otyp);
  793.  
  794.       Analyze (Sub);
  795.       Resolve (Sub, Standard_Integer);
  796.  
  797.    end Setup_Packed_Array_Reference;
  798.  
  799. end Exp_Pakd;
  800.