2003-12-03 Thomas Quinot <quinot@act-europe.fr>

	PR ada/11724

	* adaint.h, adaint.c, g-os_lib.ads:
	Do not assume that the offset argument to lseek(2) is a 32 bit integer,
	on some platforms (including FreeBSD), it is a 64 bit value.
	Introduce a __gnat_lseek wrapper in adaint.c to allow for portability.

2003-12-03  Arnaud Charlet  <charlet@act-europe.fr>

	* gnatvsn.ads (Library_Version): Now contain only the relevant
	version info.
	(Verbose_Library_Version): New constant.

	* g-spipat.adb, g-awk.adb, g-debpoo.adb,
	g-memdum.adb, g-thread.adb, s-geveop.adb, s-interr.adb,
	s-taskin.adb, s-tassta.adb: Make code compile with -gnatwa.

	* gnatlbr.adb: Clean up: replace Library_Version by
	Verbose_Library_Version.

	* make.adb, lib-writ.adb, exp_attr.adb:
	Clean up: replace Library_Version by Verbose_Library_Version.

	* 5lintman.adb: Removed.

	* Makefile.in:
	Update and simplify computation of LIBRARY_VERSION.
	Fix computation of GSMATCH_VERSION.
	5lintman.adb is no longer used: replaced by 7sintman.adb.

2003-12-03  Robert Dewar  <dewar@gnat.com>

	* exp_ch5.adb:
	(Possible_Bit_Aligned_Component): Maybe_Bit_Aligned_Large_Component new
	name. Modified to consider small non-bit-packed arrays as troublesome
	and in need of component-by-component assigment expansion.

2003-12-03  Vincent Celier  <celier@gnat.com>

	* lang-specs.h: Process nostdlib as nostdinc

	* back_end.adb: Update Copyright notice
	(Scan_Compiler_Arguments): Process -nostdlib directly.

2003-12-03  Jose Ruiz  <ruiz@act-europe.fr>

	* Makefile.in:
	When defining LIBGNAT_TARGET_PAIRS for bare board targets, remove the
	redundant inclusion of EXTRA_HIE_NONE_TARGET_PAIRS, which is always
	included in HIE_NONE_TARGET_PAIRS.

2003-12-03  Ed Schonberg  <schonberg@gnat.com>

	* sem_attr.adb:
	(Legal_Formal_Attribute): Attribute is legal in an inlined body, as it
	is legal in an instance, because legality is cheched in the template.

	* sem_prag.adb:
	(Analyze_Pragma, case Warnings): In an inlined body, the pragma may be
	appplied to an unchecked conversion of a formal parameter.

	* sem_warn.adb:
	(Output_Unreferenced_Messages): Suppress "not read" warnings on imported
	variables.

2003-12-03  Olivier Hainque  <hainque@act-europe.fr>

	* tb-alvms.c (unwind_regular_code, unwind_kernel_handler): New
	routines. The second one is new functionality to deal with backtracing
	through signal handlers.
	(unwind): Split into the two separate subroutines above.
	Update the documentation, and deal properly with sizeof (REG) different
	from sizeof (void*).


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@74226 138bc75d-0d04-0410-961f-82ee72b054a4

27 files changed, 442 insertions, 590 deletions

diff --git a/gcc/ada/5lintman.adb b/gcc/ada/5lintman.adb
deleted file mode 100644
index 56871f3d9ec..00000000000
--- a/gcc/ada/5lintman.adb
+++ /dev/null
@@ -1,401 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
---                                                                          --
---           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
---                                                                          --
---                                  B o d y                                 --
---                                                                          --
---             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2003, Ada Core Technologies               --
---                                                                          --
--- GNARL 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 2,  or (at your option) any later ver- --
--- sion. GNARL 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.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNARL; see file COPYING.  If not, write --
--- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
--- MA 02111-1307, USA.                                                      --
---                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
---                                                                          --
--- GNARL was developed by the GNARL team at Florida State University.       --
--- Extensive contributions were provided by Ada Core Technologies, Inc.     --
---                                                                          --
-------------------------------------------------------------------------------
-
---  This is the GNU/Linux version of this package
-
---  This file performs the system-dependent translation between machine
---  exceptions and the Ada exceptions, if any, that should be raised when they
---  occur. This version works for the x86 running linux.
-
---  This is a Sun OS (FSU THREADS) version of this package
-
---  PLEASE DO NOT add any dependences on other packages. ??? why not ???
---  This package is designed to work with or without tasking support.
-
---  Make a careful study of all signals available under the OS, to see which
---  need to be reserved, kept always unmasked, or kept always unmasked. Be on
---  the lookout for special signals that may be used by the thread library.
-
---  The definitions of "reserved" differ slightly between the ARM and POSIX.
---  Here is the ARM definition of reserved interrupt:
-
---  The set of reserved interrupts is implementation defined. A reserved
---  interrupt is either an interrupt for which user-defined handlers are not
---  supported, or one which already has an attached handler by some other
---  implementation-defined means. Program units can be connected to
---  non-reserved interrupts.
-
---  POSIX.5b/.5c specifies further:
-
---  Signals which the application cannot accept, and for which the application
---  cannot modify the signal action or masking, because the signals are
---  reserved for use by the Ada language implementation. The reserved signals
---  defined by this standard are Signal_Abort, Signal_Alarm,
---  Signal_Floating_Point_Error, Signal_Illegal_Instruction,
---  Signal_Segmentation_Violation, Signal_Bus_Error. If the implementation
---  supports any signals besides those defined by this standard, the
---  implementation may also reserve some of those.
-
---  The signals defined by POSIX.5b/.5c that are not specified as being
---  reserved are SIGHUP, SIGINT, SIGPIPE, SIGQUIT, SIGTERM, SIGUSR1, SIGUSR2,
---  SIGCHLD, SIGCONT, SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGIO SIGURG, and all
---  the real-time signals.
-
---  Beware of reserving signals that POSIX.5b/.5c require to be available for
---  users. POSIX.5b/.5c say:
-
---  An implementation shall not impose restrictions on the ability of an
---  application to send, accept, block, or ignore the signals defined by this
---  standard, except as specified in this standard.
-
---  Here are some other relevant requirements from POSIX.5b/.5c:
-
---  For the environment task, the initial signal mask is that specified for
---  the process...
-
---  It is anticipated that the paragraph above may be modified by a future
---  revision of this standard, to require that the realtime signals always be
---  initially masked for a process that is an Ada active partition.
-
---  For all other tasks, the initial signal mask shall include all the signals
---  that are not reserved signals and are not bound to entries of the task.
-
-with Interfaces.C;
---  used for int and other types
-
-with System.Error_Reporting;
---  used for Shutdown
-
-with System.OS_Interface;
---  used for various Constants, Signal and types
-
-with Ada.Exceptions;
---  used for Exception_Id
---           Raise_From_Signal_Handler
-
-with System.Soft_Links;
---  used for Get_Machine_State_Addr
-
-with Unchecked_Conversion;
-
-package body System.Interrupt_Management is
-
-   use Interfaces.C;
-   use System.Error_Reporting;
-   use System.OS_Interface;
-
-   package TSL renames System.Soft_Links;
-
-   type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
-   Exception_Interrupts : constant Interrupt_List :=
-     (SIGFPE, SIGILL, SIGSEGV);
-
-   Unreserve_All_Interrupts : Interfaces.C.int;
-   pragma Import
-     (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
-
-   subtype int is Interfaces.C.int;
-   subtype unsigned_short is Interfaces.C.unsigned_short;
-   subtype unsigned_long is Interfaces.C.unsigned_long;
-
-   ----------------------
-   -- Notify_Exception --
-   ----------------------
-
-   pragma Warnings (Off);
-   --  Because many unaccessed arguments
-
-   Signal_Mask : aliased sigset_t;
-   --  The set of signals handled by Notify_Exception
-
-   --  This function identifies the Ada exception to be raised using
-   --  the information when the system received a synchronous signal.
-   --  Since this function is machine and OS dependent, different code
-   --  has to be provided for different target.
-
-   procedure Notify_Exception
-     (signo         : Signal;
-      gs            : unsigned_short;
-      fs            : unsigned_short;
-      es            : unsigned_short;
-      ds            : unsigned_short;
-      edi           : unsigned_long;
-      esi           : unsigned_long;
-      ebp           : unsigned_long;
-      esp           : unsigned_long;
-      ebx           : unsigned_long;
-      edx           : unsigned_long;
-      ecx           : unsigned_long;
-      eax           : unsigned_long;
-      trapno        : unsigned_long;
-      err           : unsigned_long;
-      eip           : unsigned_long;
-      cs            : unsigned_short;
-      eflags        : unsigned_long;
-      esp_at_signal : unsigned_long;
-      ss            : unsigned_short;
-      fpstate       : System.Address;
-      oldmask       : unsigned_long;
-      cr2           : unsigned_long);
-
-   procedure Notify_Exception
-     (signo         : Signal;
-      gs            : unsigned_short;
-      fs            : unsigned_short;
-      es            : unsigned_short;
-      ds            : unsigned_short;
-      edi           : unsigned_long;
-      esi           : unsigned_long;
-      ebp           : unsigned_long;
-      esp           : unsigned_long;
-      ebx           : unsigned_long;
-      edx           : unsigned_long;
-      ecx           : unsigned_long;
-      eax           : unsigned_long;
-      trapno        : unsigned_long;
-      err           : unsigned_long;
-      eip           : unsigned_long;
-      cs            : unsigned_short;
-      eflags        : unsigned_long;
-      esp_at_signal : unsigned_long;
-      ss            : unsigned_short;
-      fpstate       : System.Address;
-      oldmask       : unsigned_long;
-      cr2           : unsigned_long)
-   is
-      pragma Warnings (On);
-
-      function To_Machine_State_Ptr is new
-        Unchecked_Conversion (Address, Machine_State_Ptr);
-
-      --  These are not directly visible
-
-      procedure Raise_From_Signal_Handler
-        (E : Ada.Exceptions.Exception_Id;
-         M : System.Address);
-      pragma Import
-        (Ada, Raise_From_Signal_Handler,
-         "ada__exceptions__raise_from_signal_handler");
-      pragma No_Return (Raise_From_Signal_Handler);
-
-      mstate  : Machine_State_Ptr;
-      message : aliased constant String := "" & ASCII.Nul;
-      --  A null terminated String.
-
-      Result  : int;
-
-   begin
-
-      --  Raise_From_Signal_Handler makes sure that the exception is raised
-      --  safely from this signal handler.
-
-      --  ??? The original signal mask (the one we had before coming into this
-      --  signal catching function) should be restored by
-      --  Raise_From_Signal_Handler. For now, restore it explicitely
-
-      Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
-      pragma Assert (Result = 0);
-
-      --  Check that treatment of exception propagation here
-      --  is consistent with treatment of the abort signal in
-      --  System.Task_Primitives.Operations.
-
-      mstate := To_Machine_State_Ptr (TSL.Get_Machine_State_Addr.all);
-      mstate.eip := eip;
-      mstate.ebx := ebx;
-      mstate.esp := esp_at_signal;
-      mstate.ebp := ebp;
-      mstate.esi := esi;
-      mstate.edi := edi;
-
-      case signo is
-         when SIGFPE =>
-            Raise_From_Signal_Handler
-              (Constraint_Error'Identity, message'Address);
-         when SIGILL =>
-            Raise_From_Signal_Handler
-              (Constraint_Error'Identity, message'Address);
-         when SIGSEGV =>
-            Raise_From_Signal_Handler
-              (Storage_Error'Identity, message'Address);
-         when others =>
-            if Shutdown ("Unexpected signal") then
-               null;
-            end if;
-      end case;
-   end Notify_Exception;
-
-   ---------------------------
-   -- Initialize_Interrupts --
-   ---------------------------
-
-   --  Nothing needs to be done on this platform.
-
-   procedure Initialize_Interrupts is
-   begin
-      null;
-   end Initialize_Interrupts;
-
-begin
-   declare
-      act     : aliased struct_sigaction;
-      old_act : aliased struct_sigaction;
-      Result  : int;
-
-      function State (Int : Interrupt_ID) return Character;
-      pragma Import (C, State, "__gnat_get_interrupt_state");
-      --  Get interrupt state.  Defined in a-init.c
-      --  The input argument is the interrupt number,
-      --  and the result is one of the following:
-
-      User    : constant Character := 'u';
-      Runtime : constant Character := 'r';
-      Default : constant Character := 's';
-      --    'n'   this interrupt not set by any Interrupt_State pragma
-      --    'u'   Interrupt_State pragma set state to User
-      --    'r'   Interrupt_State pragma set state to Runtime
-      --    's'   Interrupt_State pragma set state to System (use "default"
-      --           system handler)
-
-   begin
-      --  Need to call pthread_init very early because it is doing signal
-      --  initializations.
-
-      pthread_init;
-
-      Abort_Task_Interrupt := SIGADAABORT;
-
-      act.sa_handler := Notify_Exception'Address;
-
-      act.sa_flags := 0;
-
-      --  On some targets, we set sa_flags to SA_NODEFER so that during the
-      --  handler execution we do not change the Signal_Mask to be masked for
-      --  the Signal.
-
-      --  This is a temporary fix to the problem that the Signal_Mask is
-      --  not restored after the exception (longjmp) from the handler.
-      --  The right fix should be made in sigsetjmp so that we save
-      --  the Signal_Set and restore it after a longjmp.
-
-      --  Since SA_NODEFER is obsolete, instead we reset explicitely
-      --  the mask in the exception handler.
-
-      Result := sigemptyset (Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      --  Add signals that map to Ada exceptions to the mask.
-
-      for J in Exception_Interrupts'Range loop
-         if State (Exception_Interrupts (J)) /= Default  then
-            Result :=
-            sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J)));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-
-      act.sa_mask := Signal_Mask;
-
-      pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
-      pragma Assert (Reserve = (Interrupt_ID'Range => False));
-
-      --  Process state of exception signals
-
-      for J in Exception_Interrupts'Range loop
-         if State (Exception_Interrupts (J)) /= User then
-            Keep_Unmasked (Exception_Interrupts (J)) := True;
-            Reserve (Exception_Interrupts (J)) := True;
-
-            if State (Exception_Interrupts (J)) /= Default then
-               Result :=
-                 sigaction
-                 (Signal (Exception_Interrupts (J)), act'Unchecked_Access,
-                  old_act'Unchecked_Access);
-               pragma Assert (Result = 0);
-            end if;
-         end if;
-      end loop;
-
-      if State (Abort_Task_Interrupt) /= User then
-         Keep_Unmasked (Abort_Task_Interrupt) := True;
-         Reserve (Abort_Task_Interrupt) := True;
-      end if;
-
-      --  Set SIGINT to unmasked state as long as it's
-      --  not in "User" state.  Check for Unreserve_All_Interrupts last
-
-      if State (SIGINT) /= User then
-         Keep_Unmasked (SIGINT) := True;
-         Reserve (SIGINT) := True;
-      end if;
-
-      --  Check all signals for state that requires keeping them
-      --  unmasked and reserved
-
-      for J in Interrupt_ID'Range loop
-         if State (J) = Default or else State (J) = Runtime then
-            Keep_Unmasked (J) := True;
-            Reserve (J) := True;
-         end if;
-      end loop;
-
-      --  Add the set of signals that must always be unmasked for this target
-
-      for J in Unmasked'Range loop
-         Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True;
-         Reserve (Interrupt_ID (Unmasked (J))) := True;
-      end loop;
-
-      --  Add target-specific reserved signals
-
-      for J in Reserved'Range loop
-         Reserve (Interrupt_ID (Reserved (J))) := True;
-      end loop;
-
-      --  Process pragma Unreserve_All_Interrupts. This overrides any
-      --  settings due to pragma Interrupt_State:
-
-      if Unreserve_All_Interrupts /= 0 then
-         Keep_Unmasked (SIGINT) := False;
-         Reserve (SIGINT) := False;
-      end if;
-
-      --  We do not have Signal 0 in reality. We just use this value
-      --  to identify non-existent signals (see s-intnam.ads). Therefore,
-      --  Signal 0 should not be used in all signal related operations hence
-      --  mark it as reserved.
-
-      Reserve (0) := True;
-   end;
-end System.Interrupt_Management;
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dbcf21f623b..e0c88573e63 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,79 @@
+2003-12-03  Thomas Quinot  <quinot@act-europe.fr>
+
+	PR ada/11724
+
+	* adaint.h, adaint.c, g-os_lib.ads: 
+	Do not assume that the offset argument to lseek(2) is a 32 bit integer,
+	on some platforms (including FreeBSD), it is a 64 bit value.
+	Introduce a __gnat_lseek wrapper in adaint.c to allow for portability.
+
+2003-12-03  Arnaud Charlet  <charlet@act-europe.fr>
+
+	* gnatvsn.ads (Library_Version): Now contain only the relevant
+	version info.
+	(Verbose_Library_Version): New constant.
+
+	* g-spipat.adb, g-awk.adb, g-debpoo.adb,
+	g-memdum.adb, g-thread.adb, s-geveop.adb, s-interr.adb,
+	s-taskin.adb, s-tassta.adb: Make code compile with -gnatwa.
+
+	* gnatlbr.adb: Clean up: replace Library_Version by
+	Verbose_Library_Version.
+
+	* make.adb, lib-writ.adb, exp_attr.adb: 
+	Clean up: replace Library_Version by Verbose_Library_Version.
+
+	* 5lintman.adb: Removed.
+
+	* Makefile.in: 
+	Update and simplify computation of LIBRARY_VERSION.
+	Fix computation of GSMATCH_VERSION.
+	5lintman.adb is no longer used: replaced by 7sintman.adb.
+
+2003-12-03  Robert Dewar  <dewar@gnat.com>
+
+	* exp_ch5.adb: 
+	(Possible_Bit_Aligned_Component): Maybe_Bit_Aligned_Large_Component new
+	name. Modified to consider small non-bit-packed arrays as troublesome
+	and in need of component-by-component assigment expansion.
+
+2003-12-03  Vincent Celier  <celier@gnat.com>
+
+	* lang-specs.h: Process nostdlib as nostdinc
+
+	* back_end.adb: Update Copyright notice
+	(Scan_Compiler_Arguments): Process -nostdlib directly.
+
+2003-12-03  Jose Ruiz  <ruiz@act-europe.fr>
+
+	* Makefile.in: 
+	When defining LIBGNAT_TARGET_PAIRS for bare board targets, remove the
+	redundant inclusion of EXTRA_HIE_NONE_TARGET_PAIRS, which is always
+	included in HIE_NONE_TARGET_PAIRS.
+
+2003-12-03  Ed Schonberg  <schonberg@gnat.com>
+
+	* sem_attr.adb: 
+	(Legal_Formal_Attribute): Attribute is legal in an inlined body, as it
+	is legal in an instance, because legality is cheched in the template.
+
+	* sem_prag.adb: 
+	(Analyze_Pragma, case Warnings): In an inlined body, the pragma may be
+	appplied to an unchecked conversion of a formal parameter.
+
+	* sem_warn.adb: 
+	(Output_Unreferenced_Messages): Suppress "not read" warnings on imported
+	variables.
+
+2003-12-03  Olivier Hainque  <hainque@act-europe.fr>
+
+	* tb-alvms.c (unwind_regular_code, unwind_kernel_handler): New
+	routines. The second one is new functionality to deal with backtracing
+	through signal handlers.
+	(unwind): Split into the two separate subroutines above.
+	Update the documentation, and deal properly with sizeof (REG) different
+	from sizeof (void*).
+
 2003-12-01  Nicolas Setton  <setton@act-europe.fr>
 
 	* a-except.adb (Raise_Current_Excep): Add a pragma Inspection_Point,
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index 4983adc5299..4b7148b2947 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -375,6 +375,8 @@ PREFIX_REAL_OBJS = ../prefix.o \
   ../../libiberty/xstrdup.o    \
   ../../libiberty/xexit.o
 
+LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
+
 # $(filter-out PATTERN...,TEXT) removes all PATTERN words from TEXT.
 # $(strip STRING) removes leading and trailing spaces from STRING.
 # If what's left is null then it's a match.
@@ -450,7 +452,7 @@ ifeq ($(strip $(filter-out %86 sysv5uw%,$(arch) $(osys))),)
   PREFIX_OBJS=$(PREFIX_REAL_OBJS)
   SO_OPTS = -Wl,-h,
   GNATLIB_SHARED = gnatlib-shared-dual
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),)
@@ -692,8 +694,7 @@ ifeq ($(strip $(filter-out powerpc% unknown elf,$(targ))),)
   system.ads<59system.ads
 
   LIBGNAT_TARGET_PAIRS = \
-  $(HIE_NONE_TARGET_PAIRS) \
-  $(EXTRA_HIE_NONE_TARGET_PAIRS)
+  $(HIE_NONE_TARGET_PAIRS)
 endif
 
 ifeq ($(strip $(filter-out sparc% unknown elf,$(targ))),)
@@ -701,8 +702,7 @@ ifeq ($(strip $(filter-out sparc% unknown elf,$(targ))),)
   system.ads<5rsystem.ads
 
   LIBGNAT_TARGET_PAIRS = \
-  $(HIE_NONE_TARGET_PAIRS) \
-  $(EXTRA_HIE_NONE_TARGET_PAIRS)
+  $(HIE_NONE_TARGET_PAIRS)
 endif
 
 ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
@@ -819,7 +819,7 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
   GNATLIB_SHARED = gnatlib-shared-dual
   GMEM_LIB = gmemlib
   PREFIX_OBJS = $(PREFIX_REAL_OBJS)
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 
   ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS = \
@@ -903,7 +903,7 @@ ifeq ($(strip $(filter-out %86 solaris2%,$(arch) $(osys))),)
   SO_OPTS = -Wl,-h,
   GNATLIB_SHARED = gnatlib-shared-dual
   PREFIX_OBJS = $(PREFIX_REAL_OBJS)
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
@@ -912,7 +912,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
   a-numaux.adb<86numaux.adb \
   a-numaux.ads<86numaux.ads \
   s-inmaop.adb<7sinmaop.adb \
-  s-intman.adb<5lintman.adb \
+  s-intman.adb<7sintman.adb \
   s-mastop.adb<5omastop.adb \
   s-osinte.adb<5iosinte.adb \
   s-osinte.ads<5iosinte.ads \
@@ -929,7 +929,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
   GNATLIB_SHARED = gnatlib-shared-dual
   GMEM_LIB = gmemlib
   PREFIX_OBJS = $(PREFIX_REAL_OBJS)
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 
   ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS = \
@@ -937,7 +937,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
     a-numaux.adb<86numaux.adb \
     a-numaux.ads<86numaux.ads \
     s-inmaop.adb<7sinmaop.adb \
-    s-intman.adb<5lintman.adb \
+    s-intman.adb<7sintman.adb \
     s-mastop.adb<5omastop.adb \
     s-osinte.adb<7sosinte.adb \
     s-osinte.ads<5losinte.ads \
@@ -967,7 +967,7 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
   system.ads<56system.ads
 
   THREADSLIB=
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),)
@@ -1021,7 +1021,7 @@ ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),)
   MISCLIB = -lexc
   SO_OPTS = -Wl,-all,-set_version,sgi1.0,-update_registry,../so_locations,-soname,
   PREFIX_OBJS = $(PREFIX_REAL_OBJS)
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out hppa% hp hpux10%,$(targ))),)
@@ -1069,7 +1069,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),)
   SO_OPTS = -Wl,+h,
   PREFIX_OBJS = $(PREFIX_REAL_OBJS)
   GNATLIB_SHARED = gnatlib-shared-dual
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 
   ifeq ($(strip $(filter-out dce DCE,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS = \
@@ -1220,7 +1220,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
   THREADSLIB = -lpthread -lmach -lexc -lrt
   PREFIX_OBJS = $(PREFIX_REAL_OBJS)
   GNATLIB_SHARED = gnatlib-shared-default
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(host))),)
@@ -1290,8 +1290,7 @@ endif
      ../../gnatlbr$(exeext) \
      ,,/../gnatsym$(exeext)
   # This command transforms (YYYYMMDD) into YY,MMDD
-  GSMATCH_VERSION := $(shell grep "^ *Gnat_Version_String" $(fsrcpfx)gnatvsn.ads | sed -e 's/.*(\(.*\)).*/\1/' -e 's/\(..\)\(..\)\(....\)/\2,\3/')
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/' -e 's/\./_/g'))
+  GSMATCH_VERSION := $(shell grep "^ *Gnat_Static_Version_String" $(fsrcpfx)gnatvsn.ads | sed -e 's/.*(\(.*\)).*/\1/' -e 's/\(..\)\(..\)\(....\)/\2,\3/')
   TOOLS_LIBS_LO := --for-linker=sys\\$$\$$library:trace.exe
 endif
 
@@ -1328,14 +1327,14 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
   EXTRA_GNATRTL_NONTASKING_OBJS = g-regist.o
   soext = .dll
   GNATLIB_SHARED = gnatlib-shared-win32
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<4lintnam.ads \
   s-inmaop.adb<7sinmaop.adb \
-  s-intman.adb<5lintman.adb \
+  s-intman.adb<7sintman.adb \
   s-osinte.ads<5iosinte.ads \
   s-osinte.adb<5iosinte.adb \
   s-osprim.adb<7sosprim.adb \
@@ -1349,14 +1348,14 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
   THREADSLIB=-lpthread
   GNATLIB_SHARED=gnatlib-shared-dual
   PREFIX_OBJS=$(PREFIX_REAL_OBJS)
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<4lintnam.ads \
   s-inmaop.adb<7sinmaop.adb \
-  s-intman.adb<5lintman.adb \
+  s-intman.adb<7sintman.adb \
   s-osinte.ads<5iosinte.ads \
   s-osinte.adb<5iosinte.adb \
   s-osprim.adb<7sosprim.adb \
@@ -1370,7 +1369,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
   THREADSLIB=-lpthread
   GNATLIB_SHARED=gnatlib-shared-dual
   PREFIX_OBJS=$(PREFIX_REAL_OBJS)
-  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
+  LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
 # The runtime library for gnat comprises two directories.  One contains the
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 921e1d84f29..b7130d8fbb1 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -2481,3 +2481,9 @@ __gnatlib_install_locks (void (*lock) (void) ATTRIBUTE_UNUSED,
      a no-op in this case. */
 #endif
 }
+
+int
+__gnat_lseek (int fd, long offset, int whence)
+{
+  return (int) lseek (fd, offset, whence);
+}
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 5ce5d68ba2d..33c2bdcba95 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -140,6 +140,7 @@ extern int    __gnat_expect_poll		   (int *, int, int, int *);
 extern void   __gnat_set_binary_mode		   (int);
 extern void   __gnat_set_text_mode		   (int);
 extern char  *__gnat_ttyname			   (int);
+extern int    __gnat_lseek			   (int, long, int);
 
 #ifdef __MINGW32__
 extern void   __gnat_plist_init                    (void);
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index 5725f9eca21..ede3f8b2097 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 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- --
@@ -270,6 +270,12 @@ package body Back_End is
                Opt.No_Stdinc := True;
                Scan_Back_End_Switches (Argv);
 
+            --  We must recognize -nostdlib to suppress visibility on the
+            --  standard GNAT RTL objects.
+
+            elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
+               Opt.No_Stdlib := True;
+
             elsif Is_Front_End_Switch (Argv) then
                Scan_Front_End_Switches (Argv);
 
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 7a5d7737f02..f296a6f60cf 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -907,8 +907,9 @@ package body Exp_Attr is
          if Pent = Standard_Standard
            or else Pent = Standard_ASCII
          then
-            Name_Buffer (1 .. Library_Version'Length) := Library_Version;
-            Name_Len := Library_Version'Length;
+            Name_Buffer (1 .. Verbose_Library_Version'Length) :=
+              Verbose_Library_Version;
+            Name_Len := Verbose_Library_Version'Length;
             Rewrite (N,
               Make_String_Literal (Loc,
                 Strval => String_From_Name_Buffer));
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 8105de381d2..a257b274ce0 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -95,24 +95,6 @@ package body Exp_Ch5 is
    --  either because the target is not byte aligned, or there is a change
    --  of representation.
 
-   function Maybe_Bit_Aligned_Large_Component (N : Node_Id) return Boolean;
-   --  This function is used in processing the assignment of a record or
-   --  indexed component. The back end can handle such assignments fine
-   --  if the objects involved are small (64-bits) or are both aligned on
-   --  a byte boundary (starts on a byte, and ends on a byte). However,
-   --  problems arise for large components that are not byte aligned,
-   --  since the assignment may clobber other components that share bit
-   --  positions in the starting or ending bytes, and in the case of
-   --  components not starting on a byte boundary, the back end cannot
-   --  even manage to extract the value. This function is used to detect
-   --  such situations, so that the assignment can be handled component-wise.
-   --  A value of False means that either the object is known to be greater
-   --  than 64 bits, or that it is known to be byte aligned (and occupy an
-   --  integral number of bytes. True is returned if the object is known to
-   --  be greater than 64 bits, and is known to be unaligned. As implied
-   --  by the name, the result is conservative, in that if the compiler
-   --  cannot determine these conditions at compile time, True is returned.
-
    function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
    --  Generate the necessary code for controlled and Tagged assignment,
    --  that is to say, finalization of the target before, adjustement of
@@ -120,13 +102,41 @@ package body Exp_Ch5 is
    --  pointers which are not 'part of the value' and must not be changed
    --  upon assignment. N is the original Assignment node.
 
+   function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean;
+   --  This function is used in processing the assignment of a record or
+   --  indexed component. The back end can handle such assignments fine
+   --  if the objects involved are small (64-bits or less) records or
+   --  scalar items (including bit-packed arrays represented with modular
+   --  types) or are both aligned on a byte boundary (starting on a byte
+   --  boundary, and occupying an integral number of bytes).
+   --
+   --  However, problems arise for records larger than 64 bits, or for
+   --  arrays (other than bit-packed arrays represented with a modular
+   --  type) if the component starts on a non-byte boundary, or does
+   --  not occupy an integral number of bytes (i.e. there are some bits
+   --  possibly shared with fields at the start or beginning of the
+   --  component). The back end cannot handle loading and storing such
+   --  components in a single operation.
+   --
+   --  This function is used to detect the troublesome situation. it is
+   --  conservative in the sense that it produces True unless it knows
+   --  for sure that the component is safe (as outlined in the first
+   --  paragraph above). The code generation for record and array
+   --  assignment checks for trouble using this function, and if so
+   --  the assignment is generated component-wise, which the back end
+   --  is required to handle correctly.
+   --
+   --  Note that in GNAT 3, the back end will reject such components
+   --  anyway, so the hard work in checking for this case is wasted
+   --  in GNAT 3, but it's harmless, so it is easier to do it in
+   --  all cases, rather than conditionalize it in GNAT 5 or beyond.
+
    ------------------------------
    -- Change_Of_Representation --
    ------------------------------
 
    function Change_Of_Representation (N : Node_Id) return Boolean is
       Rhs : constant Node_Id := Expression (N);
-
    begin
       return
         Nkind (Rhs) = N_Type_Conversion
@@ -372,9 +382,9 @@ package body Exp_Ch5 is
 
       --  We require a loop if the left side is possibly bit unaligned
 
-      elsif Maybe_Bit_Aligned_Large_Component (Lhs)
+      elsif Possible_Bit_Aligned_Component (Lhs)
               or else
-            Maybe_Bit_Aligned_Large_Component (Rhs)
+            Possible_Bit_Aligned_Component (Rhs)
       then
          Loop_Required := True;
 
@@ -1026,9 +1036,9 @@ package body Exp_Ch5 is
       --  clobbering of other components sharing bits in the first or
       --  last byte of the component to be assigned.
 
-      elsif Maybe_Bit_Aligned_Large_Component (Lhs)
+      elsif Possible_Bit_Aligned_Component (Lhs)
               or
-            Maybe_Bit_Aligned_Large_Component (Rhs)
+            Possible_Bit_Aligned_Component (Rhs)
       then
          null;
 
@@ -3221,11 +3231,11 @@ package body Exp_Ch5 is
          return Empty_List;
    end Make_Tag_Ctrl_Assignment;
 
-   ---------------------------------------
-   -- Maybe_Bit_Aligned_Large_Component --
-   ---------------------------------------
+   ------------------------------------
+   -- Possible_Bit_Aligned_Component --
+   ------------------------------------
 
-   function Maybe_Bit_Aligned_Large_Component (N : Node_Id) return Boolean is
+   function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean is
    begin
       case Nkind (N) is
 
@@ -3250,7 +3260,7 @@ package body Exp_Ch5 is
                --  indexing from a possibly unaligned component.
 
                else
-                  return Maybe_Bit_Aligned_Large_Component (P);
+                  return Possible_Bit_Aligned_Component (P);
                end if;
             end;
 
@@ -3268,17 +3278,22 @@ package body Exp_Ch5 is
                --  only the recursive test on the prefix.
 
                if No (Component_Clause (Comp)) then
-                  return Maybe_Bit_Aligned_Large_Component (P);
+                  return Possible_Bit_Aligned_Component (P);
 
                --  Otherwise we have a component clause, which means that
                --  the Esize and Normalized_First_Bit fields are set and
                --  contain static values known at compile time.
 
                else
-                  --  If we know the size is 64 bits or less we are fine
-                  --  since the back end always handles small fields right.
-
-                  if Esize (Comp) <= 64 then
+                  --  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.
+
+                  if 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
@@ -3293,7 +3308,7 @@ package body Exp_Ch5 is
                   --  but we still need to test our prefix recursively.
 
                   else
-                     return Maybe_Bit_Aligned_Large_Component (P);
+                     return Possible_Bit_Aligned_Component (P);
                   end if;
                end if;
             end;
@@ -3306,6 +3321,6 @@ package body Exp_Ch5 is
             return False;
 
       end case;
-   end Maybe_Bit_Aligned_Large_Component;
+   end Possible_Bit_Aligned_Component;
 
 end Exp_Ch5;
diff --git a/gcc/ada/g-awk.adb b/gcc/ada/g-awk.adb
index 3396daac0e1..cece7e6de48 100644
--- a/gcc/ada/g-awk.adb
+++ b/gcc/ada/g-awk.adb
@@ -873,8 +873,7 @@ package body GNAT.AWK is
       Callbacks  : Callback_Mode := None;
       Session    : Session_Type  := Current_Session)
    is
-      Filter_Active : Boolean;
-      Quit          : Boolean;
+      Quit : Boolean;
 
    begin
       Open (Separators, Filename, Session);
@@ -884,7 +883,12 @@ package body GNAT.AWK is
          Split_Line (Session);
 
          if Callbacks in Only .. Pass_Through then
-            Filter_Active := Apply_Filters (Session);
+            declare
+               Discard : Boolean;
+               pragma Unreferenced (Discard);
+            begin
+               Discard := Apply_Filters (Session);
+            end;
          end if;
 
          if Callbacks /= Only then
diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index ef853da04e9..4eeae1af222 100644
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -116,7 +116,7 @@ package body GNAT.Debug_Pools is
       return Tracebacks_Array_Access;
    function Hash (T : Tracebacks_Array_Access) return Header;
    function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean;
-   pragma Inline (Set_Next, Next, Get_Key, Equal, Hash);
+   pragma Inline (Set_Next, Next, Get_Key, Hash);
    --  Subprograms required for instantiation of the htable. See GNAT.HTable.
 
    package Backtrace_Htable is new GNAT.HTable.Static_HTable
@@ -374,7 +374,6 @@ package body GNAT.Debug_Pools is
 
    function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean is
       use Ada.Exceptions.Traceback;
-
    begin
       return K1.all = K2.all;
    end Equal;
diff --git a/gcc/ada/g-memdum.adb b/gcc/ada/g-memdum.adb
index fd2167c4a63..92f08392e47 100644
--- a/gcc/ada/g-memdum.adb
+++ b/gcc/ada/g-memdum.adb
@@ -66,7 +66,7 @@ package body GNAT.Memory_Dump is
 
       Line_Buf : String (1 .. Line_Len);
 
-      Hex : array (0 .. 15) of Character := "0123456789ABCDEF";
+      Hex : constant array (0 .. 15) of Character := "0123456789ABCDEF";
 
       type Char_Ptr is access all Character;
 
diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads
index 0e1af2ae968..63ed32fc656 100644
--- a/gcc/ada/g-os_lib.ads
+++ b/gcc/ada/g-os_lib.ads
@@ -359,7 +359,7 @@ pragma Elaborate_Body (OS_Lib);
      (FD     : File_Descriptor;
       offset : Long_Integer;
       origin : Integer);
-   pragma Import (C, Lseek, "lseek");
+   pragma Import (C, Lseek, "__gnat_lseek");
    --  Sets the current file pointer to the indicated offset value,
    --  relative to the current position (origin = SEEK_CUR), end of
    --  file (origin = SEEK_END), or start of file (origin = SEEK_SET).
diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb
index 3832a7603e8..2f499b8d3ec 100644
--- a/gcc/ada/g-spipat.adb
+++ b/gcc/ada/g-spipat.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 1998-2002, Ada Core Technologies, Inc.           --
+--           Copyright (C) 1998-2003, Ada Core Technologies, 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- --
@@ -343,30 +343,28 @@ package body GNAT.Spitbol.Patterns is
    --  structure (i.e. it is a pattern that is guaranteed to match at least
    --  one character on success, and not to make any entries on the stack.
 
-   OK_For_Simple_Arbno :
-     array (Pattern_Code) of Boolean := (
-       PC_Any_CS     |
-       PC_Any_CH     |
-       PC_Any_VF     |
-       PC_Any_VP     |
-       PC_Char       |
-       PC_Len_Nat    |
-       PC_NotAny_CS  |
-       PC_NotAny_CH  |
-       PC_NotAny_VF  |
-       PC_NotAny_VP  |
-       PC_Span_CS    |
-       PC_Span_CH    |
-       PC_Span_VF    |
-       PC_Span_VP    |
-       PC_String     |
-       PC_String_2   |
-       PC_String_3   |
-       PC_String_4   |
-       PC_String_5   |
-       PC_String_6   => True,
-
-       others => False);
+   OK_For_Simple_Arbno : constant array (Pattern_Code) of Boolean :=
+     (PC_Any_CS    |
+      PC_Any_CH    |
+      PC_Any_VF    |
+      PC_Any_VP    |
+      PC_Char      |
+      PC_Len_Nat   |
+      PC_NotAny_CS |
+      PC_NotAny_CH |
+      PC_NotAny_VF |
+      PC_NotAny_VP |
+      PC_Span_CS   |
+      PC_Span_CH   |
+      PC_Span_VF   |
+      PC_Span_VP   |
+      PC_String    |
+      PC_String_2  |
+      PC_String_3  |
+      PC_String_4  |
+      PC_String_5  |
+      PC_String_6   => True,
+      others        => False);
 
    -------------------------------
    -- The Pattern History Stack --
diff --git a/gcc/ada/g-thread.adb b/gcc/ada/g-thread.adb
index 30367306b2f..1d71f379ed4 100644
--- a/gcc/ada/g-thread.adb
+++ b/gcc/ada/g-thread.adb
@@ -81,8 +81,7 @@ package body GNAT.Threads is
      (Code : Address;
       Parm : Void_Ptr;
       Size : Natural;
-      Prio : Integer)
-      return System.Address
+      Prio : Integer) return System.Address
    is
       TP : Tptr;
 
@@ -108,7 +107,6 @@ package body GNAT.Threads is
 
    procedure Unregister_Thread is
       Self_Id : constant Tasking.Task_ID := Task_Primitives.Operations.Self;
-
    begin
       Self_Id.Common.State := Tasking.Terminated;
       Destroy_TSD (Self_Id.Common.Compiler_Data);
@@ -150,7 +148,6 @@ package body GNAT.Threads is
 
    procedure Destroy_Thread (Id : Address) is
       Tid : constant Task_Id := To_Id (Id);
-
    begin
       Abort_Task (Tid);
    end Destroy_Thread;
@@ -161,9 +158,7 @@ package body GNAT.Threads is
 
    procedure Get_Thread (Id : Address; Thread : Address) is
       use System.OS_Interface;
-
-      Thr : Thread_Id_Ptr := To_Thread (Thread);
-
+      Thr : constant Thread_Id_Ptr := To_Thread (Thread);
    begin
       Thr.all := Task_Primitives.Operations.Get_Thread_Id (To_Id (Id));
    end Get_Thread;
@@ -173,8 +168,7 @@ package body GNAT.Threads is
    ----------------
 
    function To_Task_Id
-     (Id   : System.Address)
-      return Ada.Task_Identification.Task_Id
+     (Id   : System.Address) return Ada.Task_Identification.Task_Id
    is
    begin
       return To_Tid (Id);
diff --git a/gcc/ada/gnatlbr.adb b/gcc/ada/gnatlbr.adb
index 40d54349bee..917f06416da 100644
--- a/gcc/ada/gnatlbr.adb
+++ b/gcc/ada/gnatlbr.adb
@@ -254,7 +254,8 @@ begin
                              & F_ADC_File (1 .. F_ADC_File_Len));
 
                Make_Args (6) :=
-                 new String'("LIBRARY_VERSION=" & '"' & Library_Version & '"');
+                 new String'("LIBRARY_VERSION=" & '"' &
+                             Verbose_Library_Version & '"');
 
                Make_Args (7) :=
                  new String'("-f");
diff --git a/gcc/ada/gnatvsn.ads b/gcc/ada/gnatvsn.ads
index 9cbb871a7a2..3b2c5e84285 100644
--- a/gcc/ada/gnatvsn.ads
+++ b/gcc/ada/gnatvsn.ads
@@ -71,7 +71,7 @@ package Gnatvsn is
    --  value should never be decreased in the future, but it would be
    --  OK to increase it if absolutely necessary.
 
-   Library_Version : constant String := "GNAT Lib v3.4";
+   Library_Version : constant String := "3.4";
    --  Library version. This value must be updated whenever any change to the
    --  compiler affects the library formats in such a way as to obsolete
    --  previously compiled library modules.
@@ -79,6 +79,9 @@ package Gnatvsn is
    --  Note: Makefile.in relies on the precise format of the library version
    --  string in order to correctly construct the soname value.
 
+   Verbose_Library_Version : constant String := "GNAT Lib v" & Library_Version;
+   --  Version string stored in e.g. ALI files.
+
    ASIS_Version_Number : constant := 2;
    --  ASIS Version. This is used to check for consistency between the compiler
    --  used to generate trees, and an ASIS application that is reading the
diff --git a/gcc/ada/lang-specs.h b/gcc/ada/lang-specs.h
index 0ab33ff0201..b68e78d098b 100644
--- a/gcc/ada/lang-specs.h
+++ b/gcc/ada/lang-specs.h
@@ -35,6 +35,7 @@
  %{!gnatc*:%{!gnatz*:%{!gnats*:%{!S:%{!c:\
     %eone of -c, -S, -gnatc, -gnatz, or -gnats is required for Ada}}}}}\
  gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %1 %{!Q:-quiet} %{nostdinc*}\
+    %{nostdlib*}\
     -dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
     %{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
     %{!S:%{o*:%w%*-gnatO}} \
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index fcb5f193778..055f53a897b 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -729,7 +729,7 @@ package body Lib.Writ is
 
       Write_Info_Initiate ('V');
       Write_Info_Str (" """);
-      Write_Info_Str (Library_Version);
+      Write_Info_Str (Verbose_Library_Version);
       Write_Info_Char ('"');
 
       Write_Info_EOL;
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index a304f10a2cd..b566c6b1c91 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -1356,7 +1356,7 @@ package body Make is
             return;
 
          elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
-                                                          Library_Version
+                 Verbose_Library_Version
          then
             Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
             ALI := No_ALI_Id;
diff --git a/gcc/ada/s-geveop.adb b/gcc/ada/s-geveop.adb
index f183a213b39..1820bdf2a47 100644
--- a/gcc/ada/s-geveop.adb
+++ b/gcc/ada/s-geveop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2002 Free Software Foundation, Inc.            --
+--          Copyright (C) 2002-2003 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- --
@@ -61,7 +61,7 @@ package body System.Generic_Vector_Operations is
       function VP is new Unchecked_Conversion (Address, Vector_Ptr);
       function EP is new Unchecked_Conversion (Address, Element_Ptr);
 
-      SA : Address := XA + ((Length + 0) / VU * VU
+      SA : constant Address := XA + ((Length + 0) / VU * VU
                            and (Boolean'Pos (Unaligned) - Address'(1)));
       --  First address of argument X to start serial processing
 
@@ -102,7 +102,7 @@ package body System.Generic_Vector_Operations is
       function VP is new Unchecked_Conversion (Address, Vector_Ptr);
       function EP is new Unchecked_Conversion (Address, Element_Ptr);
 
-      SA : Address := XA + ((Length + 0) / VU * VU
+      SA : constant Address := XA + ((Length + 0) / VU * VU
                            and (Boolean'Pos (Unaligned) - Address'(1)));
       --  First address of argument X to start serial processing
 
diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb
index dc578bc1ce0..0145610dd12 100644
--- a/gcc/ada/s-interr.adb
+++ b/gcc/ada/s-interr.adb
@@ -598,7 +598,7 @@ package body System.Interrupts is
 
       Ptr := Registered_Handler_Head;
 
-      while (Ptr /= null) loop
+      while Ptr /= null loop
          if Ptr.H = Fat.Handler_Addr then
             return True;
          end if;
@@ -946,7 +946,7 @@ package body System.Interrupts is
             Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
          end if;
 
-         if (New_Handler = null) then
+         if New_Handler = null then
             if Old_Handler /= null then
                Unbind_Handler (Interrupt);
             end if;
diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb
index 84dafe76123..63d527d20ae 100644
--- a/gcc/ada/s-taskin.adb
+++ b/gcc/ada/s-taskin.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2003, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -122,7 +122,7 @@ package body System.Tasking is
       All_Tasks_List := T;
    end Initialize_ATCB;
 
-   Main_Task_Image : String := "main_task";
+   Main_Task_Image : constant String := "main_task";
    --  Image of environment task.
 
    Main_Priority : Integer;
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 8fc01030702..14826330e72 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1089,7 +1089,8 @@ package body System.Tasking.Stages is
         (Ada, Tailored_Exception_Information,
          "__gnat_tailored_exception_information");
 
-      Excep : Exception_Occurrence_Access := SSL.Get_Current_Excep.all;
+      Excep : constant Exception_Occurrence_Access :=
+                SSL.Get_Current_Excep.all;
 
    begin
       --  This procedure is called by the task outermost handler in
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 400b162cd60..8629c4d7359 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1364,7 +1364,8 @@ package body Sem_Attr is
             Error_Attr ("prefix of % attribute must be generic type", N);
 
          elsif Is_Generic_Actual_Type (Entity (P))
-           or In_Instance
+           or else In_Instance
+           or else In_Inlined_Body
          then
             null;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 037650fa10c..c626a1bfbef 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9631,6 +9631,12 @@ package body Sem_Prag is
                   E_Id := Expression (Arg2);
                   Analyze (E_Id);
 
+                  if In_Instance_Body
+                    and then Nkind (E_Id) = N_Unchecked_Type_Conversion
+                  then
+                     E_Id := Expression (E_Id);
+                  end if;
+
                   if not Is_Entity_Name (E_Id) then
                      Error_Pragma_Arg
                        ("second argument of pragma% must be entity name",
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index b77d49b9940..0d57ac00f66 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1440,14 +1440,16 @@ package body Sem_Warn is
                when E_Variable =>
 
                   --  Case of variable that is assigned but not read. We
-                  --  suppress the message if the variable is volatile or
-                  --  has an address clause.
+                  --  suppress the message if the variable is volatile,
+                  --  has an address clause, or is imported.
 
                   if Referenced_As_LHS (E)
                     and then No (Address_Clause (E))
                     and then not Is_Volatile (E)
                   then
-                     if Warn_On_Modified_Unread then
+                     if Warn_On_Modified_Unread
+                       and then not Is_Imported (E)
+                     then
                         Error_Msg_N
                           ("variable & is assigned but never read?", E);
                      end if;
diff --git a/gcc/ada/tb-alvms.c b/gcc/ada/tb-alvms.c
index 80cacbc3a7e..60effcc0504 100644
--- a/gcc/ada/tb-alvms.c
+++ b/gcc/ada/tb-alvms.c
@@ -40,33 +40,38 @@
    document, sections of which we will refer to as ABI-<section_number>.  */
 
 #include <pdscdef.h>
+#include <libicb.h>
+#include <chfctxdef.h>
+#include <chfdef.h>
 
-/* We still use a number of macros similar to the ones for the generic
-   __gnat_backtrace implementation.  */
-#define SKIP_FRAME 1
-#define PC_ADJUST -4
-
-#define STOP_FRAME (frame_state.saved_ra == RA_STOP)
-
-/* Mask for PDSC$V_BASE_FRAME in procedure descriptors, missing from the
-   header file included above.  */
+/* A couple of items missing from the header file included above.  */
+extern void * SYS$GL_CALL_HANDL;
 #define PDSC$M_BASE_FRAME (1 << 10)
 
-typedef unsigned long REG;
+/* Registers are 64bit wide and addresses are 32bit wide on alpha-vms.  */
+typedef void * ADDR;
+typedef unsigned long long REG;
+
+#define REG_AT(addr) (*(REG *)(addr))
 
-#define REG_AT(address) (*(REG *)(address))
+#define AS_REG(addr) ((REG)(unsigned long)(addr))
+#define AS_ADDR(reg) ((ADDR)(unsigned long)(reg))
+#define ADDR_IN(reg) (AS_ADDR(reg))
 
 /* The following structure defines the state maintained during the
    unwinding process.  */
 typedef struct
 {
-  void * pc;  /* Address of the call insn involved in the chain.  */
-  void * sp;  /* Stack Pointer at the time of this call.  */
-  void * fp;  /* Frame Pointer at the time of this call.  */
+  ADDR pc;  /* Address of the call insn involved in the chain.  */
+  ADDR sp;  /* Stack Pointer at the time of this call.  */
+  ADDR fp;  /* Frame Pointer at the time of this call.  */
+
+  /* The values above are fetched as saved REGisters on the stack. They are
+     typed ADDR because this is what the values in those registers are.  */
 
   /* Values of the registers saved by the functions in the chain,
-     incrementally updated through consecutive calls to the "unwind"
-     function below.  */
+     incrementally updated through consecutive calls to the "unwind" function
+     below.  */
   REG saved_regs [32];
 } frame_state_t;
 
@@ -79,69 +84,111 @@ typedef struct
 
    This is from ABI-3.1.1 [Integer Registers].  */
 
-#define saved_fp saved_regs[29]
-#define saved_sp saved_regs[30]
-#define saved_ra saved_regs[26]
-#define saved_pv saved_regs[27]
+#define saved_fpr saved_regs[29]
+#define saved_spr saved_regs[30]
+#define saved_rar saved_regs[26]
+#define saved_pvr saved_regs[27]
 
-/* Special values for saved_ra, used to control the overall unwinding
+/* Special values for saved_rar, used to control the overall unwinding
    process.  */
 #define RA_UNKNOWN ((REG)~0)
 #define RA_STOP    ((REG)0)
 
-/* Compute Procedure Value from a live Frame Pointer value.  */
+/* We still use a number of macros similar to the ones for the generic
+   __gnat_backtrace implementation.  */
+#define PC_ADJUST 4
+#define STOP_FRAME (frame_state.saved_rar == RA_STOP)
+
+/* Compute Procedure Value from Frame Pointer value.  This follows the rules
+   in ABI-3.6.1 [Current Procedure].  */
 #define PV_FOR(FP) \
-  ((REG_AT (FP) & 0x7) == 0) ? *(PDSCDEF **)(FP) : (PDSCDEF *)(FP);
+  (((FP) != 0) \
+    ? (((REG_AT (FP) & 0x7) == 0) ? *(PDSCDEF **)(FP) : (PDSCDEF *)(FP)) : 0)
+
 
 /**********
  * unwind *
  **********/
 
-/* Helper for __gnat_backtrace. Update FS->pc/sp/fp to represent the
-   state computed in FS->saved_regs during the previous call, and update
-   FS->saved_regs in preparation of the next call.  */
+/* Helper for __gnat_backtrace.
+
+   FS represents some call frame, identified by a pc and associated frame
+   pointer in FS->pc and FS->fp. FS->saved_regs contains the state of the
+   general registers upon entry in this frame. Of most interest in this set
+   are the saved return address and frame pointer registers, which actually
+   allow identifying the caller's frame.
+
+   This routine "unwinds" the input frame state by adjusting it to eventually
+   represent its caller's frame. The basic principle is to shift the fp and pc
+   saved values into the current state, and then compute the corresponding new
+   saved registers set.
+
+   If the call chain goes through a signal handler, special processing is
+   required when we process the kernel frame which has called the handler, to
+   switch it to the interrupted context frame.  */
+
+#define K_HANDLER_FRAME(fs) (PV_FOR ((fs)->fp) == SYS$GL_CALL_HANDL)
+
+static void unwind_regular_code (frame_state_t * fs);
+static void unwind_kernel_handler (frame_state_t * fs);
 
 void
 unwind (frame_state_t * fs)
 {
-  REG frame_base;
-  PDSCDEF * pv;
-
   /* Don't do anything if requested so.  */
-  if (fs->saved_ra == RA_STOP)
+  if (fs->saved_rar == RA_STOP)
     return;
 
   /* Retrieve the values of interest computed during the previous
      call. PC_ADJUST gets us from the return address to the call insn
      address.  */
-  fs->pc = (void *) fs->saved_ra + PC_ADJUST;
-  fs->sp = (void *) fs->saved_sp;
-  fs->fp = (void *) fs->saved_fp;
+  fs->pc = ADDR_IN (fs->saved_rar) - PC_ADJUST;
+  fs->sp = ADDR_IN (fs->saved_spr);
+  fs->fp = ADDR_IN (fs->saved_fpr);
 
   /* Unless we are able to determine otherwise, set the frame state's
      saved return address such that the unwinding process will stop.  */
-  fs->saved_ra = RA_STOP;
+  fs->saved_rar = RA_STOP;
 
-  /* Now we want to update fs->saved_regs to reflect what the procedure
-     described by pc/fp/sp has done.  */
+  /* Now we want to update fs->saved_regs to reflect the state of the caller
+     of the procedure described by pc/fp.
 
-  /* Compute the corresponding "procedure value", following the rules in
-     ABI-3.6.1 [Current Procedure]. Return immediatly if this value mandates
-     us to stop.  */
-  if (fs->fp == 0)
-    return;
+     The condition to check for a special kernel frame which has called a
+     signal handler is stated in ABI-6.7.1 [Signaler's Registers] : "The frame
+     of the call to the handler can be identified by the return address of
+     SYS$CALL_HANDL+4". We use the equivalent procedure value identification
+     here because SYS$CALL_HANDL appears to be undefined. */
+
+  if (K_HANDLER_FRAME (fs))
+    unwind_kernel_handler (fs);
+  else
+    unwind_regular_code (fs);
+}
 
-  pv = PV_FOR (fs->fp);
+/***********************
+ * unwind_regular_code *
+ ***********************/
+
+/* Helper for unwind, for the case of unwinding through regular code which
+   is not a signal handler.  */
+
+static void
+unwind_regular_code (frame_state_t * fs)
+{
+  PDSCDEF * pv = PV_FOR (fs->fp);
+
+  ADDR frame_base;
+
+  /* Use the procedure value to unwind, in a way depending on the kind of
+     procedure at hand. See ABI-3.3 [Procedure Representation] and ABI-3.4
+     [Procedure Types].  */
 
   if (pv == 0
       || pv->pdsc$w_flags & PDSC$M_BASE_FRAME)
     return;
 
-  /* Use the procedure value to unwind, in a way depending on the kind of
-     procedure at hand. This is based on ABI-3.3 [Procedure Representation]
-     and ABI-3.4 [Procedure Types].  */
   frame_base
-    = (REG) ((pv->pdsc$w_flags & PDSC$M_BASE_REG_IS_FP) ? fs->fp : fs->sp);
+    = (pv->pdsc$w_flags & PDSC$M_BASE_REG_IS_FP) ? fs->fp : fs->sp;
 
   switch (pv->pdsc$w_flags & 0xf)
     {
@@ -149,21 +196,21 @@ unwind (frame_state_t * fs)
       /* Stack Frame Procedure (ABI-3.4.1). Retrieve the necessary registers
 	 from the Register Save Area in the frame.  */
       {
-	REG rsa_base = frame_base + pv->pdsc$w_rsa_offset;
+	ADDR rsa_base = frame_base + pv->pdsc$w_rsa_offset;
 	int i, j;
 
-	fs->saved_ra = REG_AT (rsa_base);
-	fs->saved_pv = REG_AT (frame_base);
-	
+	fs->saved_rar = REG_AT (rsa_base);
+	fs->saved_pvr = REG_AT (frame_base);
+
 	for (i = 0, j = 0; i < 32; i++)
 	  if (pv->pdsc$l_ireg_mask & (1 << i))
 	    fs->saved_regs[i] = REG_AT (rsa_base + 8 * ++j);
 
-	/* Note that the loop above is guaranteed to set fs->saved_fp, because
-	   "The preserved register set must always include R29(FP) since it
-	   will always be used." (ABI-3.4.3.4 [Register Save Area for All
-	   Stack Frames]).
-	
+	/* Note that the loop above is guaranteed to set fs->saved_fpr,
+	   because "The preserved register set must always include R29(FP)
+	   since it will always be used." (ABI-3.4.3.4 [Register Save Area for
+	   All Stack Frames]).
+
 	   Also note that we need to run through all the registers to ensure
 	   that unwinding through register procedures (see below) gets the
 	   right values out of the saved_regs array.  */
@@ -174,8 +221,8 @@ unwind (frame_state_t * fs)
       /* Register Procedure (ABI-3.4.4). Retrieve the necessary registers from
 	 the registers where they have been saved.  */
       {
-	fs->saved_ra = fs->saved_regs[pv->pdsc$b_save_ra];
-	fs->saved_fp = fs->saved_regs[pv->pdsc$b_save_fp];
+	fs->saved_rar = fs->saved_regs[pv->pdsc$b_save_ra];
+	fs->saved_fpr = fs->saved_regs[pv->pdsc$b_save_fp];
       }
       break;
 
@@ -187,19 +234,111 @@ unwind (frame_state_t * fs)
   /* SP is actually never part of the saved registers area, so we use the
      corresponding entry in the saved_regs array to manually keep track of
      it's evolution.  */
-  fs->saved_sp = frame_base + pv->pdsc$l_size;
+  fs->saved_spr = AS_REG (frame_base) + pv->pdsc$l_size;
+}
+
+/*************************
+ * unwind_kernel_handler *
+ *************************/
+
+/* Helper for unwind, for the specific case of unwinding through a signal
+   handler.
+
+   The input frame state describes the kernel frame which has called a signal
+   handler. We fill the corresponding saved_regs to have it's "caller" frame
+   represented as the interrupted context.  */
+
+static void
+unwind_kernel_handler (frame_state_t * fs)
+{
+  PDSCDEF * pv = PV_FOR (fs->fp);
+
+  CHFDEF1 *sigargs;
+  CHFDEF2 *mechargs;
+
+  /* Retrieve the arguments passed to the handler, by way of a VMS service
+     providing the corresponding "Invocation Context Block".  */
+  {
+    long handler_ivhandle;
+    INVO_CONTEXT_BLK handler_ivcb;
+
+    CHFCTX *chfctx;
+
+    handler_ivcb.libicb$q_ireg [29] = AS_REG (fs->fp);
+    handler_ivcb.libicb$q_ireg [30] = 0;
+
+    handler_ivhandle = LIB$GET_INVO_HANDLE (&handler_ivcb);
+
+    if ((LIB$GET_INVO_CONTEXT (handler_ivhandle, &handler_ivcb) & 1) != 1)
+      return;
+
+    chfctx = (CHFCTX *) AS_ADDR (handler_ivcb.libicb$ph_chfctx_addr);
+
+    sigargs = (CHFDEF1 *) AS_ADDR (chfctx->chfctx$q_sigarglst);
+    mechargs = (CHFDEF2 *) AS_ADDR (chfctx->chfctx$q_mcharglst);
+  }
+
+  /* Compute the saved return address as the PC of the instruction causing the
+     condition, accounting for the fact that it will be adjusted by the next
+     call to "unwind" as if it was an actual call return address.  */
+  {
+    /* ABI-6.5.1.1 [Signal Argument Vector]: The signal occurrence address
+       is available from the sigargs argument to the handler, designed to
+       support both 32 and 64 bit addresses.  The initial reference we get
+       is a pointer to the 32bit form, from which one may extract a pointer
+       to the 64bit version if need be.  We work directly from the 32bit
+       form here.  */
+
+    /* The sigargs vector structure for 32bits addresses is:
+
+       <......32bit......>
+       +-----------------+
+       |      Vsize      | :chf$is_sig_args
+       +-----------------+ -+-
+       | Condition Value |  : [0]
+       +-----------------+  :
+       |       ...       |  :
+       +-----------------+  : vector of Vsize entries
+       |    Signal PC    |  :
+       +-----------------+  :
+       |       PS        |  : [Vsize - 1]
+       +-----------------+ -+-
+
+       */
+
+    unsigned long * sigargs_vector
+      = ((unsigned long *) (&sigargs->chf$is_sig_args)) + 1;
+
+    long sigargs_vsize
+      = sigargs->chf$is_sig_args;
+
+    fs->saved_rar = (REG) sigargs_vector [sigargs_vsize - 2] + PC_ADJUST;
+  }
+
+  fs->saved_spr = RA_UNKNOWN;
+  fs->saved_fpr = (REG) mechargs->chf$q_mch_frame;
+  fs->saved_pvr = (REG) mechargs->chf$q_mch_savr27;
+
+  fs->saved_regs[16] = (REG) mechargs->chf$q_mch_savr16;
+  fs->saved_regs[17] = (REG) mechargs->chf$q_mch_savr17;
+  fs->saved_regs[18] = (REG) mechargs->chf$q_mch_savr18;
+  fs->saved_regs[19] = (REG) mechargs->chf$q_mch_savr19;
+  fs->saved_regs[20] = (REG) mechargs->chf$q_mch_savr20;
 }
 
 /* Structure representing a traceback entry in the tracebacks array to be
    filled by __gnat_backtrace below.
 
+   !! This should match what is in System.Traceback_Entries, so beware of
+   !! the REG/ADDR difference here.
+
    The use of a structure is motivated by the potential necessity of having
    several fields to fill for each entry, for instance if later calls to VMS
    system functions need more than just a mere PC to compute info on a frame
    (e.g. for non-symbolic->symbolic translation purposes).  */
 typedef struct {
-  void * pc;
-  void * pv;
+  ADDR pc;
+  ADDR pv;
 } tb_entry_t;
 
 /********************
@@ -207,11 +346,8 @@ typedef struct {
  ********************/
 
 int
-__gnat_backtrace (void **array,
-                  int size,
-                  void *exclude_min,
-                  void *exclude_max,
-                  int skip_frames)
+__gnat_backtrace (void **array, int size,
+                  void *exclude_min, void *exclude_max, int skip_frames)
 {
   int cnt;
 
@@ -223,9 +359,9 @@ __gnat_backtrace (void **array,
   register REG this_FP __asm__("$29");
   register REG this_SP __asm__("$30");
 
-  frame_state.saved_fp = this_FP;
-  frame_state.saved_sp = this_SP;
-  frame_state.saved_ra = RA_UNKNOWN;
+  frame_state.saved_fpr = this_FP;
+  frame_state.saved_spr = this_SP;
+  frame_state.saved_rar = RA_UNKNOWN;
 
   unwind (&frame_state);
 
@@ -239,15 +375,18 @@ __gnat_backtrace (void **array,
   cnt = 0;
   while (cnt < size)
     {
+      PDSCDEF * pv = PV_FOR (frame_state.fp);
+
+      /* Stop if either the frame contents or the unwinder say so.  */
       if (STOP_FRAME)
         break;
 
-      if (frame_state.pc < exclude_min
-	  || frame_state.pc > exclude_max)
+      if (! K_HANDLER_FRAME (&frame_state)
+	  && (frame_state.pc < exclude_min || frame_state.pc > exclude_max))
 	{
-	  tbe->pc = frame_state.pc;
-	  tbe->pv = PV_FOR (frame_state.fp);
-	
+	  tbe->pc = (ADDR) frame_state.pc;
+	  tbe->pv = (ADDR) PV_FOR (frame_state.fp);
+
 	  cnt ++;
 	  tbe ++;
 	}