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?");