[multiple changes]
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*). From-SVN: r74226
This commit is contained in:
Arnaud Charlet
parent
1fcc57f195
commit
efdfd311d6
|
|
@ -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;
|
||||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
|
|
|||
|
|
@ -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 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 then
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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}} \
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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(address) (*(REG *)(address))
|
||||
#define REG_AT(addr) (*(REG *)(addr))
|
||||
|
||||
#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. */
|
||||
|
||||
pv = PV_FOR (fs->fp);
|
||||
if (K_HANDLER_FRAME (fs))
|
||||
unwind_kernel_handler (fs);
|
||||
else
|
||||
unwind_regular_code (fs);
|
||||
}
|
||||
|
||||
/***********************
|
||||
* 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 ++;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue