Skip to content

R
riscv-gcc-1
Commit d9819bbd by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r189434
parent 2ed5b748
Showing with 561 additions and 287 deletions
gcc/ada/ChangeLog
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.
......
gcc/ada/Makefile.rtl
......@@ -483,6 +483,7 @@ GNATRTL_NONTASKING_OBJS= \
s-auxdec$(objext) \
s-bitops$(objext) \
s-boarop$(objext) \
s-bytswa$(objext) \
s-carsi8$(objext) \
s-carun8$(objext) \
s-casi16$(objext) \
......
gcc/ada/exp_aggr.adb
......@@ -294,15 +294,21 @@ package body Exp_Aggr is
-- 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
......@@ -3512,10 +3518,11 @@ package body Exp_Aggr is
-- 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 :=
......@@ -3527,6 +3534,10 @@ package body Exp_Aggr is
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
......@@ -3717,6 +3728,38 @@ package body Exp_Aggr is
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;
----------------------------
......@@ -6145,9 +6188,7 @@ package body Exp_Aggr is
-- 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
......
gcc/ada/exp_pakd.adb
......@@ -1593,8 +1593,7 @@ package body Exp_Pakd 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
......
gcc/ada/g-bytswa.adb
......@@ -2,11 +2,11 @@
-- --
-- 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- --
......@@ -29,98 +29,8 @@
-- --
------------------------------------------------------------------------------
-- 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;
gcc/ada/g-bytswa.ads
......@@ -2,11 +2,11 @@
-- --
-- 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- --
......@@ -31,176 +31,8 @@
-- 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;
gcc/ada/raise-gcc.c
......@@ -1216,6 +1216,75 @@ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
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,
......@@ -1225,7 +1294,67 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
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);
......
gcc/ada/s-bytswa.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/s-bytswa.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/s-osinte-hpux.ads
......@@ -7,7 +7,7 @@
-- 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- --
......@@ -290,7 +290,7 @@ package System.OS_Interface is
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;
......
gcc/ada/tracebak.c
......@@ -143,7 +143,7 @@ __gnat_backtrace (void **array,
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
......@@ -170,7 +170,7 @@ __gnat_backtrace (void **array,
&& (void *)context.Rip <= exclude_max)
continue;
array[i++] = context.Rip - 2;
array[i++] = (void *)(context.Rip - 2);
if (i >= size)
break;
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment