-- This package is used to provide target specific linker_options for the
-- support of scokets as required by the package GNAT.Sockets.
--- This is the UnixWare version of this package
+-- This is the Solaris version of this package
package GNAT.Sockets.Linker_Options is
private
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#80#;
+
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-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- --
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#10#;
+
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2002 Ada Core Technologies, Inc. --
+-- Copyright (C) 2000-2003 Ada Core Technologies, 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- --
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#0008#;
+
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;
SIG_DFL : constant := 0;
SIG_IGN : constant := 1;
+ SA_SIGINFO : constant := 16#0040#;
+
function sigaction
(sig : Signal;
act : struct_sigaction_ptr;
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#80#;
+
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1997-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- --
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#0100#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#0100#;
+
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;
type struct_sigaction_ptr is access all struct_sigaction;
SA_RESTART : constant := 16#40#;
+ SA_SIGINFO : constant := 16#10#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
end record;
type Machine_State_Ptr is access all Machine_State;
+ SA_SIGINFO : constant := 16#04#;
+
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1991-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- --
end record;
type Machine_State_Ptr is access all Machine_State;
+ SA_SIGINFO : constant := 16#04#;
+
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1997-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- --
SIG_DFL : constant := 0;
SIG_IGN : constant := 1;
+ SA_SIGINFO : constant := 0;
+ -- Dummy constant for a sa_flags bit. A proper definition is needed only
+ -- for the GCC/ZCX EH scheme (see System.Interrupt_Management).
+
function sigaction
(sig : Signal;
act : struct_sigaction_ptr;
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2002, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-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- --
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
+ SA_SIGINFO : constant := 16#08;
+
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;
-- --
-- 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- --
act.sa_handler := Notify_Exception'Address;
- act.sa_flags := 0;
+ act.sa_flags := SA_SIGINFO;
+
+ -- Setting SA_SIGINFO asks the kernel to pass more than just the signal
+ -- number argument to the handler when it is called. The set of extra
+ -- parameters typically includes a pointer to a structure describing
+ -- the interrupted context. Although the Notify_Exception handler does
+ -- not use this information, it is actually required for the GCC/ZCX
+ -- exception propagation scheme because on some targets (at least
+ -- alpha-tru64), the structure contents are not even filled when this
+ -- flag is not set.
-- 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
+2003-12-05 Thomas Quinot <quinot@act-europe.fr>
+
+ * 3ssoliop.ads: Fix comment (this is the Solaris, not the UnixWare,
+ version of this unit).
+
+2003-12-05 Olivier Hainque <hainque@act-europe.fr>
+
+ * 53osinte.ads, 54osinte.ads, 55osinte.ads, 56osinte.ads, 5bosinte.ads,
+ 5cosinte.ads, 5hosinte.ads, 5iosinte.ads, 5losinte.ads,
+ 5tosinte.ads: Define the SA_SIGINFO constant, to allow references from
+ the body of System.Interrupt_Management common to several targets.
+ Update copyright notice when appropriate.
+
+ * 52osinte.ads, 5posinte.ads: Define a dummy value for the SA_SIGINFO
+ constant.
+
+ * 7sintman.adb (elaboration): Set SA_SIGINFO in the sigaction flags,
+ to ensure that the kernel fills in the interrupted context structure
+ before calling a signal handler, which is necessary to be able to
+ unwind past it. Update the copyright notice.
+
+2003-12-05 Jerome Guitton <guitton@act-europe.fr>
+
+ * a-elchha.ads: New file.
+
+ * a-elchha.adb: New default last chance handler. Contents taken from
+ Ada.Exceptions.Exception_Traces.Unhandled_Exception_Terminate.
+
+ * a-exextr.adb (Unhandled_Exception_Terminate): Most of this routine
+ is moved to a-elchha.adb to provide a target-independent default last
+ chance handler.
+
+ * Makefile.rtl: Add a-elchha.o
+
+ * Make-lang.in (GNAT_ADA_OBJS, GNATBIND_OBJS): Add a-elchha.o.
+
+2003-12-05 Ed Schonberg <schonberg@gnat.com>
+
+ * exp_ch6.adb (Expand_Call): If the subprogram is inlined and is
+ declared in an instance, do not inline the call if the instance is not
+ frozen yet, to prevent order of elaboration problems.
+
+ * sem_prag.adb: Add comments for previous fix.
+
+2003-12-05 Samuel Tardieu <tardieu@act-europe.fr>
+
+ * g-table.adb: Use the right variable in Set_Item.
+ Update copyright notice.
+
+2003-12-05 Arnaud Charlet <charlet@act-europe.fr>
+
+ * Makefile.in: Remove unused rules.
+
+2003-12-05 Vincent Celier <celier@gnat.com>
+
+ * switch-c.adb (Scan_Front_End_Switches): Remove processing of
+ -nostdlib. Not needed here after all.
+
2003-12-03 Thomas Quinot <quinot@act-europe.fr>
PR ada/11724
# Object files from Ada sources that are used by gnat1
GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
- ada/a-ioexce.o \
+ ada/a-elchha.o ada/a-ioexce.o \
ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/s-except.o ada/ali.o \
ada/alloc.o ada/atree.o ada/butil.o ada/casing.o ada/checks.o ada/comperr.o \
ada/tracebak.o \
ada/a-except.o \
ada/ada.o \
+ ada/a-elchha.o \
ada/ali-util.o \
ada/ali.o \
ada/alloc.o \
endif
endif
-
-ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
- LIBGNAT_TARGET_PAIRS = \
- a-sytaco.ads<4zsytaco.ads \
- a-sytaco.adb<4zsytaco.adb \
- a-intnam.ads<4zintnam.ads \
- a-numaux.ads<4znumaux.ads \
- s-inmaop.adb<7sinmaop.adb \
- s-interr.adb<5zinterr.adb \
- s-intman.ads<5zintman.ads \
- s-intman.adb<5zintman.adb \
- s-osinte.adb<5zosinte.adb \
- s-osinte.ads<5zosinte.ads \
- s-osprim.adb<5zosprim.adb \
- s-parame.ads<5yparame.ads \
- s-taprop.adb<5ztaprop.adb \
- s-taspri.ads<5ztaspri.ads \
- s-thread.adb<5zthread.adb \
- s-tpopsp.adb<5ztpopsp.adb \
- s-vxwork.ads<5pvxwork.ads \
- g-soccon.ads<3zsoccon.ads \
- g-socthi.ads<3zsocthi.ads \
- g-socthi.adb<3zsocthi.adb \
- system.ads<5ysystem.ads
-
- TOOLS_TARGET_PAIRS=mlib-tgt.adb<5zml-tgt.adb
-
- EXTRA_HIE_NONE_TARGET_PAIRS= \
- system.ads<50system.ads
-
- EXTRA_RAVEN_SOURCES=i-vxwork.ads s-vxwork.ads
- EXTRA_RAVEN_OBJS=i-vxwork.o s-vxwork.o
- EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
- EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
- HIE_RAVEN_TARGET_PAIRS=\
- $(HIE_NONE_TARGET_PAIRS) \
- a-reatim.ads<1areatim.ads \
- a-reatim.adb<1areatim.adb \
- a-retide.adb<1aretide.adb \
- a-interr.adb<1ainterr.adb \
- s-interr.ads<1sinterr.ads \
- s-interr.adb<1sinterr.adb \
- s-taskin.ads<1staskin.ads \
- s-taskin.adb<1staskin.adb \
- s-tarest.adb<1starest.adb \
- s-tposen.ads<1stposen.ads \
- s-tposen.adb<1stposen.adb \
- s-osinte.adb<1sosinte.adb \
- s-taprop.ads<1staprop.ads \
- s-taprop.adb<1staprop.adb \
- s-taprob.ads<1staprob.ads \
- s-taprob.adb<1staprob.adb \
- a-sytaco.ads<1asytaco.ads \
- a-sytaco.adb<1asytaco.adb \
- a-intnam.ads<4zintnam.ads \
- s-osinte.ads<5zosinte.ads \
- s-parame.ads<5zparame.ads \
- s-taspri.ads<5ztaspri.ads \
- s-vxwork.ads<5pvxwork.ads \
- a-taside.adb<1ataside.adb \
-
- CERT_LEVEL_B_TARGET_PAIRS=\
- a-tags.ads<1atags.ads \
- a-tags.adb<1atags.adb \
- a-elchha.ads<2aelchha.ads \
- a-elchha.adb<2aelchha.adb.empty \
- a-elchha.adb.full<2aelchha.adb.full \
- a-except.adb<2aexcept.adb \
- a-except.ads<2aexcept.ads \
- a-excach.adb<2aexcach.adb \
- i-c.ads<1ic.ads \
- g-io.adb<2gio.adb \
- s-init.ads<2sinit.ads \
- s-init.adb<5zinit.adb \
- s-memory.adb<2smemory.adb \
- s-memory.ads<2smemory.ads \
- s-osinte.ads<2sosinte.ads \
- s-secsta.ads<2ssecsta.ads \
- s-secsta.adb<2ssecsta.adb \
- s-soflin.adb<2ssoflin.adb \
- s-soflin.ads<2ssoflin.ads \
- s-stalib.adb<1sstalib.adb \
- s-stalib.ads<1sstalib.ads \
- s-thread.adb<5zthread.adb \
- s-traceb.adb<2straceb.adb \
- s-traceb.ads<2straceb.ads \
- system.ads<5isystem.ads
-
- CERT_LEVEL_B_EXTRA_OBJECT_FILES=a-elchha.adb
-
- ifeq ($(strip $(filter-out yes,$(TRACE))),)
- LIBGNAT_TARGET_PAIRS += \
- s-traces.adb<7straces.adb \
- s-trafor.adb<7strafor.adb \
- s-trafor.ads<7strafor.ads \
- s-tratas.adb<7stratas.adb \
- s-tfsetr.adb<5ztfsetr.adb
- endif
-endif
-
ifeq ($(strip $(filter-out powerpc% unknown elf,$(targ))),)
EXTRA_HIE_NONE_TARGET_PAIRS= \
system.ads<59system.ads
a-sytaco.o \
a-taside.o $(EXTRA_RAVEN_OBJS)
-
-# Files which are needed for the cert level B runtime
-
-COMPILABLE_CERT_LEVEL_B_SOURCES = \
-$(COMPILABLE_HIE_SOURCES) \
- a-except.adb \
- a-except.ads \
- a-exctra.ads \
- a-exctra.adb \
- s-init.adb \
- s-init.ads \
- s-memory.adb \
- s-memory.ads \
- s-osinte.ads \
- s-soflin.adb \
- s-soflin.ads \
- s-stalib.adb \
- s-stalib.ads \
- s-assert.adb \
- s-assert.ads \
- s-exnint.adb \
- s-exnint.ads \
- s-strops.adb \
- s-strops.ads \
- s-thread.adb \
- s-thread.ads \
- s-traceb.adb \
- s-traceb.ads \
- s-traent.ads \
- s-traent.adb \
- g-debuti.ads \
- g-debuti.adb \
- g-io.adb \
- g-io.ads \
- $(EXTRA_CERT_LEVEL_B_SOURCES)
-
-NON_COMPILABLE_CERT_LEVEL_B_SOURCES= \
- a-elchha.ads \
- a-elchha.adb \
- a-elchha.adb.full \
- a-excach.adb \
- $(NON_COMPILABLE_HIE_SOURCES)
-
-CERT_LEVEL_B_SOURCES = \
-$(NON_COMPILABLE_CERT_LEVEL_B_SOURCES) \
-$(COMPILABLE_CERT_LEVEL_B_SOURCES)
-
-# Objects to generate for the cert level B run time
-
-CERT_LEVEL_B_OBJS = \
- $(HIE_OBJS) \
- a-except.o \
- s-init.o \
- s-memory.o \
- s-soflin.o \
- s-stalib.o \
- s-thrini.o \
- s-traceb.o \
- s-assert.o \
- s-exnint.o \
- s-strops.o \
- s-thread.o \
- g-debuti.o \
- g-io.o \
- $(EXTRA_CERT_LEVEL_B_OBJS)
-
-# C files for the cert level B run time (without the .c extension)
-
-CERT_LEVEL_B_C_FILES = \
-2raise \
-$(EXTRA_CERT_LEVEL_B_C_FILES)
-
# Default run time files
ADA_INCLUDE_SRCS =\
$(RM) rts-zfp/adalib/*.o
$(CHMOD) a-wx rts-zfp/adalib/*.ali
-rts-cert: force
-# First compile the Ada files ...
- $(MAKE) $(FLAGS_TO_PASS) prepare-rts \
- RTS_NAME=cert RTS_SRCS="$(CERT_LEVEL_B_SOURCES)" \
- RTS_TARGET_PAIRS="$(CERT_LEVEL_B_TARGET_PAIRS)" \
- COMPILABLE_SOURCES="$(COMPILABLE_CERT_LEVEL_B_SOURCES)"
- $(GNATMAKE) -Prts-cert/cert.gpr --GCC="../../../xgcc -B../../../"
-# ... then the C files. This section will eventually be removed.
- $(foreach f,$(CERT_LEVEL_B_C_FILES), \
- $(CP) $(fsrcpfx)$(f).c rts-cert/adainclude/ ;)
- cd rts-cert/adalib ; \
- $(foreach f,$(CERT_LEVEL_B_C_FILES), \
- ../../../$(GCC_FOR_TARGET) -B../../../ $(TARGET_LIBGCC2_CFLAGS) \
- $(ALL_CFLAGS) $(GNATLIBCFLAGS_FOR_C) -c ../adainclude/$(f).c \
- -I../adainclude $(INCLUDES_FOR_SUBDIR) -I../../../ ;) \
-# ... Finally, generate the libs:
- cd rts-cert/adalib ; \
- ../../../xgcc -B../../../ *.o -o libgnat ; \
- $(RM) *.o ; \
- $(MV) libgnat libgnat.o ; \
- $(AR) $(ARFLAGS) libgnat.a libgnat.o ; \
- $(foreach f,$(CERT_LEVEL_B_EXTRA_OBJECT_FILES), \
- ../../../xgcc -c -B../../../ $(GNATLIBFLAGS) ../adainclude/$(f) \
- -I../adainclude; \
- $(AR) $(ARFLAGS) libgnat.a $(subst .adb,.o,$(f))) ; \
- $(CHMOD) a-wx *.ali *.o *.a ; \
-
rts-none: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
RTS_NAME=none RTS_SRCS="$(HIE_SOURCES)" \
a-diocst$(objext) \
a-direio$(objext) \
a-einuoc$(objext) \
+ a-elchha$(objext) \
a-except$(objext) \
a-exctra$(objext) \
a-filico$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . E X C E P T I O N S . L A S T _ C H A N C E _ H A N D L E R --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2003 Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the contents of the part following the private keyword. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; 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. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Default version for most targets
+
+procedure Ada.Exceptions.Last_Chance_Handler
+ (Except : Exception_Occurrence) is
+
+ procedure Unhandled_Terminate;
+ pragma No_Return (Unhandled_Terminate);
+ pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
+ -- Perform system dependent shutdown code
+
+ function Tailored_Exception_Information
+ (X : Exception_Occurrence)
+ return String;
+ -- Exception information to be output in the case of automatic tracing
+ -- requested through GNAT.Exception_Traces.
+ --
+ -- This is the same as Exception_Information if no backtrace decorator
+ -- is currently in place. Otherwise, this is Exception_Information with
+ -- the call chain raw addresses replaced by the result of a call to the
+ -- current decorator provided with the call chain addresses.
+
+ pragma Import
+ (Ada, Tailored_Exception_Information,
+ "__gnat_tailored_exception_information");
+
+ procedure Tailored_Exception_Information
+ (X : Exception_Occurrence;
+ Buff : in out String;
+ Last : in out Integer);
+ -- Procedural version of the above function. Instead of returning the
+ -- result, this one is put in Buff (Buff'first .. Buff'first + Last)
+
+ procedure To_Stderr (S : String);
+ pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
+ -- Little routine to output string to stderr
+
+ Nline : constant String := String'(1 => ASCII.LF);
+ -- Convenient shortcut
+
+ Msg : constant String := Except.Msg (1 .. Except.Msg_Length);
+
+ Max_Static_Exc_Info : constant := 1024;
+ -- This should be enough for most exception information cases
+ -- even though tailoring introduces some uncertainty. The
+ -- name+message should not exceed 320 chars, so that leaves at
+ -- least 35 backtrace slots (each slot needs 19 chars for
+ -- representing a 64 bit address).
+
+ subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
+ type Str_Ptr is access Exc_Info_Type;
+ Exc_Info : Str_Ptr;
+ Exc_Info_Last : Natural := 0;
+ -- Buffer that is allocated to store the tailored exception
+ -- information while Adafinal is run. This buffer is allocated
+ -- on the heap only when it is needed. It is better to allocate
+ -- on the heap than on the stack since stack overflows are more
+ -- common than heap overflows.
+
+ procedure Tailored_Exception_Information
+ (X : Exception_Occurrence;
+ Buff : in out String;
+ Last : in out Integer) is
+
+ Info : String := Tailored_Exception_Information (X);
+ begin
+ Last := Info'Last;
+ Buff (1 .. Last) := Info;
+ end Tailored_Exception_Information;
+
+
+
+begin
+ -- First allocate & store the exception info in a buffer when
+ -- we know it will be needed. This needs to be done before
+ -- Adafinal because it implicitly uses the secondary stack.
+
+ if Except.Id.Full_Name.all (1) /= '_'
+ and then Except.Num_Tracebacks /= 0
+ then
+ Exc_Info := new Exc_Info_Type;
+ if Exc_Info /= null then
+ Tailored_Exception_Information
+ (Except, Exc_Info.all, Exc_Info_Last);
+ end if;
+ end if;
+
+ -- Let's shutdown the runtime now. The rest of the procedure
+ -- needs to be careful not to use anything that would require
+ -- runtime support. In particular, functions returning strings
+ -- are banned since the sec stack is no longer functional.
+ System.Standard_Library.Adafinal;
+
+ -- Check for special case of raising _ABORT_SIGNAL, which is not
+ -- really an exception at all. We recognize this by the fact that
+ -- it is the only exception whose name starts with underscore.
+
+ if Except.Id.Full_Name.all (1) = '_' then
+ To_Stderr (Nline);
+ To_Stderr ("Execution terminated by abort of environment task");
+ To_Stderr (Nline);
+
+ -- If no tracebacks, we print the unhandled exception in the old style
+ -- (i.e. the style used before ZCX was implemented). We do this to
+ -- retain compatibility.
+
+ elsif Except.Num_Tracebacks = 0 then
+ To_Stderr (Nline);
+ To_Stderr ("raised ");
+ To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
+
+ if Msg'Length /= 0 then
+ To_Stderr (" : ");
+ To_Stderr (Msg);
+ end if;
+
+ To_Stderr (Nline);
+
+ else
+ -- Traceback exists
+
+ -- Note we can have this whole information output twice if
+ -- this occurrence gets reraised up to here.
+
+ To_Stderr (Nline);
+ To_Stderr ("Execution terminated by unhandled exception");
+ To_Stderr (Nline);
+ To_Stderr (Exc_Info (1 .. Exc_Info_Last));
+ end if;
+
+ Unhandled_Terminate;
+
+end Ada.Exceptions.Last_Chance_Handler;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . E X C E P T I O N S . L A S T _ C H A N C E _ H A N D L E R --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2003 Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the contents of the part following the private keyword. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; 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. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Last chance handler. Unhandled exceptions are passed to this
+-- routine.
+
+procedure Ada.Exceptions.Last_Chance_Handler
+ (Except : Exception_Occurrence);
+pragma Export (C,
+ Last_Chance_Handler,
+ "__gnat_last_chance_handler");
+pragma No_Return (Last_Chance_Handler);
pragma Export
(Ada, Raise_Hook_Initialized, "__gnat_exception_actions_initialized");
+ procedure Last_Chance_Handler
+ (Except : Exception_Occurrence);
+ pragma Import
+ (C, Last_Chance_Handler, "__gnat_last_chance_handler");
+ pragma No_Return (Last_Chance_Handler);
+ -- Users can replace the default version of this routine,
+ -- Ada.Exceptions.Last_Chance_Handler.
+
function To_Action is new Unchecked_Conversion
(Raise_Action, Exception_Action);
pragma Propagate_Exceptions;
- procedure Unhandled_Terminate;
- pragma No_Return (Unhandled_Terminate);
- pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
- -- Perform system dependent shutdown code
-
----------------------
-- Notify_Exception --
----------------------
-- could be overwritten if an exception is raised during finalization
-- (even if that exception is caught).
- Msg : constant String := Excep.Msg (1 .. Excep.Msg_Length);
-
- Max_Static_Exc_Info : constant := 1024;
- -- That should be enough for most exception information cases
- -- eventhough tailorising introduces some uncertainty. the
- -- name+message should not exceed 320 chars, so that leaves at
- -- least 35 backtrace slots (each slot needs 19 chars for
- -- representing a 64 bit address).
- -- And what happens on overflow ???
-
- subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
- type Str_Ptr is access Exc_Info_Type;
- Exc_Info : Str_Ptr;
- Exc_Info_Last : Natural := 0;
- -- Buffer that is allocated to store the tailored exception
- -- information while Adafinal is run. This buffer is allocated
- -- on the heap only when it is needed. It is better to allocate
- -- on the heap than on the stack since stack overflows are more
- -- common that heap overflows.
-
- -- Start of processing for Unhandled_Exception_Terminate
-
begin
- -- First allocate & store the exception info in a buffer when
- -- we know it will be needed. This needs to be done before
- -- Adafinal because it implicitly uses the secondary stack.
-
- if Excep.Id.Full_Name.all (1) /= '_'
- and then Excep.Num_Tracebacks /= 0
- then
- Exc_Info := new Exc_Info_Type;
- if Exc_Info /= null then
- Tailored_Exception_Information
- (Excep.all, Exc_Info.all, Exc_Info_Last);
- end if;
- end if;
-
- -- Let's shutdown the runtime now. The rest of the procedure
- -- needs to be careful not to use anything that would require
- -- runtime support. In particular, function returing strings
- -- are banned since the sec stack is not functional anymore
-
- System.Standard_Library.Adafinal;
-
- -- Check for special case of raising _ABORT_SIGNAL, which is not
- -- really an exception at all. We recognize this by the fact that
- -- it is the only exception whose name starts with underscore.
-
- if Excep.Id.Full_Name.all (1) = '_' then
- To_Stderr (Nline);
- To_Stderr ("Execution terminated by abort of environment task");
- To_Stderr (Nline);
-
- -- If no tracebacks, we print the unhandled exception in the old style
- -- (i.e. the style used before ZCX was implemented). We do this to
- -- retain compatibility, especially with the nightly scripts, but
- -- this can be removed at some point ???
-
- elsif Excep.Num_Tracebacks = 0 then
- To_Stderr (Nline);
- To_Stderr ("raised ");
- To_Stderr (Excep.Id.Full_Name.all (1 .. Excep.Id.Name_Length - 1));
-
- if Msg'Length /= 0 then
- To_Stderr (" : ");
- To_Stderr (Msg);
- end if;
-
- To_Stderr (Nline);
-
- else
- -- Traceback exists
-
- -- Note we can have this whole information output twice if
- -- this occurrence gets reraised up to here.
-
- To_Stderr (Nline);
- To_Stderr ("Execution terminated by unhandled exception");
- To_Stderr (Nline);
- To_Stderr (Exc_Info (1 .. Exc_Info_Last));
- end if;
-
- Unhandled_Terminate;
+ Last_Chance_Handler (Excep.all);
end Unhandled_Exception_Terminate;
---------------
Bod : Node_Id;
Must_Inline : Boolean := False;
Spec : constant Node_Id := Unit_Declaration_Node (Subp);
+ Scop : constant Entity_Id := Scope (Subp);
begin
-- Verify that the body to inline has already been seen,
then
Must_Inline := False;
+ -- If this an inherited function that returns a private
+ -- type, do not inline if the full view is an unconstrained
+ -- array, because such calls cannot be inlined.
+
+ elsif Present (Orig_Subp)
+ and then Is_Array_Type (Etype (Orig_Subp))
+ and then not Is_Constrained (Etype (Orig_Subp))
+ then
+ Must_Inline := False;
+
+ -- If the subprogram comes from an instance in the same
+ -- unit, and the instance is not yet frozen, inlining might
+ -- trigger order-of-elaboration problems in gigi.
+
+ elsif Is_Generic_Instance (Scop)
+ and then Present (Freeze_Node (Scop))
+ and then not Analyzed (Freeze_Node (Scop))
+ then
+ Must_Inline := False;
+
else
Bod := Body_To_Inline (Spec);
Temp_Typ := Etype (A);
end if;
- -- Comments needed here ???
+ -- If the actual is a simple name or a literal, no need to
+ -- create a temporary, object can be used directly.
if (Is_Entity_Name (A)
and then
-- --
-- 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- --
Item : Table_Component_Type)
is
begin
- if Integer (Index) > Max then
+ if Integer (Index) > Last_Val then
Set_Last (Index);
end if;
E_Id := Expression (Arg2);
Analyze (E_Id);
+ -- In the expansion of an inlined body, a reference to
+ -- the formal may be wrapped in a conversion if the actual
+ -- is a conversion. Retrieve the real entity name.
+
if In_Instance_Body
and then Nkind (E_Id) = N_Unchecked_Type_Conversion
then
when False =>
-- There are few front-end switches that
- -- do not start with -gnat: -I, --RTS, -nostdlib
+ -- do not start with -gnat: -I, --RTS
if Switch_Chars (Ptr) = 'I' then
Store_Switch := False;
Ptr := Max + 1;
- -- Processing of -nostdlib
-
- elsif Ptr + 7 = Max
- and then Switch_Chars (Ptr .. Ptr + 7) = "nostdlib"
- then
- Opt.No_Stdlib := True;
- Ptr := Max + 1;
-
-- Processing of the --RTS switch. --RTS has been modified by
-- gcc and is now of the form -fRTS
projects / gcc.git / commitdiff