-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Nmake; use Nmake;
with Opt; use Opt;
with Restrict; use Restrict;
+with Rident; use Rident;
with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
-- If Discard_Names or No_Implicit_Heap_Allocations are in effect,
-- generate a dummy declaration only.
- if Restrictions (No_Implicit_Heap_Allocations)
+ if Restriction_Active (No_Implicit_Heap_Allocations)
or else Global_Discard_Names
then
T_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
return Build_Task_Image_Function (Loc, Decls, Stats, Res);
end Build_Task_Record_Image;
+ ----------------------------------
+ -- Component_May_Be_Bit_Aligned --
+ ----------------------------------
+
+ function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean is
+ begin
+ -- If no component clause, then everything is fine, since the
+ -- back end never bit-misaligns by default, even if there is
+ -- a pragma Packed for the record.
+
+ if No (Component_Clause (Comp)) then
+ return False;
+ end if;
+
+ -- It is only array and record types that cause trouble
+
+ if not Is_Record_Type (Etype (Comp))
+ and then not Is_Array_Type (Etype (Comp))
+ then
+ return False;
+
+ -- If we know that we have a small (64 bits or less) record
+ -- or bit-packed array, then everything is fine, since the
+ -- back end can handle these cases correctly.
+
+ elsif Esize (Comp) <= 64
+ and then (Is_Record_Type (Etype (Comp))
+ or else Is_Bit_Packed_Array (Etype (Comp)))
+ then
+ return False;
+
+ -- Otherwise if the component is not byte aligned, we
+ -- know we have the nasty unaligned case.
+
+ elsif Normalized_First_Bit (Comp) /= Uint_0
+ or else Esize (Comp) mod System_Storage_Unit /= Uint_0
+ then
+ return True;
+
+ -- If we are large and byte aligned, then OK at this level
+
+ else
+ return False;
+ end if;
+ end Component_May_Be_Bit_Aligned;
+
-------------------------------
-- Convert_To_Actual_Subtype --
-------------------------------
N_Compilation_Unit_Aux |
N_Component_Clause |
N_Component_Declaration |
+ N_Component_Definition |
N_Component_List |
N_Constrained_Array_Definition |
N_Decimal_Fixed_Point_Definition |
function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
begin
+ -- ??? GCC3 will eventually handle strings with arbitrary alignments,
+ -- but for now the following check must be disabled.
+
+ -- if get_gcc_version >= 3 then
+ -- return False;
+ -- end if;
+
if Is_Entity_Name (P)
and then Is_Object (Entity (P))
and then Present (Renamed_Object (Entity (P)))
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uParent),
- Subtype_Indication => New_Reference_To (Constr_Root, Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Constr_Root, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('C')),
- Subtype_Indication => New_Reference_To (Str_Type, Loc))),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Str_Type, Loc)))),
+
Variant_Part => Empty))));
Insert_Actions (E, List_Def);
when N_Unchecked_Expression =>
return Side_Effect_Free (Expression (N));
+ -- A literal is side effect free
+
+ when N_Character_Literal |
+ N_Integer_Literal |
+ N_Real_Literal |
+ N_String_Literal
+ =>
+ return True;
+
-- We consider that anything else has side effects. This is a bit
-- crude, but we are pretty close for most common cases, and we
-- are certainly correct (i.e. we never return True when the
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Exp_Type, Loc),
- Constant_Present => True,
+ Constant_Present => not Is_Variable (Exp),
Expression => Relocate_Node (Exp));
Set_Assignment_OK (E);
and then Esize (Left_Typ) = Esize (Result_Typ);
end Target_Has_Fixed_Ops;
+ ------------------------------------------
+ -- Type_May_Have_Bit_Aligned_Components --
+ ------------------------------------------
+
+ function Type_May_Have_Bit_Aligned_Components
+ (Typ : Entity_Id) return Boolean
+ is
+ begin
+ -- Array type, check component type
+
+ if Is_Array_Type (Typ) then
+ return
+ Type_May_Have_Bit_Aligned_Components (Component_Type (Typ));
+
+ -- Record type, check components
+
+ elsif Is_Record_Type (Typ) then
+ declare
+ E : Entity_Id;
+
+ begin
+ E := First_Entity (Typ);
+ while Present (E) loop
+ if Ekind (E) = E_Component
+ or else Ekind (E) = E_Discriminant
+ then
+ if Component_May_Be_Bit_Aligned (E)
+ or else
+ Type_May_Have_Bit_Aligned_Components (Etype (E))
+ then
+ return True;
+ end if;
+ end if;
+
+ Next_Entity (E);
+ end loop;
+
+ return False;
+ end;
+
+ -- Type other than array or record is always OK
+
+ else
+ return False;
+ end if;
+ end Type_May_Have_Bit_Aligned_Components;
+
----------------------------
-- Wrap_Cleanup_Procedure --
----------------------------
OSDN Git Service
