OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2004-02-12  Olivier Hainque  <hainque@act-europe.fr>

	* decl.c (components_to_record): Don't claim that the internal fields
	we make to hold the variant parts are semantically addressable, because
	they are not.

	* exp_pakd.adb (Create_Packed_Array_Type): Rename Esiz into PASize and
	adjust the comment describing the modular type form when we can use it.
	(Install_PAT): Account for the Esiz renaming.

	* init.c (__gnat_error_handler for alpha-tru64): Arrange to clear the
	sc_onstack context indication before raising the exception to which
	the signal is mapped. Allows better handling of later signals possibly
	triggered by the resumed user code if the exception is handled.

2004-02-12  Arnaud Charlet  <charlet@act-europe.fr>

	* 5zinit.adb: Removed, no longer used.

2004-02-12  Robert Dewar  <dewar@gnat.com>

	* ali.adb: Remove separating space between parameters on R line. Makes
	format consistent with format used by the binder for Set_Globals call.

	* atree.ads, atree.adb: Minor reformatting (new function header format)

	* bindgen.adb: Add Run-Time Globals documentation section containing
	detailed documentation of the globals passed from the binder file to
	the run time.

	* gnatls.adb: Minor reformatting

	* init.c (__gnat_set_globals): Add note pointing to documentation in
	bindgen.

	* lib-writ.ads, lib-writ.adb: Remove separating space between
	parameters on R line.
	Makes format consistent with format used by the binder for Set_Globals
	call.

	* osint.ads: Add 2004 to copyright notice
	Minor reformatting

	* snames.ads: Correct capitalization of FIFO_Within_Priorities
	Noticed during code reading, documentation issue only

	* usage.adb: Remove junk line for obsolete C switch
	Noticed during code reading

2004-02-12  Vincent Celier  <celier@gnat.com>

	* bld.adb (Process_Declarative_Items): For Source_Dirs call gprcmd
	extend for each directory, so that multiple /** directories are
	extended individually.
	(Recursive_Process): Set the default for LANGUAGES to ada

	* gprcmd.adb: Define new command "ignore", to do nothing.
	Implement new comment "path".

	* Makefile.generic: Suppress output when SILENT is set
	Make sure that when compiler for C/C++ is gcc, the correct -x switch is
	used, so that the correct compiler is invoked.
	When compiler is gcc/g++, put search path in env vars C_INCLUDE_PATH/
	CXX_INCLUDE_PATH, to avoid failure with too long command lines.

2004-02-12  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in: Clean ups and remove obsolete targets.

2004-02-12  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch5.adb: Remove Possible_Unligned_Slice, in favor of the similar
	predicate declared in exp_util.

	* exp_util.adb: Add comments.

	* sem_ch10.adb (Analyze_Subunit): Remove ultimate parent unit from
	visibility before compiling context of the subunit.

	* sem_res.adb (Check_Parameterless_Call): If the context expects a
	value but the name is a procedure, do not attempt to analyze as a call,
	in order to obtain more telling diagnostics.

	* sem_util.adb (Wrong_Type): Further enhancement to diagnose missing
	'Access on parameterless function calls.
	(Normalize_Actuals): For a parameterless function call with missing
	actuals, defer diagnostic until resolution of enclosing call.

	* sem_util.adb (Wrong_Type): If the context type is an access to
	subprogram and the expression is a procedure name, suggest a missing
	'attribute.

From-SVN: r77704
This commit is contained in:
Arnaud Charlet 2004-02-12 14:28:13 +01:00
parent a980dd9b54
commit 18c0ecbeb8
24 changed files with 446 additions and 519 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

319
gcc/ada/5zinit.adb
View File

@ -1,319 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . I N I T --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 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- --
-- 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 Level A cert version of this package for AE653
with Interfaces.C;
-- Used for int and other types
with Ada.Exceptions;
-- Used for Raise_Exception
package body System.Init is
use Ada.Exceptions;
use Interfaces.C;
--------------------------
-- Signal Definitions --
--------------------------
NSIG : constant := 32;
-- Number of signals on the target OS
type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1);
SIGILL : constant := 4; -- illegal instruction (not reset)
SIGFPE : constant := 8; -- floating point exception
SIGBUS : constant := 10; -- bus error
SIGSEGV : constant := 11; -- segmentation violation
type sigset_t is new long;
SIG_SETMASK : constant := 3;
SA_ONSTACK : constant := 16#0004#;
type struct_sigaction is record
sa_handler : System.Address;
sa_mask : sigset_t;
sa_flags : int;
end record;
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
function sigdelset (set : access sigset_t; sig : Signal) return int;
pragma Import (C, sigdelset, "sigdelset");
function sigemptyset (set : access sigset_t) return int;
pragma Import (C, sigemptyset, "sigemptyset");
function sigaction
(sig : Signal;
act : struct_sigaction_ptr;
oact : struct_sigaction_ptr) return int;
pragma Import (C, sigaction, "sigaction");
type sigset_t_ptr is access all sigset_t;
function pthread_sigmask
(how : int;
set : sigset_t_ptr;
oset : sigset_t_ptr) return int;
pragma Import (C, pthread_sigmask, "sigprocmask");
-------------------------------
-- Binder Generated Values --
-------------------------------
Gl_Main_Priority : Integer := -1;
pragma Export (C, Gl_Main_Priority, "__gl_main_priority");
Gl_Time_Slice_Val : Integer := -1;
pragma Export (C, Gl_Time_Slice_Val, "__gl_time_slice_val");
Gl_Wc_Encoding : Character := 'n';
pragma Export (C, Gl_Wc_Encoding, "__gl_wc_encoding");
Gl_Locking_Policy : Character := ' ';
pragma Export (C, Gl_Locking_Policy, "__gl_locking_policy");
Gl_Queuing_Policy : Character := ' ';
pragma Export (C, Gl_Queuing_Policy, "__gl_queuing_policy");
Gl_Task_Dispatching_Policy : Character := ' ';
pragma Export (C, Gl_Task_Dispatching_Policy,
"__gl_task_dispatching_policy");
Gl_Restrictions : Address := Null_Address;
pragma Export (C, Gl_Restrictions, "__gl_restrictions");
Gl_Interrupt_States : Address := Null_Address;
pragma Export (C, Gl_Interrupt_States, "__gl_interrupt_states");
Gl_Num_Interrupt_States : Integer := 0;
pragma Export (C, Gl_Num_Interrupt_States, "__gl_num_interrupt_states");
Gl_Unreserve_All_Interrupts : Integer := 0;
pragma Export (C, Gl_Unreserve_All_Interrupts,
"__gl_unreserve_all_interrupts");
Gl_Exception_Tracebacks : Integer := 0;
pragma Export (C, Gl_Exception_Tracebacks, "__gl_exception_tracebacks");
Gl_Zero_Cost_Exceptions : Integer := 0;
pragma Export (C, Gl_Zero_Cost_Exceptions, "__gl_zero_cost_exceptions");
Already_Called : Boolean := False;
Handler_Installed : Integer := 0;
pragma Export (C, Handler_Installed, "__gnat_handler_installed");
-- Indication of whether synchronous signal handlers have already been
-- installed by a previous call to Install_Handler.
------------------------
-- Local procedures --
------------------------
procedure GNAT_Error_Handler (Sig : Signal);
-- Common procedure that is executed when a SIGFPE, SIGILL,
-- SIGSEGV, or SIGBUS is captured.
------------------------
-- GNAT_Error_Handler --
------------------------
procedure GNAT_Error_Handler (Sig : Signal) is
Mask : aliased sigset_t;
Result : int;
pragma Unreferenced (Result);
begin
-- VxWorks will always mask out the signal during the signal
-- handler and will reenable it on a longjmp. GNAT does not
-- generate a longjmp to return from a signal handler so the
-- signal will still be masked unless we unmask it.
Result := pthread_sigmask (SIG_SETMASK, null, Mask'Unchecked_Access);
Result := sigdelset (Mask'Access, Sig);
Result := pthread_sigmask (SIG_SETMASK, Mask'Unchecked_Access, null);
case Sig is
when SIGFPE =>
Raise_Exception (Constraint_Error'Identity, "SIGFPE");
when SIGILL =>
Raise_Exception (Constraint_Error'Identity, "SIGILL");
when SIGSEGV =>
Raise_Exception
(Program_Error'Identity,
"erroneous memory access");
when SIGBUS =>
Raise_Exception
(Storage_Error'Identity,
"stack overflow or SIGBUS");
when others =>
Raise_Exception (Program_Error'Identity, "unhandled signal");
end case;
end GNAT_Error_Handler;
-----------------
-- Set_Globals --
-----------------
-- This routine is called from the binder generated main program. It
-- copies the values for global quantities computed by the binder
-- into the following global locations. The reason that we go through
-- this copy, rather than just define the global locations in the
-- binder generated file, is that they are referenced from the
-- runtime, which may be in a shared library, and the binder file is
-- not in the shared library. Global references across library
-- boundaries like this are not handled correctly in all systems.
procedure Set_Globals
(Main_Priority : Integer;
Time_Slice_Value : Integer;
WC_Encoding : Character;
Locking_Policy : Character;
Queuing_Policy : Character;
Task_Dispatching_Policy : Character;
Restrictions : System.Address;
Interrupt_States : System.Address;
Num_Interrupt_States : Integer;
Unreserve_All_Interrupts : Integer;
Exception_Tracebacks : Integer;
Zero_Cost_Exceptions : Integer)
is
begin
-- If this procedure has been already called once, check that the
-- arguments in this call are consistent with the ones in the
-- previous calls. Otherwise, raise a Program_Error exception.
-- We do not check for consistency of the wide character encoding
-- method. This default affects only Wide_Text_IO where no
-- explicit coding method is given, and there is no particular
-- reason to let this default be affected by the source
-- representation of a library in any case.
-- We do not check either for the consistency of exception tracebacks,
-- because exception tracebacks are not normally set in Stand-Alone
-- libraries. If a library or the main program set the exception
-- tracebacks, then they are never reset afterwards (see below).
-- The value of main_priority is meaningful only when we are
-- invoked from the main program elaboration routine of an Ada
-- application. Checking the consistency of this parameter should
-- therefore not be done. Since it is assured that the main
-- program elaboration will always invoke this procedure before
-- any library elaboration routine, only the value of
-- main_priority during the first call should be taken into
-- account and all the subsequent ones should be ignored. Note
-- that the case where the main program is not written in Ada is
-- also properly handled, since the default value will then be
-- used for this parameter.
-- For identical reasons, the consistency of time_slice_val should
-- not be checked.
if Already_Called then
if (Gl_Locking_Policy /= Locking_Policy) or else
(Gl_Queuing_Policy /= Queuing_Policy) or else
(Gl_Task_Dispatching_Policy /= Task_Dispatching_Policy) or else
(Gl_Unreserve_All_Interrupts /= Unreserve_All_Interrupts) or else
(Gl_Exception_Tracebacks /= Exception_Tracebacks) or else
(Gl_Zero_Cost_Exceptions /= Zero_Cost_Exceptions)
then
raise Program_Error;
end if;
-- If either a library or the main program set the exception
-- traceback flag, it is never reset later.
if Gl_Exception_Tracebacks /= 0 then
Gl_Exception_Tracebacks := Exception_Tracebacks;
end if;
else
Already_Called := True;
Gl_Main_Priority := Main_Priority;
Gl_Time_Slice_Val := Time_Slice_Value;
Gl_Wc_Encoding := WC_Encoding;
Gl_Locking_Policy := Locking_Policy;
Gl_Queuing_Policy := Queuing_Policy;
Gl_Task_Dispatching_Policy := Task_Dispatching_Policy;
Gl_Restrictions := Restrictions;
Gl_Interrupt_States := Interrupt_States;
Gl_Num_Interrupt_States := Num_Interrupt_States;
Gl_Unreserve_All_Interrupts := Unreserve_All_Interrupts;
Gl_Exception_Tracebacks := Exception_Tracebacks;
Gl_Zero_Cost_Exceptions := Zero_Cost_Exceptions;
end if;
end Set_Globals;
---------------------
-- Install_Handler --
---------------------
procedure Install_Handler is
Mask : aliased sigset_t;
Signal_Action : aliased struct_sigaction;
Result : Interfaces.C.int;
pragma Unreferenced (Result);
begin
-- Set up signal handler to map synchronous signals to appropriate
-- exceptions. Make sure that the handler isn't interrupted by
-- another signal that might cause a scheduling event!
Signal_Action.sa_handler := GNAT_Error_Handler'Address;
Signal_Action.sa_flags := SA_ONSTACK;
Result := sigemptyset (Mask'Access);
Signal_Action.sa_mask := Mask;
Result := sigaction
(Signal (SIGFPE), Signal_Action'Unchecked_Access, null);
Result := sigaction
(Signal (SIGILL), Signal_Action'Unchecked_Access, null);
Result := sigaction
(Signal (SIGSEGV), Signal_Action'Unchecked_Access, null);
Result := sigaction
(Signal (SIGBUS), Signal_Action'Unchecked_Access, null);
Handler_Installed := 1;
end Install_Handler;
end System.Init;

92
gcc/ada/ChangeLog
View File

@ -1,3 +1,95 @@
2004-02-12 Olivier Hainque <hainque@act-europe.fr>
* decl.c (components_to_record): Don't claim that the internal fields
we make to hold the variant parts are semantically addressable, because
they are not.
* exp_pakd.adb (Create_Packed_Array_Type): Rename Esiz into PASize and
adjust the comment describing the modular type form when we can use it.
(Install_PAT): Account for the Esiz renaming.
* init.c (__gnat_error_handler for alpha-tru64): Arrange to clear the
sc_onstack context indication before raising the exception to which
the signal is mapped. Allows better handling of later signals possibly
triggered by the resumed user code if the exception is handled.
2004-02-12 Arnaud Charlet <charlet@act-europe.fr>
* 5zinit.adb: Removed, no longer used.
2004-02-12 Robert Dewar <dewar@gnat.com>
* ali.adb: Remove separating space between parameters on R line. Makes
format consistent with format used by the binder for Set_Globals call.
* atree.ads, atree.adb: Minor reformatting (new function header format)
* bindgen.adb: Add Run-Time Globals documentation section containing
detailed documentation of the globals passed from the binder file to
the run time.
* gnatls.adb: Minor reformatting
* init.c (__gnat_set_globals): Add note pointing to documentation in
bindgen.
* lib-writ.ads, lib-writ.adb: Remove separating space between
parameters on R line.
Makes format consistent with format used by the binder for Set_Globals
call.
* osint.ads: Add 2004 to copyright notice
Minor reformatting
* snames.ads: Correct capitalization of FIFO_Within_Priorities
Noticed during code reading, documentation issue only
* usage.adb: Remove junk line for obsolete C switch
Noticed during code reading
2004-02-12 Vincent Celier <celier@gnat.com>
* bld.adb (Process_Declarative_Items): For Source_Dirs call gprcmd
extend for each directory, so that multiple /** directories are
extended individually.
(Recursive_Process): Set the default for LANGUAGES to ada
* gprcmd.adb: Define new command "ignore", to do nothing.
Implement new comment "path".
* Makefile.generic: Suppress output when SILENT is set
Make sure that when compiler for C/C++ is gcc, the correct -x switch is
used, so that the correct compiler is invoked.
When compiler is gcc/g++, put search path in env vars C_INCLUDE_PATH/
CXX_INCLUDE_PATH, to avoid failure with too long command lines.
2004-02-12 Jerome Guitton <guitton@act-europe.fr>
* Makefile.in: Clean ups and remove obsolete targets.
2004-02-12 Ed Schonberg <schonberg@gnat.com>
* exp_ch5.adb: Remove Possible_Unligned_Slice, in favor of the similar
predicate declared in exp_util.
* exp_util.adb: Add comments.
* sem_ch10.adb (Analyze_Subunit): Remove ultimate parent unit from
visibility before compiling context of the subunit.
* sem_res.adb (Check_Parameterless_Call): If the context expects a
value but the name is a procedure, do not attempt to analyze as a call,
in order to obtain more telling diagnostics.
* sem_util.adb (Wrong_Type): Further enhancement to diagnose missing
'Access on parameterless function calls.
(Normalize_Actuals): For a parameterless function call with missing
actuals, defer diagnostic until resolution of enclosing call.
* sem_util.adb (Wrong_Type): If the context type is an access to
subprogram and the expression is a procedure name, suggest a missing
'attribute.
2004-02-10 Arnaud Charlet <charlet@act-europe.fr>,
Nathanael Nerode <neroden@gcc.gnu.org>

80
gcc/ada/Makefile.generic
View File

@ -9,12 +9,12 @@
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# GCC is distributed in the hope that it will be useful,
# but WITHOUT 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
# along with GCC; see the file COPYING. If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330,
@ -64,7 +64,7 @@
# CXX name of the C++ compiler (optional, default to gcc)
# AR_CMD command to create an archive (optional, default to "ar rc")
# AR_EXT file extension of an archive (optional, default to ".a")
# RANLIB command to generate an index (optional, default to "ranlib")
# RANLIB command to generate an index (optional, default to "ranlib")
# GNATMAKE name of the GNAT builder (optional, default to "gnatmake")
# ADAFLAGS additional Ada compilation switches, e.g "-gnatf" (optional)
# CFLAGS default C compilation switches, e.g "-O2 -g" (optional)
@ -78,6 +78,9 @@
# PROJECT_FILE name of the project file, without the .gpr extension
# DEPS_PROJECTS list of project dependencies (optional)
# SILENT (optional) when defined, make -s will not output anything
# when all commands are successful.
# Set the source search path for C and C++ if needed
ifndef MAIN
@ -124,7 +127,7 @@ ifndef RANLIB
endif
ifndef GNATMAKE
GNATMAKE=gnatmake
GNATMAKE:=gnatmake
endif
ifndef ARCHIVE
@ -135,6 +138,39 @@ ifeq ($(EXEC_DIR),)
EXEC_DIR=$(OBJ_DIR)
endif
# Define display to echo only when SILENT is not defined
ifdef SILENT
define display
@gprcmd ignore
endef
else
define display
@echo
endef
endif
# Make sure gnatmake is called silently when SILENT is set
ifdef SILENT
GNATMAKE:=$(GNATMAKE) -q
endif
# If C/C++ compiler is gcc, make sure gcc is called with the switch indicating
# the language, in case the extension is not standard.
ifeq ($(strip $(filter-out %gcc,$(CC))),)
C_Compiler=$(CC) -x c
else
C_Compiler=$(CC)
endif
ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
CXX_Compiler=$(CXX) -x c++
else
CXX_Compiler=$(CXX)
endif
# Set the object search path
vpath %$(OBJ_EXT) $(OBJ_DIR)
@ -222,8 +258,8 @@ else
endif
C_INCLUDES := $(foreach name,$(SRC_DIRS),-I$(name))
ALL_CFLAGS = $(CFLAGS) $(C_INCLUDES) $(DEP_CFLAGS)
ALL_CXXFLAGS = $(CXXFLAGS) $(C_INCLUDES) $(DEP_CFLAGS)
ALL_CFLAGS = $(CFLAGS) $(DEP_CFLAGS)
ALL_CXXFLAGS = $(CXXFLAGS) $(DEP_CFLAGS)
LDFLAGS := $(LIBS) $(LDFLAGS)
# Compute list of objects based on languages
@ -276,7 +312,7 @@ else
internal-compile: lib$(PROJECT_BASE)$(AR_EXT)
lib$(PROJECT_BASE)$(AR_EXT): $(OBJECTS)
@echo creating archive file for $(PROJECT_BASE)
@$(display) creating archive file for $(PROJECT_BASE)
cd $(OBJ_DIR); $(AR_CMD) $@ $(strip $(OBJECTS))
-$(RANLIB) $(OBJ_DIR)/$@
@ -313,7 +349,7 @@ else
link: $(EXEC_DIR)/$(EXEC) archive-objects
$(EXEC_DIR)/$(EXEC): $(OBJ_FILES)
@echo $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
@$(display) $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
endif
endif
@ -327,11 +363,12 @@ ifeq ($(strip $(filter-out c c++ ada,$(LANGUAGES))),)
ifeq ($(MAIN),ada)
# Ada main
link: $(LINKER) archive-objects force
$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
@(display) $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) archive-objects force
@echo $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(display) $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) -P$(PROJECT_FILE) $(EXEC_RULE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(LARGS) $(LDFLAGS)
@ -339,11 +376,12 @@ else
# C/C++ main
link: $(LINKER) archive-objects force
$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
@(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) archive-objects force
@echo $(GNATMAKE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(display) $(GNATMAKE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) \
-B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
@ -360,7 +398,12 @@ endif
# Automatic handling of dependencies
ifeq ($(strip $(filter-out %gcc %g++,$(CC) $(CXX))),)
# Compiler is GCC, take avantage of the preprocessor option -MD
# Compiler is GCC, take avantage of the preprocessor option -MD and
# C*_INCLUDE_PATH environment variables
export C_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(C_INCLUDE_PATH)
export CXX_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(CXX_INCLUDE_PATH)
DEP_CFLAGS = -Wp,-MD,$(OBJ_DIR)/$(*F).d
define post-compile
@ -375,6 +418,9 @@ $(OBJ_DIR)/%.d:
else
# Compiler unknown, use a more general approach based on the output of $(CC) -M
ALL_CFLAGS := $(ALL_CFLAGS) $(C_INCLUDES)
ALL_CXXFLAGS := $(ALL_CXXFLAGS) $(C_INCLUDES)
DEP_FLAGS = -M
DEP_CFLAGS =
@ -400,17 +446,17 @@ endif
# Compile C files individually
%$(OBJ_EXT) : %$(C_EXT)
@echo $(CC) -c $(CFLAGS) $< -o $(OBJ_DIR)/$@
@$(display) $(C_Compiler) -c $(CFLAGS) $< -o $(OBJ_DIR)/$@
ifndef FAKE_COMPILE
@$(CC) -c $(ALL_CFLAGS) $< -o $(OBJ_DIR)/$@
@$(C_Compiler) -c $(ALL_CFLAGS) $< -o $(OBJ_DIR)/$@
@$(post-compile)
endif
# Compile C++ files individually
%$(OBJ_EXT) : %$(CXX_EXT)
@echo $(CXX) -c $(CXXFLAGS) $< -o $(OBJ_DIR)/$@
@$(display) $(CXX_Compiler) -c $(CXXFLAGS) $< -o $(OBJ_DIR)/$@
ifndef FAKE_COMPILE
@$(CXX) -c $(ALL_CXXFLAGS) $< -o $(OBJ_DIR)/$@
@$(CXX_Compiler) -c $(ALL_CXXFLAGS) $< -o $(OBJ_DIR)/$@
@$(post-compile)
endif

13
gcc/ada/Makefile.in
View File

@ -1861,27 +1861,18 @@ rts-zfp: force
RTS_NAME=zfp RTS_SRCS="$(HIE_SOURCES)" \
RTS_TARGET_PAIRS="$(HIE_NONE_TARGET_PAIRS)" \
COMPILABLE_SOURCES="$(COMPILABLE_HIE_SOURCES)"
-$(GNATMAKE) -Prts-zfp/zfp.gpr --GCC="../../../xgcc -B../../../"
$(GNATMAKE) -Prts-zfp/zfp.gpr --GCC="../../../xgcc -B../../../"
cd rts-zfp/adalib/ ; $(AR) r libgnat.a *.o
$(RM) rts-zfp/adalib/*.o
$(CHMOD) a-wx rts-zfp/adalib/*.ali
$(CHMOD) a-wx rts-zfp/adalib/libgnat.a
rts-none: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
RTS_NAME=none RTS_SRCS="$(HIE_SOURCES)" \
RTS_TARGET_PAIRS="$(HIE_NONE_TARGET_PAIRS)" \
COMPILABLE_SOURCES="$(COMPILABLE_HIE_SOURCES)"
-$(GNATMAKE) -Prts-none/none.gpr --GCC="../../../xgcc -B../../../"
$(RM) rts-none/adalib/*.o
$(CHMOD) a-wx rts-none/adalib/*.ali
rts-ravenscar: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
RTS_NAME=ravenscar RTS_SRCS="$(RAVEN_SOURCES)" \
RTS_TARGET_PAIRS="$(HIE_RAVEN_TARGET_PAIRS)" \
COMPILABLE_SOURCES="$(COMPILABLE_RAVEN_SOURCES)"
-$(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
$(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
--GCC="../../../xgcc -B../../../"
cd rts-ravenscar/adalib/ ; $(AR) r libgnat.a *.o
$(RM) rts-ravenscar/adalib/*.o

4
gcc/ada/ali.adb
View File

@ -991,10 +991,6 @@ package body ALI is
end case;
end loop;
-- Skip separating space
Checkc (' ');
-- Acquire information for parameter restrictions
for RP in All_Parameter_Restrictions loop

27
gcc/ada/atree.adb
View File

@ -1032,8 +1032,7 @@ package body Atree is
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
New_Scope : Entity_Id := Empty)
return Node_Id
New_Scope : Entity_Id := Empty) return Node_Id
is
Actual_Map : Elist_Id := Map;
-- This is the actual map for the copy. It is initialized with the
@ -1053,8 +1052,7 @@ package body Atree is
-- Builds hash tables (number of elements >= threshold value)
function Copy_Elist_With_Replacement
(Old_Elist : Elist_Id)
return Elist_Id;
(Old_Elist : Elist_Id) return Elist_Id;
-- Called during second phase to copy element list doing replacements.
procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
@ -1167,8 +1165,7 @@ package body Atree is
---------------------------------
function Copy_Elist_With_Replacement
(Old_Elist : Elist_Id)
return Elist_Id
(Old_Elist : Elist_Id) return Elist_Id
is
M : Elmt_Id;
New_Elist : Elist_Id;
@ -1243,8 +1240,7 @@ package body Atree is
--------------------------------
function Copy_List_With_Replacement
(Old_List : List_Id)
return List_Id
(Old_List : List_Id) return List_Id
is
New_List : List_Id;
E : Node_Id;
@ -1270,14 +1266,12 @@ package body Atree is
--------------------------------
function Copy_Node_With_Replacement
(Old_Node : Node_Id)
return Node_Id
(Old_Node : Node_Id) return Node_Id
is
New_Node : Node_Id;
function Copy_Field_With_Replacement
(Field : Union_Id)
return Union_Id;
(Field : Union_Id) return Union_Id;
-- Given Field, which is a field of Old_Node, return a copy of it
-- if it is a syntactic field (i.e. its parent is Node), setting
-- the parent of the copy to poit to New_Node. Otherwise returns
@ -1288,8 +1282,7 @@ package body Atree is
---------------------------------
function Copy_Field_With_Replacement
(Field : Union_Id)
return Union_Id
(Field : Union_Id) return Union_Id
is
begin
if Field = Union_Id (Empty) then
@ -1829,8 +1822,7 @@ package body Atree is
function New_Entity
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr)
return Entity_Id
New_Sloc : Source_Ptr) return Entity_Id
is
Ent : Entity_Id;
@ -1900,8 +1892,7 @@ package body Atree is
function New_Node
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr)
return Node_Id
New_Sloc : Source_Ptr) return Node_Id
is
Nod : Node_Id;

9
gcc/ada/atree.ads
View File

@ -332,8 +332,7 @@ package Atree is
function New_Node
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr)
return Node_Id;
New_Sloc : Source_Ptr) return Node_Id;
-- Allocates a completely new node with the given node type and source
-- location values. All other fields are set to their standard defaults:
--
@ -351,8 +350,7 @@ package Atree is
function New_Entity
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr)
return Entity_Id;
New_Sloc : Source_Ptr) return Entity_Id;
-- Similar to New_Node, except that it is used only for entity nodes
-- and returns an extended node.
@ -427,8 +425,7 @@ package Atree is
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
New_Scope : Entity_Id := Empty)
return Node_Id;
New_Scope : Entity_Id := Empty) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Tree copies the entire
-- syntactic subtree, including recursively any descendents whose parent
-- field references a copied node (descendents not linked to a copied node

82
gcc/ada/bindgen.adb
View File

@ -80,6 +80,88 @@ package body Bindgen is
Table_Increment => 200,
Table_Name => "IS_Pragma_Settings");
----------------------
-- Run-Time Globals --
----------------------
-- This section documents the global variables that are passed to the
-- run time from the generated binder file. The call that is made is
-- to the routine Set_Globals, which has the following spec:
-- procedure Set_Globals
-- (Main_Priority : Integer;
-- Time_Slice_Value : Integer;
-- WC_Encoding : Character;
-- Locking_Policy : Character;
-- Queuing_Policy : Character;
-- Task_Dispatching_Policy : Character;
-- Restrictions : System.Address;
-- Interrupt_States : System.Address;
-- Num_Interrupt_States : Integer;
-- Unreserve_All_Interrupts : Integer;
-- Exception_Tracebacks : Integer;
-- Zero_Cost_Exceptions : Integer);
-- Main_Priority is the priority value set by pragma Priority in the
-- main program. If no such pragma is present, the value is -1.
-- Time_Slice_Value is the time slice value set by pragma Time_Slice
-- in the main program, or by the use of a -Tnnn parameter for the
-- binder (if both are present, the binder value overrides). The
-- value is in milliseconds. A value of zero indicates that time
-- slicing should be suppressed. If no pragma is present, and no
-- -T switch was used, the value is -1.
-- WC_Encoding shows the wide character encoding method used for
-- the main program. This is one of the encoding letters defined
-- in System.WCh_Con.WC_Encoding_Letters.
-- Locking_Policy is a space if no locking policy was specified
-- for the partition. If a locking policy was specified, the value
-- is the upper case first character of the locking policy name,
-- for example, 'C' for Ceiling_Locking.
-- Queuing_Policy is a space if no queuing policy was specified
-- for the partition. If a queuing policy was specified, the value
-- is the upper case first character of the queuing policy name
-- for example, 'F' for FIFO_Queuing.
-- Task_Dispatching_Policy is a space if no task dispatching policy
-- was specified for the partition. If a task dispatching policy
-- was specified, the value is the upper case first character of
-- the policy name, e.g. 'F' for FIFO_Within_Priorities.
-- Restrictions is the address of a null-terminated string specifying the
-- restrictions information for the partition. The format is identical to
-- that of the parameter string found on R lines in ali files (see Lib.Writ
-- spec in lib-writ.ads for full details). The difference is that in this
-- context the values are the cumulative ones for the entire partition.
-- Interrupt_States is the address of a string used to specify the
-- cumulative results of Interrupt_State pragmas used in the partition.
-- The length of this string is determined by the last interrupt for which
-- such a pragma is given (the string will be a null string if no pragmas
-- were used). If pragma were present the entries apply to the interrupts
-- in sequence from the first interrupt, and are set to one of four
-- possible settings: 'n' for not specified, 'u' for user, 'r' for
-- run time, 's' for system, see description of Interrupt_State pragma
-- for further details.
-- Num_Interrupt_States is the length of the Interrupt_States string.
-- It will be set to zero if no Interrupt_State pragmas are present.
-- Unreserve_All_Interrupts is set to one if at least one unit in the
-- partition had a pragma Unreserve_All_Interrupts, and zero otherwise.
-- Exception_Tracebacks is set to one if the -E parameter was present
-- in the bind and to zero otherwise. Note that on some targets exception
-- tracebacks are provided by default, so a value of zero for this
-- parameter does not necessarily mean no trace backs are available.
-- Zero_Cost_Exceptions is set to one if zero cost exceptions are used for
-- this partition, and to zero if longjmp/setjmp exceptions are used.
-- the use of zero
-----------------------
-- Local Subprograms --
-----------------------

15
gcc/ada/bld.adb
View File

@ -1504,11 +1504,11 @@ package body Bld is
-- being an absolute directory name.
Put (Project_Name &
".src_dirs:=$(shell gprcmd extend $(");
Put (Project_Name);
Put (".base_dir) '$(");
".src_dirs:=$(foreach name,$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put_Line (")')");
Put ("),$(shell gprcmd extend $(");
Put (Project_Name);
Put_Line (".base_dir) '$(name)'))");
elsif Item_Name = Snames.Name_Source_Files then
@ -2692,6 +2692,13 @@ package body Bld is
IO.Mark (Src_List_File_Init);
Put_Line ("src_list_file.specified:=FALSE");
-- Default language is Ada, but variable LANGUAGES may have
-- been changed by an imported Makefile. So, we set it
-- to "ada"; if attribute Languages is defined in the project
-- file, it will be redefined.
Put_Line ("LANGUAGES:=ada");
-- <PROJECT>.src_dirs is set by default to the project
-- directory.

4
gcc/ada/decl.c
View File

@ -5366,7 +5366,7 @@ components_to_record (tree gnu_record_type,
? TYPE_SIZE (gnu_record_type) : 0),
(all_rep_and_size
? bitsize_zero_node : 0),
1);
0);
DECL_INTERNAL_P (gnu_field) = 1;
DECL_QUALIFIER (gnu_field) = gnu_qual;
@ -5397,7 +5397,7 @@ components_to_record (tree gnu_record_type,
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
packed,
all_rep ? TYPE_SIZE (gnu_union_type) : 0,
all_rep ? bitsize_zero_node : 0, 1);
all_rep ? bitsize_zero_node : 0, 0);
DECL_INTERNAL_P (gnu_union_field) = 1;
TREE_CHAIN (gnu_union_field) = gnu_field_list;

69
gcc/ada/exp_ch5.adb
View File

@ -52,7 +52,6 @@ with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
with Validsw; use Validsw;
@ -181,16 +180,6 @@ package body Exp_Ch5 is
-- an object. Such objects can be aliased to parameters (unlike local
-- array references).
function Possible_Unaligned_Slice (Arg : Node_Id) return Boolean;
-- Returns True if Arg (either the left or right hand side of the
-- assignment) is a slice that could be unaligned wrt the array type.
-- This is true if Arg is a component of a packed record, or is
-- a record component to which a component clause applies. This
-- is a little pessimistic, but the result of an unnecessary
-- decision that something is possibly unaligned is only to
-- generate a front end loop, which is not so terrible.
-- It would really be better if backend handled this ???
-----------------------
-- Apply_Dereference --
-----------------------
@ -242,60 +231,6 @@ package body Exp_Ch5 is
and then Is_Non_Local_Array (Prefix (Exp)));
end Is_Non_Local_Array;
------------------------------
-- Possible_Unaligned_Slice --
------------------------------
function Possible_Unaligned_Slice (Arg : Node_Id) return Boolean is
begin
-- No issue if this is not a slice, or else strict alignment
-- is not required in any case.
if Nkind (Arg) /= N_Slice
or else not Target_Strict_Alignment
then
return False;
end if;
-- No issue if the component type is a byte or byte aligned
declare
Array_Typ : constant Entity_Id := Etype (Arg);
Comp_Typ : constant Entity_Id := Component_Type (Array_Typ);
Pref : constant Node_Id := Prefix (Arg);
begin
if Known_Alignment (Array_Typ) then
if Alignment (Array_Typ) = 1 then
return False;
end if;
elsif Known_Component_Size (Array_Typ) then
if Component_Size (Array_Typ) = 1 then
return False;
end if;
elsif Known_Esize (Comp_Typ) then
if Esize (Comp_Typ) <= System_Storage_Unit then
return False;
end if;
end if;
-- No issue if this is not a selected component
if Nkind (Pref) /= N_Selected_Component then
return False;
end if;
-- Else we test for a possibly unaligned component
return
Is_Packed (Etype (Pref))
or else
Present (Component_Clause (Entity (Selector_Name (Pref))));
end;
end Possible_Unaligned_Slice;
-- Determine if Lhs, Rhs are formal arrays or nonlocal arrays
Lhs_Formal : constant Boolean := Is_Formal_Array (Act_Lhs);
@ -528,8 +463,8 @@ package body Exp_Ch5 is
elsif Is_Bit_Packed_Array (L_Type)
or else Is_Bit_Packed_Array (R_Type)
or else Possible_Unaligned_Slice (Lhs)
or else Possible_Unaligned_Slice (Rhs)
or else Is_Possibly_Unaligned_Slice (Lhs)
or else Is_Possibly_Unaligned_Slice (Rhs)
then
Loop_Required := True;

15
gcc/ada/exp_pakd.adb
View File

@ -700,7 +700,7 @@ package body Exp_Pakd is
Ancest : Entity_Id;
PB_Type : Entity_Id;
Esiz : Uint;
PASize : Uint;
Decl : Node_Id;
PAT : Entity_Id;
Len_Dim : Node_Id;
@ -770,10 +770,10 @@ package body Exp_Pakd is
-- Do not reset RM_Size if already set, as happens in the case
-- of a modular type.
Set_Esize (PAT, Esiz);
Set_Esize (PAT, PASize);
if Unknown_RM_Size (PAT) then
Set_RM_Size (PAT, Esiz);
Set_RM_Size (PAT, PASize);
end if;
-- Set remaining fields of packed array type
@ -853,7 +853,7 @@ package body Exp_Pakd is
-- type, since this size clearly belongs to the packed array type. The
-- size of the conceptual unpacked type is always set to unknown.
Esiz := Esize (Typ);
PASize := Esize (Typ);
-- Case of an array where at least one index is of an enumeration
-- type with a non-standard representation, but the component size
@ -1099,7 +1099,8 @@ package body Exp_Pakd is
-- We can use the modular type, it has the form:
-- subtype tttPn is btyp
-- range 0 .. 2 ** (Esize (Typ) * Csize) - 1;
-- range 0 .. 2 ** ((Typ'Length (1)
-- * ... * Typ'Length (n)) * Csize) - 1;
-- The bounds are statically known, and btyp is one
-- of the unsigned types, depending on the length. If the
@ -1140,8 +1141,8 @@ package body Exp_Pakd is
Make_Integer_Literal (Loc, 0),
High_Bound => Lit))));
if Esiz = Uint_0 then
Esiz := Len_Bits;
if PASize = Uint_0 then
PASize := Len_Bits;
end if;
Install_PAT;

7
gcc/ada/exp_util.adb
View File

@ -2352,6 +2352,13 @@ package body Exp_Util is
function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
begin
-- ??? GCC3 will eventually handle strings with arbitrary alignments,
-- but for now the following check must be disabled.
-- if get_gcc_version >= 3 then
-- return False;
-- end if;
if Is_Entity_Name (P)
and then Is_Object (Entity (P))
and then Present (Renamed_Object (Entity (P)))

28
gcc/ada/gnatls.adb
View File

@ -87,10 +87,10 @@ procedure Gnatls is
Print_Unit : Boolean := True;
Print_Source : Boolean := True;
Print_Object : Boolean := True;
-- Flags controlling the form of the outpout
-- Flags controlling the form of the output
Dependable : Boolean := False; -- flag -d
Also_Predef : Boolean := False;
Dependable : Boolean := False; -- flag -d
Also_Predef : Boolean := False;
Unit_Start : Integer;
Unit_End : Integer;
@ -132,14 +132,14 @@ procedure Gnatls is
-- updated to the full file name if available.
function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
-- Give the Sdep entry corresponding to the unit U in ali record A.
-- Give the Sdep entry corresponding to the unit U in ali record A
procedure Output_Object (O : File_Name_Type);
-- Print out the name of the object when requested
procedure Output_Source (Sdep_I : Sdep_Id);
-- Print out the name and status of the source corresponding to this
-- sdep entry
-- sdep entry.
procedure Output_Status (FS : File_Status; Verbose : Boolean);
-- Print out FS either in a coded form if verbose is false or in an
@ -152,10 +152,10 @@ procedure Gnatls is
-- Reset Print flags properly when selective output is chosen
procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean);
-- Scan and process lser specific arguments. Argv is a single argument.
-- Scan and process lser specific arguments. Argv is a single argument
procedure Usage;
-- Print usage message.
-- Print usage message
-----------------
-- Add_Lib_Dir --
@ -279,10 +279,12 @@ procedure Gnatls is
-- Verify is output is not wider than maximum number of columns
Too_Long := Verbose_Mode or else
(Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
Too_Long :=
Verbose_Mode
or else
(Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
-- Set start and end of columns.
-- Set start and end of columns
Object_Start := 1;
Object_End := Object_Start - 1;
@ -817,10 +819,9 @@ begin
Namet.Initialize;
Csets.Initialize;
-- Use low level argument routines to avoid dragging in the secondary stack
-- Loop to scan out arguments
Next_Arg := 1;
Scan_Args : while Next_Arg < Arg_Count loop
declare
Next_Argv : String (1 .. Len_Arg (Next_Arg));
@ -956,6 +957,7 @@ begin
end loop;
Find_General_Layout;
for Id in ALIs.First .. ALIs.Last loop
declare
Last_U : Unit_Id;
@ -993,7 +995,7 @@ begin
end if;
end loop;
-- Print out list of dependable units
-- Print out list of units on which this unit depends (D lines)
if Dependable and then Print_Source then
if Verbose_Mode then

23
gcc/ada/gprcmd.adb
View File

@ -38,6 +38,9 @@
-- deps post process dependency makefiles
-- stamp copy file time stamp from file1 to file2
-- prefix get the prefix of the GNAT installation
-- path convert a list of directories to a path list, inserting a
-- path separator after each directory, including the last one
-- ignore do nothing
with Gnatvsn;
with Osint; use Osint;
@ -349,6 +352,10 @@ procedure Gprcmd is
"copy file time stamp from file1 to file2");
Put_Line (Standard_Error, " prefix " &
"get the prefix of the GNAT installation");
Put_Line (Standard_Error, " path " &
"convert a directory list into a path list");
Put_Line (Standard_Error, " ignore " &
"do nothing");
OS_Exit (1);
end Usage;
@ -363,7 +370,8 @@ begin
begin
if Cmd = "-v" then
-- Should this be on Standard_Error ???
-- Output on standard error, because only returned values should
-- go to standard output.
Put (Standard_Error, "GPRCMD ");
Put (Standard_Error, Gnatvsn.Gnat_Version_String);
@ -474,6 +482,19 @@ begin
end if;
end;
-- For "path" just add path separator after each directory argument
elsif Cmd = "path" then
for J in 2 .. Argument_Count loop
Put (Argument (J));
Put (Path_Separator);
end loop;
-- For "ignore" do nothing
elsif Cmd = "ignore" then
null;
-- Unknown command
else

56
gcc/ada/init.c
View File

@ -39,6 +39,10 @@
installed by this file are used to handle resulting signals that come
from these probes failing (i.e. touching protected pages) */
/* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, and
5zinit.adb. All these files implement the required functionality for
different targets. */
/* The following include is here to meet the published VxWorks requirement
that the __vxworks header appear before any other include. */
#ifdef __vxworks
@ -154,6 +158,9 @@ __gnat_get_interrupt_state (int intrup)
binder file is not in the shared library. Global references across library
boundaries like this are not handled correctly in all systems. */
/* For detailed description of the parameters to this routine, see the
section titled Run-Time Globals in package Bindgen (bindgen.adb) */
void
__gnat_set_globals (int main_priority,
int time_slice_val,
@ -363,6 +370,7 @@ __gnat_initialize (void)
exclude this case in the above test. */
#include <signal.h>
#include <setjmp.h>
#include <sys/siginfo.h>
static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
@ -440,7 +448,48 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
if (mstate != 0)
*mstate = *context;
Raise_From_Signal_Handler (exception, (char *) msg);
/* We are now going to raise the exception corresponding to the signal we
caught, which may eventually end up resuming the application code if the
exception is handled.
When the exception is handled, merely arranging for the *exception*
handler's context (stack pointer, program counter, other registers, ...)
to be installed is *not* enough to let the kernel think we've left the
*signal* handler. This has annoying implications if an alternate stack
has been setup for this *signal* handler, because the kernel thinks we
are still running on that alternate stack even after the jump, which
causes trouble at least as soon as another signal is raised.
We deal with this by forcing a "local" longjmp within the signal handler
below, forcing the "on alternate stack" indication to be reset (kernel
wise) on the way. If no alternate stack has been setup, this should be a
neutral operation. Otherwise, we will be in a delicate situation for a
short while because we are going to run the exception propagation code
within the alternate stack area (that is, with the stack pointer inside
the alternate stack bounds), but with the corresponding flag off from the
kernel's standpoint. We expect this to be ok as long as the propagation
code does not trigger a signal itself, which is expected.
??? A better approach would be to at least delay this operation until the
last second, that is, until just before we jump to the exception handler,
if any. */
{
jmp_buf handler_jmpbuf;
if (setjmp (handler_jmpbuf) != 0)
Raise_From_Signal_Handler (exception, (char *) msg);
else
{
/* Arrange for the "on alternate stack" flag to be reset. See the
comments around "jmp_buf offsets" in /usr/include/setjmp.h. */
struct sigcontext * handler_context
= (struct sigcontext *) & handler_jmpbuf;
handler_context->sc_onstack = 0;
longjmp (handler_jmpbuf, 1);
}
}
}
void
@ -461,11 +510,12 @@ __gnat_install_handler (void)
we want this to happen for tasks also. */
static char sig_stack [8*1024];
/* 8K allocated here because 4K is not enough for the GCC/ZCX scheme. */
/* 8K is a mininum to be able to propagate an exception using the GCC/ZCX
scheme. */
struct sigaltstack ss;
ss.ss_sp = (void *) & sig_stack;
ss.ss_sp = (void *) sig_stack;
ss.ss_size = sizeof (sig_stack);
ss.ss_flags = 0;

4
gcc/ada/lib-writ.adb
View File

@ -940,10 +940,6 @@ package body Lib.Writ is
end if;
end loop;
-- A separating space
Write_Info_Char (' ');
-- And now the information for the parameter restrictions
for RP in All_Parameter_Restrictions loop

7
gcc/ada/lib-writ.ads
View File

@ -256,7 +256,7 @@ package Lib.Writ is
-- has been able to determine with respect to restrictions violations.
-- The format is:
-- R <<restriction-characters>> space <<restriction-param-id-entries>>
-- R <<restriction-characters>> <<restriction-param-id-entries>>
-- The first parameter is a string of characters that records
-- information regarding restrictions that do not take parameter
@ -283,8 +283,9 @@ package Lib.Writ is
-- has "v", which is not permitted, since these restrictions
-- are partition-wide.
-- Following a space, the second parameter refers to restriction
-- identifiers for which a parameter is given.
-- The second parameter, which immediately follows the first (with
-- no separating space) gives restriction information for identifiers
-- for which a parameter is given.
-- The parameter is a string of entries, one for each value in
-- Restrict.All_Parameter_Restrictions. Each entry has two

44
gcc/ada/osint.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -52,9 +52,8 @@ package Osint is
type File_Type is (Source, Library, Config, Definition, Preprocessing_Data);
function Find_File
(N : File_Name_Type;
T : File_Type)
return File_Name_Type;
(N : File_Name_Type;
T : File_Type) return File_Name_Type;
-- Finds a source, library or config file depending on the value
-- of T following the directory search order rules unless N is the
-- name of the file just read with Next_Main_File and already
@ -155,8 +154,7 @@ package Osint is
function To_Canonical_File_List
(Wildcard_Host_File : String;
Only_Dirs : Boolean)
return String_Access_List_Access;
Only_Dirs : Boolean) return String_Access_List_Access;
-- Expand a wildcard host syntax file or directory specification (e.g. on
-- a VMS host, any file or directory spec that contains:
-- "*", or "%", or "...")
@ -165,8 +163,7 @@ package Osint is
function To_Canonical_Dir_Spec
(Host_Dir : String;
Prefix_Style : Boolean)
return String_Access;
Prefix_Style : Boolean) return String_Access;
-- Convert a host syntax directory specification (e.g. on a VMS host:
-- "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
-- If Prefix_Style then make it a valid file specification prefix.
@ -176,30 +173,26 @@ package Osint is
-- this simply means the spec has a trailing slash ("/").
function To_Canonical_File_Spec
(Host_File : String)
return String_Access;
(Host_File : String) return String_Access;
-- Convert a host syntax file specification (e.g. on a VMS host:
-- "SYS$DEVICE:[DIR]FILE.EXT;69 to canonical (Unix) syntax (e.g.
-- "/sys$device/dir/file.ext.69").
function To_Canonical_Path_Spec
(Host_Path : String)
return String_Access;
(Host_Path : String) return String_Access;
-- Convert a host syntax Path specification (e.g. on a VMS host:
-- "SYS$DEVICE:[BAR],DISK$USER:[FOO] to canonical (Unix) syntax (e.g.
-- "/sys$device/foo:disk$user/foo").
function To_Host_Dir_Spec
(Canonical_Dir : String;
Prefix_Style : Boolean)
return String_Access;
Prefix_Style : Boolean) return String_Access;
-- Convert a canonical syntax directory specification to host syntax.
-- The Prefix_Style flag is currently ignored but should be set to
-- False.
function To_Host_File_Spec
(Canonical_File : String)
return String_Access;
(Canonical_File : String) return String_Access;
-- Convert a canonical syntax file specification to host syntax.
function Relocate_Path
@ -209,9 +202,8 @@ package Osint is
-- replace the Prefix substring with the root installation directory.
-- By default, try to compute the root installation directory by looking
-- at the executable name as it was typed on the command line and, if
-- needed, use the PATH environment variable.
-- If the above computation fails, return Path.
-- This function assumes that Prefix'First = Path'First
-- needed, use the PATH environment variable. If the above computation
-- fails, return Path. This function assumes Prefix'First = Path'First.
function Shared_Lib (Name : String) return String;
-- Returns the runtime shared library in the form -l<name>-<version> where
@ -244,8 +236,7 @@ package Osint is
procedure Get_Next_Dir_In_Path_Init
(Search_Path : String_Access);
function Get_Next_Dir_In_Path
(Search_Path : String_Access)
return String_Access;
(Search_Path : String_Access) return String_Access;
-- These subprograms are used to parse out the directory names in a
-- search path specified by a Search_Path argument. The procedure
-- initializes an internal pointer to point to the initial directory
@ -292,8 +283,7 @@ package Osint is
function Get_RTS_Search_Dir
(Search_Dir : String;
File_Type : Search_File_Type)
return String_Ptr;
File_Type : Search_File_Type) return String_Ptr;
-- This function retrieves the paths to the search (resp. lib) dirs and
-- return them. The search dir can be absolute or relative. If the search
-- dir contains Include_Search_File (resp. Object_Search_File), then this
@ -382,9 +372,8 @@ package Osint is
-- called Source_File_Data (Cache => True). See below.
function Matching_Full_Source_Name
(N : File_Name_Type;
T : Time_Stamp_Type)
return File_Name_Type;
(N : File_Name_Type;
T : Time_Stamp_Type) return File_Name_Type;
-- Same semantics than Full_Source_Name but will search on the source
-- path until a source file with time stamp matching T is found. If
-- none is found returns No_File.
@ -440,8 +429,7 @@ package Osint is
function Read_Library_Info
(Lib_File : File_Name_Type;
Fatal_Err : Boolean := False)
return Text_Buffer_Ptr;
Fatal_Err : Boolean := False) return Text_Buffer_Ptr;
-- Allocates a Text_Buffer of appropriate length and reads in the entire
-- source of the library information from the library information file
-- whose name is given by the parameter Name.

4
gcc/ada/sem_ch10.adb
View File

@ -1475,8 +1475,12 @@ package body Sem_Ch10 is
end if;
end if;
Set_Is_Immediately_Visible (Par_Unit, False);
Analyze_Subunit_Context;
Re_Install_Parents (Lib_Unit, Par_Unit);
Set_Is_Immediately_Visible (Par_Unit);
-- If the context includes a child unit of the parent of the
-- subunit, the parent will have been removed from visibility,

16
gcc/ada/sem_res.adb
View File

@ -801,6 +801,22 @@ package body Sem_Res is
Require_Entity (N);
end if;
-- If the context expects a value, and the name is a procedure,
-- this is most likely a missing 'Access. Do not try to resolve
-- the parameterless call, error will be caught when the outer
-- call is analyzed.
if Is_Entity_Name (N)
and then Ekind (Entity (N)) = E_Procedure
and then not Is_Overloaded (N)
and then
(Nkind (Parent (N)) = N_Parameter_Association
or else Nkind (Parent (N)) = N_Function_Call
or else Nkind (Parent (N)) = N_Procedure_Call_Statement)
then
return;
end if;
-- Rewrite as call if overloadable entity that is (or could be, in
-- the overloaded case) a function call. If we know for sure that
-- the entity is an enumeration literal, we do not rewrite it.

42
gcc/ada/sem_util.adb
View File

@ -4881,17 +4881,28 @@ package body Sem_Util is
or else Sloc (S) = Standard_Location)
and then Is_Overloadable (S)
then
Error_Msg_Name_1 := Chars (S);
Error_Msg_Sloc := Sloc (S);
Error_Msg_NE
("missing argument for parameter & " &
"in call to % declared #", N, Formal);
if No (Actuals)
and then
(Nkind (Parent (N)) = N_Procedure_Call_Statement
or else
(Nkind (Parent (N)) = N_Function_Call
or else
Nkind (Parent (N)) = N_Parameter_Association))
then
Set_Etype (N, Etype (S));
else
Error_Msg_Name_1 := Chars (S);
Error_Msg_Sloc := Sloc (S);
Error_Msg_NE
("missing argument for parameter & " &
"in call to % declared #", N, Formal);
end if;
elsif Is_Overloadable (S) then
Error_Msg_Name_1 := Chars (S);
-- Point to type derivation that
-- generated the operation.
-- Point to type derivation that generated the
-- operation.
Error_Msg_Sloc := Sloc (Parent (S));
@ -6358,7 +6369,22 @@ package body Sem_Util is
or else
Ekind (Entity (Expr)) = E_Generic_Procedure)
then
Error_Msg_N ("found procedure name instead of function!", Expr);
if Ekind (Expec_Type) = E_Access_Subprogram_Type then
Error_Msg_N
("found procedure name, possibly missing Access attribute!",
Expr);
else
Error_Msg_N ("found procedure name instead of function!", Expr);
end if;
elsif Nkind (Expr) = N_Function_Call
and then Ekind (Expec_Type) = E_Access_Subprogram_Type
and then Etype (Designated_Type (Expec_Type)) = Etype (Expr)
and then No (Parameter_Associations (Expr))
then
Error_Msg_N
("found function name, possibly missing Access attribute!",
Expr);
-- catch common error: a prefix or infix operator which is not
-- directly visible because the type isn't.

2
gcc/ada/snames.ads
View File

@ -751,7 +751,7 @@ package Snames is
-- are added, the first character must be distinct.
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 440;
Name_Fifo_Within_Priorities : constant Name_Id := N + 440;
Name_FIFO_Within_Priorities : constant Name_Id := N + 440;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 440;
-- Names of recognized checks for pragma Suppress

3
gcc/ada/usage.adb
View File

@ -134,9 +134,6 @@ begin
Write_Switch_Char ("c");
Write_Line ("Check syntax and semantics only (no code generation)");
Write_Switch_Char ("C");
Write_Line ("Compress names in external names and debug info tables");
-- Line for -gnatd switch
Write_Switch_Char ("d?");