aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2004-02-12 14:28:13 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2004-02-12 14:28:13 +0100
commit18c0ecbeb82efa35502754b4031214050f0483ce (patch)
tree3067241056d7811b5be0253db902c31399aabba2 /gcc/ada
parenta980dd9b54d1bdee4a331b307980b75857c3f9f1 (diff)
downloadgcc-18c0ecbeb82efa35502754b4031214050f0483ce.zip
gcc-18c0ecbeb82efa35502754b4031214050f0483ce.tar.gz
gcc-18c0ecbeb82efa35502754b4031214050f0483ce.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/5zinit.adb319
-rw-r--r--gcc/ada/ChangeLog92
-rw-r--r--gcc/ada/Makefile.generic80
-rw-r--r--gcc/ada/Makefile.in13
-rw-r--r--gcc/ada/ali.adb4
-rw-r--r--gcc/ada/atree.adb27
-rw-r--r--gcc/ada/atree.ads9
-rw-r--r--gcc/ada/bindgen.adb82
-rw-r--r--gcc/ada/bld.adb15
-rw-r--r--gcc/ada/decl.c4
-rw-r--r--gcc/ada/exp_ch5.adb69
-rw-r--r--gcc/ada/exp_pakd.adb15
-rw-r--r--gcc/ada/exp_util.adb7
-rw-r--r--gcc/ada/gnatls.adb28
-rw-r--r--gcc/ada/gprcmd.adb23
-rw-r--r--gcc/ada/init.c56
-rw-r--r--gcc/ada/lib-writ.adb4
-rw-r--r--gcc/ada/lib-writ.ads7
-rw-r--r--gcc/ada/osint.ads44
-rw-r--r--gcc/ada/sem_ch10.adb4
-rw-r--r--gcc/ada/sem_res.adb16
-rw-r--r--gcc/ada/sem_util.adb42
-rw-r--r--gcc/ada/snames.ads2
-rw-r--r--gcc/ada/usage.adb3
24 files changed, 446 insertions, 519 deletions
diff --git a/gcc/ada/5zinit.adb b/gcc/ada/5zinit.adb
deleted file mode 100644
index 1544569..0000000
--- a/gcc/ada/5zinit.adb
+++ /dev/null
@@ -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;
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3f49f1b..6243ab2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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>
diff --git a/gcc/ada/Makefile.generic b/gcc/ada/Makefile.generic
index 6be6231..61d0ff9 100644
--- a/gcc/ada/Makefile.generic
+++ b/gcc/ada/Makefile.generic
@@ -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
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index 4633768..53df983 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -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
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 2246620..06055ba 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -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
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 906b3af..d410a33 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -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;
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 4bb8a66..501c183 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -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
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index f9b6b81..ea9cc28 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -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 --
-----------------------
diff --git a/gcc/ada/bld.adb b/gcc/ada/bld.adb
index d31ed69..a86f299 100644
--- a/gcc/ada/bld.adb
+++ b/gcc/ada/bld.adb
@@ -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.
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index 623ee73..ca7d78c 100644
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -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;
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 3ecb496..0b35cef 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -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;
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index f86ab6e..4167127 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -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;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 56c25f1..69f9361 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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)))
diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index 2f5d3155..3d08549 100644
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -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
diff --git a/gcc/ada/gprcmd.adb b/gcc/ada/gprcmd.adb
index 369dae0..14798fb 100644
--- a/gcc/ada/gprcmd.adb
+++ b/gcc/ada/gprcmd.adb
@@ -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
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 4e4400f..7db7f1f 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -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;
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 4d0c297..1cafffe 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -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
diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads
index e21112c..c6f185b 100644
--- a/gcc/ada/lib-writ.ads
+++ b/gcc/ada/lib-writ.ads
@@ -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
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index a1c37be..ec86234 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -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.
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 64fcd74..6047a41 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -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,
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index aeca86f..07d8a31 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 687d5a5..9ab12a4 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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.
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads
index 3f4db22..473077b 100644
--- a/gcc/ada/snames.ads
+++ b/gcc/ada/snames.ads
@@ -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
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 249274f..f6dea3e 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -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?");