From 18c0ecbeb82efa35502754b4031214050f0483ce Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 12 Feb 2004 14:28:13 +0100 Subject: [PATCH] [multiple changes] 2004-02-12 Olivier Hainque * 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 * 5zinit.adb: Removed, no longer used. 2004-02-12 Robert Dewar * 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 * 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 * Makefile.in: Clean ups and remove obsolete targets. 2004-02-12 Ed Schonberg * 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 --- gcc/ada/5zinit.adb | 319 --------------------------------------- gcc/ada/ChangeLog | 92 +++++++++++ gcc/ada/Makefile.generic | 80 +++++++--- gcc/ada/Makefile.in | 13 +- gcc/ada/ali.adb | 4 - gcc/ada/atree.adb | 27 ++-- gcc/ada/atree.ads | 9 +- gcc/ada/bindgen.adb | 82 ++++++++++ gcc/ada/bld.adb | 15 +- gcc/ada/decl.c | 4 +- gcc/ada/exp_ch5.adb | 69 +-------- gcc/ada/exp_pakd.adb | 15 +- gcc/ada/exp_util.adb | 7 + gcc/ada/gnatls.adb | 28 ++-- gcc/ada/gprcmd.adb | 23 ++- gcc/ada/init.c | 56 ++++++- gcc/ada/lib-writ.adb | 4 - gcc/ada/lib-writ.ads | 7 +- gcc/ada/osint.ads | 44 ++---- gcc/ada/sem_ch10.adb | 4 + gcc/ada/sem_res.adb | 16 ++ gcc/ada/sem_util.adb | 42 +++++- gcc/ada/snames.ads | 2 +- gcc/ada/usage.adb | 3 - 24 files changed, 446 insertions(+), 519 deletions(-) delete mode 100644 gcc/ada/5zinit.adb diff --git a/gcc/ada/5zinit.adb b/gcc/ada/5zinit.adb deleted file mode 100644 index 15445696f4d..00000000000 --- 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 3f49f1b798d..6243ab2a799 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,95 @@ +2004-02-12 Olivier Hainque + + * 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 + + * 5zinit.adb: Removed, no longer used. + +2004-02-12 Robert Dewar + + * 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 + + * 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 + + * Makefile.in: Clean ups and remove obsolete targets. + +2004-02-12 Ed Schonberg + + * 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 , Nathanael Nerode diff --git a/gcc/ada/Makefile.generic b/gcc/ada/Makefile.generic index 6be62317c07..61d0ff9e839 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 4633768563b..53df983cc7b 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 22466200830..06055bad6a6 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 906b3af8aab..d410a33c108 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 4bb8a66c52e..501c1830fa4 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 f9b6b819b0b..ea9cc28f09f 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 d31ed69f22d..a86f299c6c9 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"); + -- .src_dirs is set by default to the project -- directory. diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 623ee73c898..ca7d78c5f9e 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 3ecb496b08c..0b35cefd6ca 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 f86ab6e8c27..416712712bb 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 56c25f19ad8..69f93610504 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 2f5d3155ca3..3d0854914a6 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 369dae07147..14798fb4f49 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 4e4400f63b7..7db7f1f5d90 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 +#include #include 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 4d0c29778d7..1cafffe9afd 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 e21112cf6b0..c6f185bf2fc 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 <> space <> + -- R <> <> -- 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 a1c37be828e..ec86234b586 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- 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 64fcd743df0..6047a41fe3b 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 aeca86fb6f1..07d8a3198cc 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 687d5a5816d..9ab12a4797b 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 3f4db225bcb..473077b41e1 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 249274f52a7..f6dea3e7a2a 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?");