+2012-07-12 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_aggr.adb (Convert_To_Positional): Increase acceptable size
+ of static aggregate when Static_Elaboration_Desired is requested.
+ Add a warning if the request cannot be satisfied either because
+ some components or some array bounds are non-static.
+
+2012-07-12 Thomas Quinot <quinot@adacore.com>
+
+ * exp_pakd.adb: Minor reformatting.
+
+2012-07-12 Tristan Gingold <gingold@adacore.com>
+
+ * tracebak.c: Fix warnings.
+ * raise-gcc.c (__gnat_adjust_context): New function
+ (__gnat_personality_seh0): Call __gnat_adjust_context to adjust
+ PC in machine frame for exceptions that occur in the current
+ function.
+
+2012-07-12 Thomas Quinot <quinot@adacore.com>
+
+ * g-bytswa.adb, g-bytswa.ads, s-bytswa.adb, s-bytswa.ads, Makefile.rtl:
+ Move GNAT.Byte_Swapping to System (with a renaming under GNAT)
+ so that it is usable in expanded code.
+
+2012-07-12 Tristan Gingold <gingold@adacore.com>
+
+ * s-osinte-hpux.ads: Increase alternate stack size on hpux.
+
2012-07-12 Javier Miranda <miranda@adacore.com>
* exp_ch3.adb (Make_Neq_Body): Fix typo in comment.
s-auxdec$(objext) \
s-bitops$(objext) \
s-boarop$(objext) \
+ s-bytswa$(objext) \
s-carsi8$(objext) \
s-carun8$(objext) \
s-casi16$(objext) \
-- The normal limit is 5000, but we increase this limit to 2**24 (about
-- 16 million) if Restrictions (No_Elaboration_Code) or Restrictions
- -- (No_Implicit_Loops) is specified, since in either case, we are at
- -- risk of declaring the program illegal because of this limit.
+ -- (No_Implicit_Loops) is specified, since in either case we are at risk
+ -- of declaring the program illegal because of this limit. We also
+ -- increase the limit when Static_Elaboration_Desired, given that this
+ -- means that objects are intended to be placed in data memory.
Max_Aggr_Size : constant Nat :=
5000 + (2 ** 24 - 5000) *
Boolean'Pos
(Restriction_Active (No_Elaboration_Code)
- or else
- Restriction_Active (No_Implicit_Loops));
+ or else
+ Restriction_Active (No_Implicit_Loops)
+ or else
+ ((Ekind (Current_Scope) = E_Package
+ and then
+ Static_Elaboration_Desired (Current_Scope))));
function Component_Count (T : Entity_Id) return Int;
-- The limit is applied to the total number of components that the
-- we skip this test if either of the restrictions
-- No_Elaboration_Code or No_Implicit_Loops is
-- active, if this is a preelaborable unit or a
- -- predefined unit. This ensures that predefined
- -- units get the same level of constant folding in
- -- Ada 95 and Ada 2005, where their categorization
- -- has changed.
+ -- predefined unit, or if the unit must be placed
+ -- in data memory. This also ensures that
+ -- predefined units get the same level of constant
+ -- folding in Ada 95 and Ada 2005, where their
+ -- categorization has changed.
declare
P : constant Entity_Id :=
if Restriction_Active (No_Elaboration_Code)
or else Restriction_Active (No_Implicit_Loops)
+ or else
+ (Ekind (Current_Scope) = E_Package
+ and then
+ Static_Elaboration_Desired (Current_Scope))
or else Is_Preelaborated (P)
or else (Ekind (P) = E_Package_Body
and then
Analyze_And_Resolve (N, Typ);
end if;
+
+ if (Ekind (Current_Scope) = E_Package
+ and then Static_Elaboration_Desired (Current_Scope))
+ and then Nkind (Parent (N)) = N_Object_Declaration
+ then
+ declare
+ Expr : Node_Id;
+
+ begin
+ if Present (Expressions (N)) then
+ Expr := First (Expressions (N));
+ while Present (Expr) loop
+ if Nkind_In (Expr, N_Integer_Literal, N_Real_Literal)
+ or else
+ (Is_Entity_Name (Expr)
+ and then Ekind (Entity (Expr)) = E_Enumeration_Literal)
+ then
+ null;
+ else
+ Error_Msg_N ("non-static object "
+ & " requires elaboration code?", N);
+ exit;
+ end if;
+ Next (Expr);
+ end loop;
+
+ if Present (Component_Associations (N)) then
+ Error_Msg_N ("object requires elaboration code?", N);
+ end if;
+ end if;
+ end;
+ end if;
end Convert_To_Positional;
----------------------------
-- Now we can rewrite with the proper value
- Lit :=
- Make_Integer_Literal (Loc,
- Intval => Aggregate_Val);
+ Lit := Make_Integer_Literal (Loc, Intval => Aggregate_Val);
Set_Print_In_Hex (Lit);
-- Construct the expression using this literal. Note that it is
-- Note that Rhs_Val has already been normalized to
-- be an unsigned value with the proper number of bits.
- Rhs :=
- Make_Integer_Literal (Loc, Rhs_Val);
+ Rhs := Make_Integer_Literal (Loc, Rhs_Val);
-- Otherwise we need an unchecked conversion
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
--- G N A T . B Y T E _ S W A P P I N G --
+-- G N A T . B Y T E _ S W A P P I N G --
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2012, AdaCore --
+-- Copyright (C) 1995-2012, AdaCore --
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- This is a general implementation that uses GCC intrinsics to take
--- advantage of any machine-specific instructions.
+-- This package does not require a body, since it is a package renaming. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
-with Ada.Unchecked_Conversion; use Ada;
-
-package body GNAT.Byte_Swapping is
-
- type U16 is mod 2**16;
- type U32 is mod 2**32;
- type U64 is mod 2**64;
-
- function Bswap_16 (X : U16) return U16 is (X / 256 or X * 256);
- -- The above is an idiom recognized by GCC
-
- function Bswap_32 (X : U32) return U32;
- pragma Import (Intrinsic, Bswap_32, "__builtin_bswap32");
-
- function Bswap_64 (X : U64) return U64;
- pragma Import (Intrinsic, Bswap_64, "__builtin_bswap64");
-
- --------------
- -- Swapped2 --
- --------------
-
- function Swapped2 (Input : Item) return Item is
- function As_U16 is new Unchecked_Conversion (Item, U16);
- function As_Item is new Unchecked_Conversion (U16, Item);
-
- function Bswap_16 (X : U16) return U16 is (X / 256 or X * 256);
- -- ??? Need to have function local here to allow inlining
- pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2,
- "storage size must be 2 bytes");
- begin
- return As_Item (Bswap_16 (As_U16 (Input)));
- end Swapped2;
-
- --------------
- -- Swapped4 --
- --------------
-
- function Swapped4 (Input : Item) return Item is
- function As_U32 is new Unchecked_Conversion (Item, U32);
- function As_Item is new Unchecked_Conversion (U32, Item);
- pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 4,
- "storage size must be 4 bytes");
- begin
- return As_Item (Bswap_32 (As_U32 (Input)));
- end Swapped4;
-
- --------------
- -- Swapped8 --
- --------------
-
- function Swapped8 (Input : Item) return Item is
- function As_U64 is new Unchecked_Conversion (Item, U64);
- function As_Item is new Unchecked_Conversion (U64, Item);
- pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 8,
- "storage size must be 8 bytes");
- begin
- return As_Item (Bswap_64 (As_U64 (Input)));
- end Swapped8;
-
- -----------
- -- Swap2 --
- -----------
-
- procedure Swap2 (Location : System.Address) is
- X : U16;
- for X'Address use Location;
- begin
- X := Bswap_16 (X);
- end Swap2;
-
- -----------
- -- Swap4 --
- -----------
-
- procedure Swap4 (Location : System.Address) is
- X : U32;
- for X'Address use Location;
- begin
- X := Bswap_32 (X);
- end Swap4;
-
- -----------
- -- Swap8 --
- -----------
-
- procedure Swap8 (Location : System.Address) is
- X : U64;
- for X'Address use Location;
- begin
- X := Bswap_64 (X);
- end Swap8;
-end GNAT.Byte_Swapping;
+pragma No_Body;
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
--- G N A T . B Y T E _ S W A P P I N G --
+-- G N A T . B Y T E _ S W A P P I N G --
-- --
-- S p e c --
-- --
--- Copyright (C) 2006-2011, AdaCore --
+-- Copyright (C) 2006-2012, AdaCore --
-- --
-- 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- --
-- Simple routines for swapping the bytes of 16-, 32-, and 64-bit objects
--- The generic functions should be instantiated with types that are of a size
--- in bytes corresponding to the name of the generic. For example, a 2-byte
--- integer type would be compatible with Swapped2, 4-byte integer with
--- Swapped4, and so on. Failure to do so will result in a warning when
--- compiling the instantiation; this warning should be heeded. Ignoring this
--- warning can result in unexpected results.
+-- See file s-bytswa.ads for full documentation of the interface
--- An example of proper usage follows:
+with System.Byte_Swapping;
--- declare
--- type Short_Integer is range -32768 .. 32767;
--- for Short_Integer'Size use 16; -- for confirmation
-
--- X : Short_Integer := 16#7FFF#;
-
--- function Swapped is new Byte_Swapping.Swapped2 (Short_Integer);
-
--- begin
--- Put_Line (X'Img);
--- X := Swapped (X);
--- Put_Line (X'Img);
--- end;
-
--- Note that the generic actual types need not be scalars, but must be
--- 'definite' types. They can, for example, be constrained subtypes of
--- unconstrained array types as long as the size is correct. For instance,
--- a subtype of String with length of 4 would be compatible with the
--- Swapped4 generic:
-
--- declare
--- subtype String4 is String (1 .. 4);
--- function Swapped is new Byte_Swapping.Swapped4 (String4);
--- S : String4 := "ABCD";
--- for S'Alignment use 4;
--- begin
--- Put_Line (S);
--- S := Swapped (S);
--- Put_Line (S);
--- end;
-
--- Similarly, a constrained array type is also acceptable:
-
--- declare
--- type Mask is array (0 .. 15) of Boolean;
--- for Mask'Alignment use 2;
--- for Mask'Component_Size use Boolean'Size;
--- X : Mask := (0 .. 7 => True, others => False);
--- function Swapped is new Byte_Swapping.Swapped2 (Mask);
--- begin
--- ...
--- X := Swapped (X);
--- ...
--- end;
-
--- A properly-sized record type will also be acceptable, and so forth
-
--- However, as described, a size mismatch must be avoided. In the following we
--- instantiate one of the generics with a type that is too large. The result
--- of the function call is undefined, such that assignment to an object can
--- result in garbage values.
-
--- Wrong: declare
--- subtype String16 is String (1 .. 16);
-
--- function Swapped is new Byte_Swapping.Swapped8 (String16);
--- -- Instantiation generates a compiler warning about
--- -- mismatched sizes
-
--- S : String16;
-
--- begin
--- S := "ABCDEFGHDEADBEEF";
---
--- Put_Line (S);
---
--- -- the following assignment results in garbage in S after the
--- -- first 8 bytes
---
--- S := Swapped (S);
---
--- Put_Line (S);
--- end Wrong;
-
--- When the size of the type is larger than 8 bytes, the use of the non-
--- generic procedures is an alternative because no function result is
--- involved; manipulation of the object is direct.
-
--- The procedures are passed the address of an object to manipulate. They will
--- swap the first N bytes of that object corresponding to the name of the
--- procedure. For example:
-
--- declare
--- S2 : String := "AB";
--- for S2'Alignment use 2;
--- S4 : String := "ABCD";
--- for S4'Alignment use 4;
--- S8 : String := "ABCDEFGH";
--- for S8'Alignment use 8;
-
--- begin
--- Swap2 (S2'Address);
--- Put_Line (S2);
-
--- Swap4 (S4'Address);
--- Put_Line (S4);
-
--- Swap8 (S8'Address);
--- Put_Line (S8);
--- end;
-
--- If an object of a type larger than N is passed, the remaining bytes of the
--- object are undisturbed. For example:
-
--- declare
--- subtype String16 is String (1 .. 16);
-
--- S : String16;
--- for S'Alignment use 8;
-
--- begin
--- S := "ABCDEFGHDEADBEEF";
--- Put_Line (S);
--- Swap8 (S'Address);
--- Put_Line (S);
--- end;
-
-with System;
-
-package GNAT.Byte_Swapping is
- pragma Pure;
-
- -- NB: all the routines in this package treat the application objects as
- -- unsigned (modular) types of a size in bytes corresponding to the routine
- -- name. For example, the generic function Swapped2 manipulates the object
- -- passed to the formal parameter Input as a value of an unsigned type that
- -- is 2 bytes long. Therefore clients are responsible for the compatibility
- -- of application types manipulated by these routines and these modular
- -- types, in terms of both size and alignment. This requirement applies to
- -- the generic actual type passed to the generic formal type Item in the
- -- generic functions, as well as to the type of the object implicitly
- -- designated by the address passed to the non-generic procedures. Use of
- -- incompatible types can result in implementation- defined effects.
-
- generic
- type Item is limited private;
- function Swapped2 (Input : Item) return Item;
- -- Return the 2-byte value of Input with the bytes swapped
-
- generic
- type Item is limited private;
- function Swapped4 (Input : Item) return Item;
- -- Return the 4-byte value of Input with the bytes swapped
-
- generic
- type Item is limited private;
- function Swapped8 (Input : Item) return Item;
- -- Return the 8-byte value of Input with the bytes swapped
-
- procedure Swap2 (Location : System.Address);
- -- Swap the first 2 bytes of the object starting at the address specified
- -- by Location.
-
- procedure Swap4 (Location : System.Address);
- -- Swap the first 4 bytes of the object starting at the address specified
- -- by Location.
-
- procedure Swap8 (Location : System.Address);
- -- Swap the first 8 bytes of the object starting at the address specified
- -- by Location.
-
- pragma Inline (Swap2, Swap4, Swap8, Swapped2, Swapped4, Swapped8);
-
-end GNAT.Byte_Swapping;
+package GNAT.Byte_Swapping renames System.Byte_Swapping;
EXCEPTION_DISPOSITION __gnat_SEH_error_handler
(struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
+/* Unwind opcodes. */
+#define UWOP_PUSH_NONVOL 0
+#define UWOP_ALLOC_LARGE 1
+#define UWOP_ALLOC_SMALL 2
+#define UWOP_SET_FPREG 3
+#define UWOP_SAVE_NONVOL 4
+#define UWOP_SAVE_NONVOL_FAR 5
+#define UWOP_SAVE_XMM128 8
+#define UWOP_SAVE_XMM128_FAR 9
+#define UWOP_PUSH_MACHFRAME 10
+
+/* Modify the IP value saved in the machine frame. This is really a kludge,
+ that will be removed if we could propagate the Windows exception (and not
+ the GCC one).
+ What is very wrong is that the Windows unwinder will try to decode the
+ instruction at IP, which isn't valid anymore after the adjust. */
+
+static void
+__gnat_adjust_context (unsigned char *unw, ULONG64 rsp)
+{
+ unsigned int len;
+
+ /* Version = 1, no flags, no prolog. */
+ if (unw[0] != 1 || unw[1] != 0)
+ return;
+ len = unw[2];
+ /* No frame pointer. */
+ if (unw[3] != 0)
+ return;
+ unw += 4;
+ while (len > 0)
+ {
+ /* Offset in prolog = 0. */
+ if (unw[0] != 0)
+ return;
+ switch (unw[1] & 0xf)
+ {
+ case UWOP_ALLOC_LARGE:
+ /* Expect < 512KB. */
+ if ((unw[1] & 0xf0) != 0)
+ return;
+ rsp += *(unsigned short *)(unw + 2) * 8;
+ len--;
+ unw += 2;
+ break;
+ case UWOP_SAVE_NONVOL:
+ case UWOP_SAVE_XMM128:
+ len--;
+ unw += 2;
+ break;
+ case UWOP_PUSH_MACHFRAME:
+ {
+ ULONG64 *rip;
+ rip = (ULONG64 *)rsp;
+ if ((unw[1] & 0xf0) == 0x10)
+ rip++;
+ /* Adjust rip. */
+ (*rip)++;
+ }
+ return;
+ default:
+ /* Unexpected. */
+ return;
+ }
+ unw += 2;
+ len--;
+ }
+}
+
EXCEPTION_DISPOSITION
__gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
PCONTEXT ms_orig_context,
optimization, we call __gnat_SEH_error_handler only on non-user
exceptions. */
if (!(ms_exc->ExceptionCode & STATUS_USER_DEFINED))
- __gnat_SEH_error_handler (ms_exc, this_frame, ms_orig_context, ms_disp);
+ {
+ ULONG64 excpip = (ULONG64) ms_exc->ExceptionAddress;
+ if (excpip != 0
+ && excpip >= (ms_disp->ImageBase
+ + ms_disp->FunctionEntry->BeginAddress)
+ && excpip < (ms_disp->ImageBase
+ + ms_disp->FunctionEntry->EndAddress))
+ {
+ /* This is a fault in this function. We need to adjust the return
+ address before raising the GCC exception. */
+ CONTEXT context;
+ PRUNTIME_FUNCTION mf_func = NULL;
+ ULONG64 mf_imagebase;
+ ULONG64 mf_rsp;
+
+ /* Get the context. */
+ RtlCaptureContext (&context);
+
+ while (1)
+ {
+ PRUNTIME_FUNCTION RuntimeFunction;
+ ULONG64 ImageBase;
+ VOID *HandlerData;
+ ULONG64 EstablisherFrame;
+
+ /* Get function metadata. */
+ RuntimeFunction = RtlLookupFunctionEntry
+ (context.Rip, &ImageBase, ms_disp->HistoryTable);
+ if (RuntimeFunction == ms_disp->FunctionEntry)
+ break;
+ mf_func = RuntimeFunction;
+ mf_imagebase = ImageBase;
+ mf_rsp = context.Rsp;
+
+ if (!RuntimeFunction)
+ {
+ /* In case of failure, assume this is a leaf function. */
+ context.Rip = *(ULONG64 *) context.Rsp;
+ context.Rsp += 8;
+ }
+ else
+ {
+ /* Unwind. */
+ RtlVirtualUnwind (0, ImageBase, context.Rip, RuntimeFunction,
+ &context, &HandlerData, &EstablisherFrame,
+ NULL);
+ }
+
+ /* 0 means bottom of the stack. */
+ if (context.Rip == 0)
+ {
+ mf_func = NULL;
+ break;
+ }
+ }
+ if (mf_func != NULL)
+ __gnat_adjust_context
+ ((unsigned char *)(mf_imagebase + mf_func->UnwindData), mf_rsp);
+ }
+ __gnat_SEH_error_handler (ms_exc, this_frame, ms_orig_context, ms_disp);
+ }
return _GCC_specific_handler (ms_exc, this_frame, ms_orig_context,
ms_disp, __gnat_personality_imp);
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . B Y T E _ S W A P P I N G --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2006-2012, AdaCore --
+-- --
+-- 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is a general implementation that uses GCC intrinsics to take
+-- advantage of any machine-specific instructions.
+
+with Ada.Unchecked_Conversion; use Ada;
+
+package body System.Byte_Swapping is
+
+ type U16 is mod 2**16;
+ type U32 is mod 2**32;
+ type U64 is mod 2**64;
+
+ function Bswap_16 (X : U16) return U16;
+ pragma Import (Intrinsic, Bswap_16, "__builtin_bswap16");
+
+ function Bswap_32 (X : U32) return U32;
+ pragma Import (Intrinsic, Bswap_32, "__builtin_bswap32");
+
+ function Bswap_64 (X : U64) return U64;
+ pragma Import (Intrinsic, Bswap_64, "__builtin_bswap64");
+
+ --------------
+ -- Swapped2 --
+ --------------
+
+ function Swapped2 (Input : Item) return Item is
+ function As_U16 is new Unchecked_Conversion (Item, U16);
+ function As_Item is new Unchecked_Conversion (U16, Item);
+
+ function Bswap_16 (X : U16) return U16 is (X / 256 or X * 256);
+ -- ??? Need to have function local here to allow inlining
+ pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2,
+ "storage size must be 2 bytes");
+ begin
+ return As_Item (Bswap_16 (As_U16 (Input)));
+ end Swapped2;
+
+ --------------
+ -- Swapped4 --
+ --------------
+
+ function Swapped4 (Input : Item) return Item is
+ function As_U32 is new Unchecked_Conversion (Item, U32);
+ function As_Item is new Unchecked_Conversion (U32, Item);
+ pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 4,
+ "storage size must be 4 bytes");
+ begin
+ return As_Item (Bswap_32 (As_U32 (Input)));
+ end Swapped4;
+
+ --------------
+ -- Swapped8 --
+ --------------
+
+ function Swapped8 (Input : Item) return Item is
+ function As_U64 is new Unchecked_Conversion (Item, U64);
+ function As_Item is new Unchecked_Conversion (U64, Item);
+ pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 8,
+ "storage size must be 8 bytes");
+ begin
+ return As_Item (Bswap_64 (As_U64 (Input)));
+ end Swapped8;
+
+ -----------
+ -- Swap2 --
+ -----------
+
+ procedure Swap2 (Location : System.Address) is
+ X : U16;
+ for X'Address use Location;
+ begin
+ X := Bswap_16 (X);
+ end Swap2;
+
+ -----------
+ -- Swap4 --
+ -----------
+
+ procedure Swap4 (Location : System.Address) is
+ X : U32;
+ for X'Address use Location;
+ begin
+ X := Bswap_32 (X);
+ end Swap4;
+
+ -----------
+ -- Swap8 --
+ -----------
+
+ procedure Swap8 (Location : System.Address) is
+ X : U64;
+ for X'Address use Location;
+ begin
+ X := Bswap_64 (X);
+ end Swap8;
+
+end System.Byte_Swapping;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . B Y T E _ S W A P P I N G --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2006-2012, AdaCore --
+-- --
+-- 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Simple routines for swapping the bytes of 16-, 32-, and 64-bit objects
+
+-- The generic functions should be instantiated with types that are of a size
+-- in bytes corresponding to the name of the generic. For example, a 2-byte
+-- integer type would be compatible with Swapped2, 4-byte integer with
+-- Swapped4, and so on. Failure to do so will result in a warning when
+-- compiling the instantiation; this warning should be heeded. Ignoring this
+-- warning can result in unexpected results.
+
+-- An example of proper usage follows:
+
+-- declare
+-- type Short_Integer is range -32768 .. 32767;
+-- for Short_Integer'Size use 16; -- for confirmation
+
+-- X : Short_Integer := 16#7FFF#;
+
+-- function Swapped is new Byte_Swapping.Swapped2 (Short_Integer);
+
+-- begin
+-- Put_Line (X'Img);
+-- X := Swapped (X);
+-- Put_Line (X'Img);
+-- end;
+
+-- Note that the generic actual types need not be scalars, but must be
+-- 'definite' types. They can, for example, be constrained subtypes of
+-- unconstrained array types as long as the size is correct. For instance,
+-- a subtype of String with length of 4 would be compatible with the
+-- Swapped4 generic:
+
+-- declare
+-- subtype String4 is String (1 .. 4);
+-- function Swapped is new Byte_Swapping.Swapped4 (String4);
+-- S : String4 := "ABCD";
+-- for S'Alignment use 4;
+-- begin
+-- Put_Line (S);
+-- S := Swapped (S);
+-- Put_Line (S);
+-- end;
+
+-- Similarly, a constrained array type is also acceptable:
+
+-- declare
+-- type Mask is array (0 .. 15) of Boolean;
+-- for Mask'Alignment use 2;
+-- for Mask'Component_Size use Boolean'Size;
+-- X : Mask := (0 .. 7 => True, others => False);
+-- function Swapped is new Byte_Swapping.Swapped2 (Mask);
+-- begin
+-- ...
+-- X := Swapped (X);
+-- ...
+-- end;
+
+-- A properly-sized record type will also be acceptable, and so forth
+
+-- However, as described, a size mismatch must be avoided. In the following we
+-- instantiate one of the generics with a type that is too large. The result
+-- of the function call is undefined, such that assignment to an object can
+-- result in garbage values.
+
+-- Wrong: declare
+-- subtype String16 is String (1 .. 16);
+
+-- function Swapped is new Byte_Swapping.Swapped8 (String16);
+-- -- Instantiation generates a compiler warning about
+-- -- mismatched sizes
+
+-- S : String16;
+
+-- begin
+-- S := "ABCDEFGHDEADBEEF";
+--
+-- Put_Line (S);
+--
+-- -- the following assignment results in garbage in S after the
+-- -- first 8 bytes
+--
+-- S := Swapped (S);
+--
+-- Put_Line (S);
+-- end Wrong;
+
+-- When the size of the type is larger than 8 bytes, the use of the non-
+-- generic procedures is an alternative because no function result is
+-- involved; manipulation of the object is direct.
+
+-- The procedures are passed the address of an object to manipulate. They will
+-- swap the first N bytes of that object corresponding to the name of the
+-- procedure. For example:
+
+-- declare
+-- S2 : String := "AB";
+-- for S2'Alignment use 2;
+-- S4 : String := "ABCD";
+-- for S4'Alignment use 4;
+-- S8 : String := "ABCDEFGH";
+-- for S8'Alignment use 8;
+
+-- begin
+-- Swap2 (S2'Address);
+-- Put_Line (S2);
+
+-- Swap4 (S4'Address);
+-- Put_Line (S4);
+
+-- Swap8 (S8'Address);
+-- Put_Line (S8);
+-- end;
+
+-- If an object of a type larger than N is passed, the remaining bytes of the
+-- object are undisturbed. For example:
+
+-- declare
+-- subtype String16 is String (1 .. 16);
+
+-- S : String16;
+-- for S'Alignment use 8;
+
+-- begin
+-- S := "ABCDEFGHDEADBEEF";
+-- Put_Line (S);
+-- Swap8 (S'Address);
+-- Put_Line (S);
+-- end;
+
+with System;
+
+package System.Byte_Swapping is
+ pragma Pure;
+
+ -- NB: all the routines in this package treat the application objects as
+ -- unsigned (modular) types of a size in bytes corresponding to the routine
+ -- name. For example, the generic function Swapped2 manipulates the object
+ -- passed to the formal parameter Input as a value of an unsigned type that
+ -- is 2 bytes long. Therefore clients are responsible for the compatibility
+ -- of application types manipulated by these routines and these modular
+ -- types, in terms of both size and alignment. This requirement applies to
+ -- the generic actual type passed to the generic formal type Item in the
+ -- generic functions, as well as to the type of the object implicitly
+ -- designated by the address passed to the non-generic procedures. Use of
+ -- incompatible types can result in implementation- defined effects.
+
+ generic
+ type Item is limited private;
+ function Swapped2 (Input : Item) return Item;
+ -- Return the 2-byte value of Input with the bytes swapped
+
+ generic
+ type Item is limited private;
+ function Swapped4 (Input : Item) return Item;
+ -- Return the 4-byte value of Input with the bytes swapped
+
+ generic
+ type Item is limited private;
+ function Swapped8 (Input : Item) return Item;
+ -- Return the 8-byte value of Input with the bytes swapped
+
+ procedure Swap2 (Location : System.Address);
+ -- Swap the first 2 bytes of the object starting at the address specified
+ -- by Location.
+
+ procedure Swap4 (Location : System.Address);
+ -- Swap the first 4 bytes of the object starting at the address specified
+ -- by Location.
+
+ procedure Swap8 (Location : System.Address);
+ -- Swap the first 8 bytes of the object starting at the address specified
+ -- by Location.
+
+ pragma Inline (Swap2, Swap4, Swap8, Swapped2, Swapped4, Swapped8);
+
+end System.Byte_Swapping;
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2012, 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- --
pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
-- The alternate signal stack for stack overflows
- Alternate_Stack_Size : constant := 16 * 1024;
+ Alternate_Stack_Size : constant := 128 * 1024;
-- This must be in keeping with init.c:__gnat_alternate_stack
Stack_Base_Available : constant Boolean := False;
if (!RuntimeFunction)
{
/* In case of failure, assume this is a leaf function. */
- context.Rip = *(ULONG64 **) context.Rsp;
+ context.Rip = *(ULONG64 *) context.Rsp;
context.Rsp += 8;
}
else
&& (void *)context.Rip <= exclude_max)
continue;
- array[i++] = context.Rip - 2;
+ array[i++] = (void *)(context.Rip - 2);
if (i >= size)
break;
}
projects / platform / upstream / gcc.git / commitdiff