diff options
71 files changed, 1168 insertions, 203 deletions
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index 4b9e58c2024..811f29c70f1 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -457,8 +457,6 @@ endif ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -485,8 +483,6 @@ endif ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -524,8 +520,6 @@ endif ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -563,8 +557,6 @@ endif ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -593,8 +585,6 @@ endif ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ i-vxwork.ads<i-vxwork-x86.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -634,8 +624,6 @@ endif ifeq ($(strip $(filter-out xscale% coff wrs vx%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -664,8 +652,6 @@ endif ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ - a-sytaco.ads<a-sytaco-vxworks.ads \ - a-sytaco.adb<a-sytaco-vxworks.adb \ a-intnam.ads<a-intnam-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \ s-inmaop.adb<s-inmaop-posix.adb \ @@ -1251,11 +1237,13 @@ endif ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),) TOOLS_TARGET_PAIRS= \ mlib-tgt.adb<mlib-tgt-vms-ia64.adb \ - symbols.adb<symbols-vms-ia64.adb + symbols.adb<symbols-vms.adb \ + symbols-processing.adb<symbols-processing-vms-ia64.adb else TOOLS_TARGET_PAIRS= \ mlib-tgt.adb<mlib-tgt-vms-alpha.adb \ - symbols.adb<symbols-vms-alpha.adb + symbols.adb<symbols-vms.adb \ + symbols-processing.adb<symbols-processing-vms-alpha.adb endif GNATLIB_SHARED=gnatlib-shared-vms @@ -1507,12 +1495,12 @@ endif # subdirectory and copied. LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \ errno.c exit.c cal.c ctrl_c.c \ - raise.h raise.c sysdep.c aux-io.c init.c seh_init.c \ + raise.h raise.c sysdep.c aux-io.c init.c initialize.c seh_init.c \ final.c tracebak.c tb-alvms.c tb-alvxw.c expect.c mkdir.c socket.c gsocket.h \ $(EXTRA_LIBGNAT_SRCS) LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \ - raise.o sysdep.o aux-io.o init.o seh_init.o cal.o final.o \ + raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o final.o \ tracebak.o expect.o mkdir.o socket.o $(EXTRA_LIBGNAT_OBJS) # NOTE ??? - when the -I option for compiling Ada code is made to work, @@ -2029,26 +2017,30 @@ socket.o : socket.c gsocket.h sysdep.o : sysdep.c gen-soccon: gen-soccon.c gsocket.h - $(CC) $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \ - $(ALL_CPPFLAGS) $(INCLUDES) -DTARGET=\"$(target_alias)\" \ + $(CC) $(ALL_CFLAGS) $(ADA_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + -UIN_GCC -DTARGET=\"$(target_alias)\" \ $< $(OUTPUT_OPTION) cio.o : cio.c - $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \ + $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) init.o : init.c ada.h types.h raise.h - $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \ + $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +initialize.o : initialize.c + $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) # No optimization to compile this file as optimizations (-O1 or above) breaks # the SEH handling on Windows. The reasons are not clear. seh_init.o : seh_init.c raise.h - $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) -O0 \ + $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) -O0 \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) raise.o : raise.c raise.h - $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \ + $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) # Need to keep the frame pointer in this file to pop the stack properly on diff --git a/gcc/ada/a-direct.ads b/gcc/ada/a-direct.ads index 5047cc76bd5..d16e2f68826 100644 --- a/gcc/ada/a-direct.ads +++ b/gcc/ada/a-direct.ads @@ -178,8 +178,9 @@ package Ada.Directories is -- and form given by Form, or copying of the file with the name given by -- Source_Name (in the absence of Name_Error). - - -- File and directory name operations: + ---------------------------------------- + -- File and directory name operations -- + ---------------------------------------- function Full_Name (Name : String) return String; -- Returns the full name corresponding to the file name specified by Name. @@ -231,15 +232,16 @@ package Ada.Directories is -- Name is not a possible simple name (if Extension is null) or base name -- (if Extension is non-null). - - -- File and directory queries: + -------------------------------- + -- File and directory queries -- + -------------------------------- type File_Kind is (Directory, Ordinary_File, Special_File); -- The type File_Kind represents the kind of file represented by an -- external file or directory. type File_Size is range 0 .. Long_Long_Integer'Last; - -- The type File_Size represents the size of an external file. + -- The type File_Size represents the size of an external file function Exists (Name : String) return Boolean; -- Returns True if external file represented by Name exists, and False @@ -403,19 +405,16 @@ private -- Search_Type need to be a controlled type, because it includes component -- of type Dir_Type (in GNAT.Directory_Operations) that need to be closed - -- (if opened) during finalization. - -- The component need to be an access value, because Search_Data is not - -- fully defined in the spec. + -- (if opened) during finalization. The component need to be an access + -- value, because Search_Data is not fully defined in the spec. type Search_Type is new Ada.Finalization.Controlled with record Value : Search_Ptr; end record; procedure Finalize (Search : in out Search_Type); - -- Close the directory, if opened, and deallocate Value. + -- Close the directory, if opened, and deallocate Value procedure End_Search (Search : in out Search_Type) renames Finalize; end Ada.Directories; - - diff --git a/gcc/ada/a-direio.ads b/gcc/ada/a-direio.ads index 8526d298997..6106922adc4 100644 --- a/gcc/ada/a-direio.ads +++ b/gcc/ada/a-direio.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -35,7 +35,6 @@ -- -- ------------------------------------------------------------------------------ - with Ada.IO_Exceptions; with System.Direct_IO; with Interfaces.C_Streams; diff --git a/gcc/ada/a-exctra.ads b/gcc/ada/a-exctra.ads index 97a110f2cf2..f8eae603864 100644 --- a/gcc/ada/a-exctra.ads +++ b/gcc/ada/a-exctra.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -35,7 +35,7 @@ -- -- ------------------------------------------------------------------------------ --- This package is part of the support for tracebacks on exceptions. +-- This package is part of the support for tracebacks on exceptions with System.Traceback_Entries; @@ -47,7 +47,7 @@ package Ada.Exceptions.Traceback is -- Code location in executing program type Tracebacks_Array is array (Positive range <>) of TBE.Traceback_Entry; - -- A traceback array is an array of traceback entries. + -- A traceback array is an array of traceback entries function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array; -- This function extracts the traceback information from an exception diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb index 63085f65a11..c7949acdba2 100644 --- a/gcc/ada/a-exexda.adb +++ b/gcc/ada/a-exexda.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -152,7 +152,6 @@ package body Exception_Data is Info : in out String; Ptr : in out Natural); - -- The "functional" interface to the exception information not involving -- a traceback decorator uses preallocated intermediate buffers to avoid -- the use of secondary stack. Preallocation requires preliminary length diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb index 835c2cb5268..7fa41e08e07 100644 --- a/gcc/ada/a-exextr.adb +++ b/gcc/ada/a-exextr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -190,7 +190,6 @@ package body Exception_Traces is Last_Chance_Handler (Excep.all); end Unhandled_Exception_Terminate; - ------------------------------------ -- Handling GNAT.Exception_Traces -- ------------------------------------ diff --git a/gcc/ada/a-slcain.adb b/gcc/ada/a-slcain.adb index 6d395afaab8..a986420786d 100644 --- a/gcc/ada/a-slcain.adb +++ b/gcc/ada/a-slcain.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -76,5 +76,3 @@ begin RI := RI + 1; end loop; end Ada.Strings.Less_Case_Insensitive; - - diff --git a/gcc/ada/a-stream.ads b/gcc/ada/a-stream.ads index 8f0732632f1..53300dc8d96 100644 --- a/gcc/ada/a-stream.ads +++ b/gcc/ada/a-stream.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -35,7 +35,6 @@ -- -- ------------------------------------------------------------------------------ - package Ada.Streams is pragma Pure (Streams); diff --git a/gcc/ada/a-stzhas.ads b/gcc/ada/a-stzhas.ads index f2059288d20..8a8436c33df 100644 --- a/gcc/ada/a-stzhas.ads +++ b/gcc/ada/a-stzhas.ads @@ -19,6 +19,3 @@ function Ada.Strings.Wide_Wide_Hash (Key : Wide_Wide_String) return Containers.Hash_Type; pragma Pure (Ada.Strings.Wide_Wide_Hash); - - - diff --git a/gcc/ada/a-swmwco.ads b/gcc/ada/a-swmwco.ads index 200d90099a3..ffb50ca7d16 100644 --- a/gcc/ada/a-swmwco.ads +++ b/gcc/ada/a-swmwco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -182,7 +182,6 @@ private (AF.Controlled with Character_Ranges'Unrestricted_Access); - Lower_Case_Mapping : aliased constant Wide_Character_Mapping_Values := (Length => 56, diff --git a/gcc/ada/a-szmzco.ads b/gcc/ada/a-szmzco.ads index d82e2ba8e58..77450debd78 100644 --- a/gcc/ada/a-szmzco.ads +++ b/gcc/ada/a-szmzco.ads @@ -182,7 +182,6 @@ private (AF.Controlled with Character_Ranges'Unrestricted_Access); - Lower_Case_Mapping : aliased constant Wide_Wide_Character_Mapping_Values := (Length => 56, diff --git a/gcc/ada/a-tiinau.adb b/gcc/ada/a-tiinau.adb index 03977710a50..8dede97277a 100644 --- a/gcc/ada/a-tiinau.adb +++ b/gcc/ada/a-tiinau.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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,7 +52,7 @@ package body Ada.Text_IO.Integer_Aux is (File : in File_Type; Buf : out String; Ptr : in out Natural); - -- This is an auxiliary routine that is used to load an possibly signed + -- This is an auxiliary routine that is used to load a possibly signed -- integer literal value from the input file into Buf, starting at Ptr + 1. -- On return, Ptr is set to the last character stored. diff --git a/gcc/ada/a-wichun.adb b/gcc/ada/a-wichun.adb new file mode 100755 index 00000000000..96a0ea1a79c --- /dev/null +++ b/gcc/ada/a-wichun.adb @@ -0,0 +1,167 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . W I D E _ C H A R A C T E R T S . U N I C O D E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2005 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package body Ada.Wide_Characters.Unicode is + + package G renames GNAT.UTF_32; + + ------------------ + -- Get_Category -- + ------------------ + + function Get_Category (U : Wide_Character) return Category is + begin + return Category (G.Get_Category (Wide_Character'Pos (U))); + end Get_Category; + + -------------- + -- Is_Digit -- + -------------- + + function Is_Digit (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Digit (Wide_Character'Pos (U)); + end Is_Digit; + + function Is_Digit (C : Category) return Boolean is + begin + return G.Is_UTF_32_Digit (G.Category (C)); + end Is_Digit; + + --------------- + -- Is_Letter -- + --------------- + + function Is_Letter (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Letter (Wide_Character'Pos (U)); + end Is_Letter; + + function Is_Letter (C : Category) return Boolean is + begin + return G.Is_UTF_32_Letter (G.Category (C)); + end Is_Letter; + + ------------------------ + -- Is_Line_Terminator -- + ------------------------ + + function Is_Line_Terminator (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Line_Terminator (Wide_Character'Pos (U)); + end Is_Line_Terminator; + + ------------- + -- Is_Mark -- + ------------- + + function Is_Mark (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Mark (Wide_Character'Pos (U)); + end Is_Mark; + + function Is_Mark (C : Category) return Boolean is + begin + return G.Is_UTF_32_Mark (G.Category (C)); + end Is_Mark; + + -------------------- + -- Is_Non_Graphic -- + -------------------- + + function Is_Non_Graphic (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Non_Graphic (Wide_Character'Pos (U)); + end Is_Non_Graphic; + + function Is_Non_Graphic (C : Category) return Boolean is + begin + return G.Is_UTF_32_Non_Graphic (G.Category (C)); + end Is_Non_Graphic; + + -------------- + -- Is_Other -- + -------------- + + function Is_Other (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Other (Wide_Character'Pos (U)); + end Is_Other; + + function Is_Other (C : Category) return Boolean is + begin + return G.Is_UTF_32_Other (G.Category (C)); + end Is_Other; + + -------------------- + -- Is_Punctuation -- + -------------------- + + function Is_Punctuation (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Punctuation (Wide_Character'Pos (U)); + end Is_Punctuation; + + function Is_Punctuation (C : Category) return Boolean is + begin + return G.Is_UTF_32_Punctuation (G.Category (C)); + end Is_Punctuation; + + -------------- + -- Is_Space -- + -------------- + + function Is_Space (U : Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Space (Wide_Character'Pos (U)); + end Is_Space; + + function Is_Space (C : Category) return Boolean is + begin + return G.Is_UTF_32_Space (G.Category (C)); + end Is_Space; + + ------------------- + -- To_Upper_Case -- + ------------------- + + function To_Upper_Case + (U : Wide_Character) return Wide_Character + is + begin + return + Wide_Character'Val + (G.UTF_32_To_Upper_Case (Wide_Character'Pos (U))); + end To_Upper_Case; + +end Ada.Wide_Characters.Unicode; diff --git a/gcc/ada/a-wichun.ads b/gcc/ada/a-wichun.ads new file mode 100755 index 00000000000..7bfe04530f2 --- /dev/null +++ b/gcc/ada/a-wichun.ads @@ -0,0 +1,190 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . W I D E _ C H A R A C T E R S . U N I C O D E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2005 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Unicode categorization routines for Wide_Character. Note that this +-- package is strictly speaking Ada 2005 (since it is a child of an +-- Ada 2005 unit), but we make it available in Ada 95 mode, since it +-- only deals with wide characters. + +with GNAT.UTF_32; + +package Ada.Wide_Characters.Unicode is + + -- The following type defines the categories from the unicode definitions. + -- The one addition we make is Fe, which represents the characters FFFE + -- and FFFF in any of the planes. + + type Category is new GNAT.UTF_32.Category; + -- Cc Other, Control + -- Cf Other, Format + -- Cn Other, Not Assigned + -- Co Other, Private Use + -- Cs Other, Surrogate + -- Ll Letter, Lowercase + -- Lm Letter, Modifier + -- Lo Letter, Other + -- Lt Letter, Titlecase + -- Lu Letter, Uppercase + -- Mc Mark, Spacing Combining + -- Me Mark, Enclosing + -- Mn Mark, Nonspacing + -- Nd Number, Decimal Digit + -- Nl Number, Letter + -- No Number, Other + -- Pc Punctuation, Connector + -- Pd Punctuation, Dash + -- Pe Punctuation, Close + -- Pf Punctuation, Final quote + -- Pi Punctuation, Initial quote + -- Po Punctuation, Other + -- Ps Punctuation, Open + -- Sc Symbol, Currency + -- Sk Symbol, Modifier + -- Sm Symbol, Math + -- So Symbol, Other + -- Zl Separator, Line + -- Zp Separator, Paragraph + -- Zs Separator, Space + -- Fe relative position FFFE/FFFF in plane + + function Get_Category (U : Wide_Character) return Category; + pragma Inline (Get_Category); + -- Given a Wide_Character, returns corresponding Category, or Cn if the + -- code does not have an assigned unicode category. + + -- The following functions perform category tests corresponding to lexical + -- classes defined in the Ada standard. There are two interfaces for each + -- function. The second takes a Category (e.g. returned by Get_Category). + -- The first takes a Wide_Character. The form taking the Wide_Character is + -- typically more efficient than calling Get_Category, but if several + -- different tests are to be performed on the same code, it is more + -- efficient to use Get_Category to get the category, then test the + -- resulting category. + + function Is_Letter (U : Wide_Character) return Boolean; + function Is_Letter (C : Category) return Boolean; + pragma Inline (Is_Letter); + -- Returns true iff U is a letter that can be used to start an identifier, + -- or if C is one of the corresponding categories, which are the following: + -- Letter, Uppercase (Lu) + -- Letter, Lowercase (Ll) + -- Letter, Titlecase (Lt) + -- Letter, Modifier (Lm) + -- Letter, Other (Lo) + -- Number, Letter (Nl) + + function Is_Digit (U : Wide_Character) return Boolean; + function Is_Digit (C : Category) return Boolean; + pragma Inline (Is_Digit); + -- Returns true iff U is a digit that can be used to extend an identifer, + -- or if C is one of the corresponding categories, which are the following: + -- Number, Decimal_Digit (Nd) + + function Is_Line_Terminator (U : Wide_Character) return Boolean; + pragma Inline (Is_Line_Terminator); + -- Returns true iff U is an allowed line terminator for source programs, + -- if U is in the category Zp (Separator, Paragaph), or Zs (Separator, + -- Line), or if U is a conventional line terminator (CR, LF, VT, FF). + -- There is no category version for this function, since the set of + -- characters does not correspond to a set of Unicode categories. + + function Is_Mark (U : Wide_Character) return Boolean; + function Is_Mark (C : Category) return Boolean; + pragma Inline (Is_Mark); + -- Returns true iff U is a mark character which can be used to extend an + -- identifier, or if C is one of the corresponding categories, which are + -- the following: + -- Mark, Non-Spacing (Mn) + -- Mark, Spacing Combining (Mc) + + function Is_Other (U : Wide_Character) return Boolean; + function Is_Other (C : Category) return Boolean; + pragma Inline (Is_Other); + -- Returns true iff U is an other format character, which means that it + -- can be used to extend an identifier, but is ignored for the purposes of + -- matching of identiers, or if C is one of the corresponding categories, + -- which are the following: + -- Other, Format (Cf) + + function Is_Punctuation (U : Wide_Character) return Boolean; + function Is_Punctuation (C : Category) return Boolean; + pragma Inline (Is_Punctuation); + -- Returns true iff U is a punctuation character that can be used to + -- separate pices of an identifier, or if C is one of the corresponding + -- categories, which are the following: + -- Punctuation, Connector (Pc) + + function Is_Space (U : Wide_Character) return Boolean; + function Is_Space (C : Category) return Boolean; + pragma Inline (Is_Space); + -- Returns true iff U is considered a space to be ignored, or if C is one + -- of the corresponding categories, which are the following: + -- Separator, Space (Zs) + + function Is_Non_Graphic (U : Wide_Character) return Boolean; + function Is_Non_Graphic (C : Category) return Boolean; + pragma Inline (Is_Non_Graphic); + -- Returns true iff U is considered to be a non-graphic character, or if C + -- is one of the corresponding categories, which are the following: + -- Other, Control (Cc) + -- Other, Private Use (Co) + -- Other, Surrogate (Cs) + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + -- FFFE or FFFF positions in any plane (Fe) + -- + -- Note that the Ada category format effector is subsumed by the above + -- list of Unicode categories. + -- + -- Note that Other, Unassiged (Cn) is quite deliberately not included + -- in the list of categories above. This means that should any of these + -- code positions be defined in future with graphic characters they will + -- be allowed without a need to change implementations or the standard. + -- + -- Note that Other, Format (Cf) is also quite deliberately not included + -- in the list of categories above. This means that these characters can + -- be included in character and string literals. + + -- The following function is used to fold to upper case, as required by + -- the Ada 2005 standard rules for identifier case folding. Two + -- identifiers are equivalent if they are identical after folding all + -- letters to upper case using this routine. + + function To_Upper_Case (U : Wide_Character) return Wide_Character; + pragma Inline (To_Upper_Case); + -- If U represents a lower case letter, returns the corresponding upper + -- case letter, otherwise U is returned unchanged. The folding is locale + -- independent as defined by documents referenced in the note in section + -- 1 of ISO/IEC 10646:2003 + +end Ada.Wide_Characters.Unicode; diff --git a/gcc/ada/a-widcha.ads b/gcc/ada/a-widcha.ads new file mode 100755 index 00000000000..d912e3d39db --- /dev/null +++ b/gcc/ada/a-widcha.ads @@ -0,0 +1,21 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . W I D E _ C H A R A C T E R S -- +-- -- +-- S p e c -- +-- -- +-- This specification is adapted from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +-- Note: strictly this is an Ada 2005 package, but we make it freely +-- available in Ada 95 mode, since it deals only with wide characters. + +package Ada.Wide_Characters is +pragma Pure (Wide_Characters); +end Ada.Wide_Characters; diff --git a/gcc/ada/a-zchara.ads b/gcc/ada/a-zchara.ads new file mode 100755 index 00000000000..916a9c0fe24 --- /dev/null +++ b/gcc/ada/a-zchara.ads @@ -0,0 +1,18 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . W I D E _ W I D E _ C H A R A C T E R S -- +-- -- +-- S p e c -- +-- -- +-- This specification is adapted from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +package Ada.Wide_Wide_Characters is +pragma Pure (Wide_Wide_Characters); +end Ada.Wide_Wide_Characters; diff --git a/gcc/ada/a-zchuni.adb b/gcc/ada/a-zchuni.adb new file mode 100755 index 00000000000..827a98fdc07 --- /dev/null +++ b/gcc/ada/a-zchuni.adb @@ -0,0 +1,167 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . W I D E _ W I D E _ C H A R A C T E R T S . U N I C O D E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2005 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package body Ada.Wide_Wide_Characters.Unicode is + + package G renames GNAT.UTF_32; + + ------------------ + -- Get_Category -- + ------------------ + + function Get_Category (U : Wide_Wide_Character) return Category is + begin + return Category (G.Get_Category (Wide_Wide_Character'Pos (U))); + end Get_Category; + + -------------- + -- Is_Digit -- + -------------- + + function Is_Digit (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Digit (Wide_Wide_Character'Pos (U)); + end Is_Digit; + + function Is_Digit (C : Category) return Boolean is + begin + return G.Is_UTF_32_Digit (G.Category (C)); + end Is_Digit; + + --------------- + -- Is_Letter -- + --------------- + + function Is_Letter (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Letter (Wide_Wide_Character'Pos (U)); + end Is_Letter; + + function Is_Letter (C : Category) return Boolean is + begin + return G.Is_UTF_32_Letter (G.Category (C)); + end Is_Letter; + + ------------------------ + -- Is_Line_Terminator -- + ------------------------ + + function Is_Line_Terminator (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Line_Terminator (Wide_Wide_Character'Pos (U)); + end Is_Line_Terminator; + + ------------- + -- Is_Mark -- + ------------- + + function Is_Mark (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Mark (Wide_Wide_Character'Pos (U)); + end Is_Mark; + + function Is_Mark (C : Category) return Boolean is + begin + return G.Is_UTF_32_Mark (G.Category (C)); + end Is_Mark; + + -------------------- + -- Is_Non_Graphic -- + -------------------- + + function Is_Non_Graphic (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Non_Graphic (Wide_Wide_Character'Pos (U)); + end Is_Non_Graphic; + + function Is_Non_Graphic (C : Category) return Boolean is + begin + return G.Is_UTF_32_Non_Graphic (G.Category (C)); + end Is_Non_Graphic; + + -------------- + -- Is_Other -- + -------------- + + function Is_Other (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Other (Wide_Wide_Character'Pos (U)); + end Is_Other; + + function Is_Other (C : Category) return Boolean is + begin + return G.Is_UTF_32_Other (G.Category (C)); + end Is_Other; + + -------------------- + -- Is_Punctuation -- + -------------------- + + function Is_Punctuation (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Punctuation (Wide_Wide_Character'Pos (U)); + end Is_Punctuation; + + function Is_Punctuation (C : Category) return Boolean is + begin + return G.Is_UTF_32_Punctuation (G.Category (C)); + end Is_Punctuation; + + -------------- + -- Is_Space -- + -------------- + + function Is_Space (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Space (Wide_Wide_Character'Pos (U)); + end Is_Space; + + function Is_Space (C : Category) return Boolean is + begin + return G.Is_UTF_32_Space (G.Category (C)); + end Is_Space; + + ------------------- + -- To_Upper_Case -- + ------------------- + + function To_Upper_Case + (U : Wide_Wide_Character) return Wide_Wide_Character + is + begin + return + Wide_Wide_Character'Val + (G.UTF_32_To_Upper_Case (Wide_Wide_Character'Pos (U))); + end To_Upper_Case; + +end Ada.Wide_Wide_Characters.Unicode; diff --git a/gcc/ada/a-zchuni.ads b/gcc/ada/a-zchuni.ads new file mode 100755 index 00000000000..a7bf566ad3d --- /dev/null +++ b/gcc/ada/a-zchuni.ads @@ -0,0 +1,188 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . W I D E _ W I D E _ C H A R A C T E R T S . U N I C O D E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2005 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Unicode categorization routines for Wide_Wide_Character + +with GNAT.UTF_32; + +package Ada.Wide_Wide_Characters.Unicode is + + -- The following type defines the categories from the unicode definitions. + -- The one addition we make is Fe, which represents the characters FFFE + -- and FFFF in any of the planes. + + type Category is new GNAT.UTF_32.Category; + -- Cc Other, Control + -- Cf Other, Format + -- Cn Other, Not Assigned + -- Co Other, Private Use + -- Cs Other, Surrogate + -- Ll Letter, Lowercase + -- Lm Letter, Modifier + -- Lo Letter, Other + -- Lt Letter, Titlecase + -- Lu Letter, Uppercase + -- Mc Mark, Spacing Combining + -- Me Mark, Enclosing + -- Mn Mark, Nonspacing + -- Nd Number, Decimal Digit + -- Nl Number, Letter + -- No Number, Other + -- Pc Punctuation, Connector + -- Pd Punctuation, Dash + -- Pe Punctuation, Close + -- Pf Punctuation, Final quote + -- Pi Punctuation, Initial quote + -- Po Punctuation, Other + -- Ps Punctuation, Open + -- Sc Symbol, Currency + -- Sk Symbol, Modifier + -- Sm Symbol, Math + -- So Symbol, Other + -- Zl Separator, Line + -- Zp Separator, Paragraph + -- Zs Separator, Space + -- Fe relative position FFFE/FFFF in plane + + function Get_Category (U : Wide_Wide_Character) return Category; + pragma Inline (Get_Category); + -- Given a Wide_Wide_Character, returns corresponding Category, or Cn if + -- the code does not have an assigned unicode category. + + -- The following functions perform category tests corresponding to lexical + -- classes defined in the Ada standard. There are two interfaces for each + -- function. The second takes a Category (e.g. returned by Get_Category). + -- The first takes a Wide_Wide_Character. The form taking the + -- Wide_Wide_Character is typically more efficient than calling + -- Get_Category, but if several different tests are to be performed on the + -- same code, it is more efficient to use Get_Category to get the category, + -- then test the resulting category. + + function Is_Letter (U : Wide_Wide_Character) return Boolean; + function Is_Letter (C : Category) return Boolean; + pragma Inline (Is_Letter); + -- Returns true iff U is a letter that can be used to start an identifier, + -- or if C is one of the corresponding categories, which are the following: + -- Letter, Uppercase (Lu) + -- Letter, Lowercase (Ll) + -- Letter, Titlecase (Lt) + -- Letter, Modifier (Lm) + -- Letter, Other (Lo) + -- Number, Letter (Nl) + + function Is_Digit (U : Wide_Wide_Character) return Boolean; + function Is_Digit (C : Category) return Boolean; + pragma Inline (Is_Digit); + -- Returns true iff U is a digit that can be used to extend an identifer, + -- or if C is one of the corresponding categories, which are the following: + -- Number, Decimal_Digit (Nd) + + function Is_Line_Terminator (U : Wide_Wide_Character) return Boolean; + pragma Inline (Is_Line_Terminator); + -- Returns true iff U is an allowed line terminator for source programs, + -- if U is in the category Zp (Separator, Paragaph), or Zs (Separator, + -- Line), or if U is a conventional line terminator (CR, LF, VT, FF). + -- There is no category version for this function, since the set of + -- characters does not correspond to a set of Unicode categories. + + function Is_Mark (U : Wide_Wide_Character) return Boolean; + function Is_Mark (C : Category) return Boolean; + pragma Inline (Is_Mark); + -- Returns true iff U is a mark character which can be used to extend an + -- identifier, or if C is one of the corresponding categories, which are + -- the following: + -- Mark, Non-Spacing (Mn) + -- Mark, Spacing Combining (Mc) + + function Is_Other (U : Wide_Wide_Character) return Boolean; + function Is_Other (C : Category) return Boolean; + pragma Inline (Is_Other); + -- Returns true iff U is an other format character, which means that it + -- can be used to extend an identifier, but is ignored for the purposes of + -- matching of identiers, or if C is one of the corresponding categories, + -- which are the following: + -- Other, Format (Cf) + + function Is_Punctuation (U : Wide_Wide_Character) return Boolean; + function Is_Punctuation (C : Category) return Boolean; + pragma Inline (Is_Punctuation); + -- Returns true iff U is a punctuation character that can be used to + -- separate pices of an identifier, or if C is one of the corresponding + -- categories, which are the following: + -- Punctuation, Connector (Pc) + + function Is_Space (U : Wide_Wide_Character) return Boolean; + function Is_Space (C : Category) return Boolean; + pragma Inline (Is_Space); + -- Returns true iff U is considered a space to be ignored, or if C is one + -- of the corresponding categories, which are the following: + -- Separator, Space (Zs) + + function Is_Non_Graphic (U : Wide_Wide_Character) return Boolean; + function Is_Non_Graphic (C : Category) return Boolean; + pragma Inline (Is_Non_Graphic); + -- Returns true iff U is considered to be a non-graphic character, or if C + -- is one of the corresponding categories, which are the following: + -- Other, Control (Cc) + -- Other, Private Use (Co) + -- Other, Surrogate (Cs) + -- Separator, Line (Zl) + -- Separator, Paragraph (Zp) + -- FFFE or FFFF positions in any plane (Fe) + -- + -- Note that the Ada category format effector is subsumed by the above + -- list of Unicode categories. + -- + -- Note that Other, Unassiged (Cn) is quite deliberately not included + -- in the list of categories above. This means that should any of these + -- code positions be defined in future with graphic characters they will + -- be allowed without a need to change implementations or the standard. + -- + -- Note that Other, Format (Cf) is also quite deliberately not included + -- in the list of categories above. This means that these characters can + -- be included in character and string literals. + + -- The following function is used to fold to upper case, as required by + -- the Ada 2005 standard rules for identifier case folding. Two + -- identifiers are equivalent if they are identical after folding all + -- letters to upper case using this routine. + + function To_Upper_Case + (U : Wide_Wide_Character) return Wide_Wide_Character; + pragma Inline (To_Upper_Case); + -- If U represents a lower case letter, returns the corresponding upper + -- case letter, otherwise U is returned unchanged. The folding is locale + -- independent as defined by documents referenced in the note in section + -- 1 of ISO/IEC 10646:2003 + +end Ada.Wide_Wide_Characters.Unicode; diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 3988800a4f2..309948aa09a 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -294,7 +294,6 @@ package body Comperr is End_Line; end if; - Write_Str ("| Use a subject line meaningful to you" & " and us to track the bug."); diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 06d8e7c0c00..3a5381448c2 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -730,7 +730,6 @@ package body Exp_Ch11 is end; end if; - -- If an exception occurrence is present, then we must declare it -- and initialize it from the value stored in the TSD @@ -1175,7 +1174,6 @@ package body Exp_Ch11 is Name_Buffer (Name_Len) := ASCII.NUL; end if; - if Opt.Exception_Locations_Suppressed then Name_Len := 0; end if; diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index 6898cbea354..c2b129785e9 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -492,5 +492,4 @@ package body Exp_Smem is end if; end On_Lhs_Of_Assignment; - end Exp_Smem; diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 0c7ec893ce2..6b001f26785 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -297,7 +297,6 @@ package body Fmap is return; end if; - Name_Len := Last - First + 1; Name_Buffer (1 .. Name_Len) := SP (First .. Last); Uname := Find_Name; diff --git a/gcc/ada/g-boubuf.adb b/gcc/ada/g-boubuf.adb index 5b6a9a830c5..fd707073716 100644 --- a/gcc/ada/g-boubuf.adb +++ b/gcc/ada/g-boubuf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2003-2005, AdaCore -- -- -- -- 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- -- @@ -89,5 +89,4 @@ package body GNAT.Bounded_Buffers is end Bounded_Buffer; - end GNAT.Bounded_Buffers; diff --git a/gcc/ada/g-calend.adb b/gcc/ada/g-calend.adb index 18c74ace13b..7f0bda2bced 100644 --- a/gcc/ada/g-calend.adb +++ b/gcc/ada/g-calend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2001 Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -253,7 +253,6 @@ package body GNAT.Calendar is sec : aliased C.long; usec : aliased C.long; - begin timeval_to_duration (T, sec'Access, usec'Access); return Duration (sec) + Duration (usec) / Micro; diff --git a/gcc/ada/g-debpoo.ads b/gcc/ada/g-debpoo.ads index 1ac0e56050a..b21842c4c83 100644 --- a/gcc/ada/g-debpoo.ads +++ b/gcc/ada/g-debpoo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -85,7 +85,6 @@ -- This allows faster checks, and limits the performance impact of using -- this pool. - with System; use System; with System.Storage_Elements; use System.Storage_Elements; with System.Checked_Pools; diff --git a/gcc/ada/g-moreex.ads b/gcc/ada/g-moreex.ads index 21983ea1dc0..21f83c34bb4 100644 --- a/gcc/ada/g-moreex.ads +++ b/gcc/ada/g-moreex.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000 Ada Core Technologies, Inc. -- +-- Copyright (C) 2000-2005, AdaCore -- -- -- -- 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- -- @@ -45,9 +45,9 @@ package GNAT.Most_Recent_Exception is function Occurrence return Ada.Exceptions.Exception_Occurrence; - -- Returns the Exception_Occurrence for the most recently raised - -- exception in the current task. If no exception has been raised - -- in the current task prior to the call, returns Null_Occurrence. + -- Returns the Exception_Occurrence for the most recently raised exception + -- in the current task. If no exception has been raised in the current task + -- prior to the call, returns Null_Occurrence. function Occurrence_Access return Ada.Exceptions.Exception_Occurrence_Access; @@ -73,5 +73,4 @@ package GNAT.Most_Recent_Exception is -- -- not about the Constraint_Error exception being handled -- -- by the current handler code. - end GNAT.Most_Recent_Exception; diff --git a/gcc/ada/g-regpat.ads b/gcc/ada/g-regpat.ads index 82bab7f5bda..0b8c38e55df 100644 --- a/gcc/ada/g-regpat.ads +++ b/gcc/ada/g-regpat.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1986 by University of Toronto. -- --- Copyright (C) 1996-2004 Ada Core Technologies, Inc. -- +-- Copyright (C) 1996-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -524,7 +524,6 @@ pragma Preelaborate (Regpat); -- Expression_Error is raised if the given expression is not a legal -- regular expression. - procedure Match (Expression : String; Data : String; diff --git a/gcc/ada/g-soccon-vms.adb b/gcc/ada/g-soccon-vms.adb index ebd394c54a3..42df2a677a3 100644 --- a/gcc/ada/g-soccon-vms.adb +++ b/gcc/ada/g-soccon-vms.adb @@ -4,9 +4,9 @@ -- -- -- G N A T . S O C K E T S . C O N S T A N T S -- -- -- --- S p e c -- +-- B o d y -- -- -- --- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005 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- -- diff --git a/gcc/ada/g-soliop-mingw.ads b/gcc/ada/g-soliop-mingw.ads index e930da934d5..710d3c18e96 100644 --- a/gcc/ada/g-soliop-mingw.ads +++ b/gcc/ada/g-soliop-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,7 +36,6 @@ -- This is the Windows/NT version of this package - package GNAT.Sockets.Linker_Options is private pragma Linker_Options ("-lwsock32"); diff --git a/gcc/ada/gen-soccon.c b/gcc/ada/gen-soccon.c index de63816cc09..04dfccf8d5d 100644 --- a/gcc/ada/gen-soccon.c +++ b/gcc/ada/gen-soccon.c @@ -4,7 +4,7 @@ ** ** ** G E N - S O C C O N ** ** ** -** Copyright (C) 2004 Free Software Foundation, Inc. ** +** Copyright (C) 2004-2005 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- ** @@ -27,11 +27,16 @@ #include <stdio.h> #include <string.h> -#include "socket.h" +#include "gsocket.h" + +#ifdef __MINGW32__ +#include <winsock2.h> +#else #include <netinet/in.h> #include <netinet/tcp.h> -#include <sys/filio.h> +#include <sys/ioctl.h> #include <netdb.h> +#endif struct line { char *text; @@ -48,8 +53,8 @@ struct line *first = NULL, *last = NULL; #define _NL TXT("") /* Empty line */ -#define itoad(n) itoa ("%d", n) -#define itoax(n) itoa ("16#%08x#", n) +#define itoad(n) f_itoa ("%d", n) +#define itoax(n) f_itoa ("16#%08x#", n) #define CND(name,comment) add_line(#name, itoad (name), comment); /* Constant (decimal) */ @@ -63,12 +68,13 @@ struct line *first = NULL, *last = NULL; void output (void); /* Generate output spec */ -char *itoa (char *, int); +char *f_itoa (char *, int); /* int to string */ void add_line (char *, char*, char*); -void main (void) { +int +main (void) { TXT("------------------------------------------------------------------------------") TXT("-- --") @@ -78,7 +84,7 @@ TXT("-- G N A T . S O C K E T S . C O N S T A N T S TXT("-- --") TXT("-- S p e c --") TXT("-- --") -TXT("-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --") +TXT("-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --") TXT("-- --") TXT("-- GNAT is free software; you can redistribute it and/or modify it under --") TXT("-- terms of the GNU General Public License as published by the Free Soft- --") @@ -507,15 +513,10 @@ CND(SO_ERROR, "Get/clear error status") #endif CND(SO_BROADCAST, "Can send broadcast msgs") -#ifndef IP_ADD_MEMBERSHIP -#define IP_ADD_MEMBERSHIP -1 -#endif -CND(IP_ADD_MEMBERSHIP, "Join a multicast group") - -#ifndef IP_DROP_MEMBERSHIP -#define IP_DROP_MEMBERSHIP -1 +#ifndef IP_MULTICAST_IF +#define IP_MULTICAST_IF -1 #endif -CND(IP_DROP_MEMBERSHIP, "Leave a multicast group") +CND(IP_MULTICAST_IF, "Set/get mcast interface") #ifndef IP_MULTICAST_TTL #define IP_MULTICAST_TTL -1 @@ -526,10 +527,22 @@ CND(IP_MULTICAST_TTL, "Set/get multicast TTL") #define IP_MULTICAST_LOOP -1 #endif CND(IP_MULTICAST_LOOP, "Set/get mcast loopback") + +#ifndef IP_ADD_MEMBERSHIP +#define IP_ADD_MEMBERSHIP -1 +#endif +CND(IP_ADD_MEMBERSHIP, "Join a multicast group") + +#ifndef IP_DROP_MEMBERSHIP +#define IP_DROP_MEMBERSHIP -1 +#endif +CND(IP_DROP_MEMBERSHIP, "Leave a multicast group") + _NL TXT("end GNAT.Sockets.Constants;") -output (); + output (); + return 0; } void @@ -563,13 +576,14 @@ output (void) { } char * -itoa (char *fmt, int n) { +f_itoa (char *fmt, int n) { char buf[32]; sprintf (buf, fmt, n); return strdup (buf); } -void add_line (char *_text, char *_value, char *_comment) { +void +add_line (char *_text, char *_value, char *_comment) { struct line *l = (struct line *) malloc (sizeof (struct line)); l->text = _text; l->value = _value; diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 02e07526778..9b59832c0d4 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2005, 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- -- @@ -312,7 +312,6 @@ package body GPrep is null; end Obsolescent_Check; - --------------- -- Post_Scan -- --------------- diff --git a/gcc/ada/i-cexten.ads b/gcc/ada/i-cexten.ads index e1203ff9c49..c78303cf124 100644 --- a/gcc/ada/i-cexten.ads +++ b/gcc/ada/i-cexten.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994,1995 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -247,5 +247,4 @@ package Interfaces.C.Extensions is type Signed_32 is range -2 ** 31 .. 2 ** 31 - 1; for Signed_32'Size use 32; - end Interfaces.C.Extensions; diff --git a/gcc/ada/i-os2thr.ads b/gcc/ada/i-os2thr.ads index 0c3f3aa5503..0bee96980a6 100644 --- a/gcc/ada/i-os2thr.ads +++ b/gcc/ada/i-os2thr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1993-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1993-2005 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- -- @@ -91,7 +91,6 @@ pragma Preelaborate (Threads); function DosKillThread (Id : TID) return APIRET; pragma Import (C, DosKillThread, "DosKillThread"); - DCWW_WAIT : constant := 0; DCWW_NOWAIT : constant := 1; -- Values for "Option" parameter in DosWaitThread call diff --git a/gcc/ada/i-vxwork-x86.ads b/gcc/ada/i-vxwork-x86.ads index bbae9233813..e6edc14e743 100644 --- a/gcc/ada/i-vxwork-x86.ads +++ b/gcc/ada/i-vxwork-x86.ads @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ -- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- -- I N T E R F A C E S . V X W O R K S -- -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2004 Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2005, AdaCore -- -- -- -- 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- -- @@ -137,6 +137,10 @@ package Interfaces.VxWorks is -- user handler. The routine generates a wrapper around the user -- handler to save and restore context + function intContext return int; + -- Binding to the C routine intContext. This function returns 1 only + -- if the current execution state is in interrupt context. + function intVecGet (Vector : Interrupt_Vector) return VOIDFUNCPTR; -- Binding to the C routine intVecGet. Use this to get the @@ -200,6 +204,7 @@ private -- Target-dependent floating point context type pragma Import (C, intConnect, "intConnect"); + pragma Import (C, intContext, "intContext"); pragma Import (C, intVecGet, "intVecGet"); pragma Import (C, intVecSet, "intVecSet"); pragma Import (C, intVecGet2, "intVecGet2"); diff --git a/gcc/ada/i-vxwork.ads b/gcc/ada/i-vxwork.ads index fc1acb11e3b..0c2febc246d 100644 --- a/gcc/ada/i-vxwork.ads +++ b/gcc/ada/i-vxwork.ads @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ -- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- -- I N T E R F A C E S . V X W O R K S -- -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2005, AdaCore -- -- -- -- 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- -- @@ -138,6 +138,10 @@ package Interfaces.VxWorks is -- user handler. The routine generates a wrapper around the user -- handler to save and restore context + function intContext return int; + -- Binding to the C routine intContext. This function returns 1 only + -- if the current execution state is in interrupt context. + function intVecGet (Vector : Interrupt_Vector) return VOIDFUNCPTR; -- Binding to the C routine intVecGet. Use this to get the @@ -192,6 +196,7 @@ private -- Target-dependent floating point context type pragma Import (C, intConnect, "intConnect"); + pragma Import (C, intContext, "intContext"); pragma Import (C, intVecGet, "intVecGet"); pragma Import (C, intVecSet, "intVecSet"); pragma Import (C, INUM_TO_IVEC, "__gnat_inum_to_ivec"); diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 2053e3ea3ca..94b337a3d4d 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -63,7 +63,6 @@ package Makeutl is -- of project Project, in project tree In_Tree, and in the projects that -- it imports directly or indirectly, and returns the result. - -- Package Mains is used to store the mains specified on the command line -- and to retrieve them when a project file is used, to verify that the -- files exist and that they belong to a project file. diff --git a/gcc/ada/memroot.adb b/gcc/ada/memroot.adb index edfce668acd..4f515d27598 100644 --- a/gcc/ada/memroot.adb +++ b/gcc/ada/memroot.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 1997-2005, AdaCore -- -- -- -- 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- -- @@ -425,6 +425,7 @@ package body Memroot is pragma Warnings (Off, Line); procedure Find_File; + pragma Inline (Find_File); -- Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains -- the file name. The file name may not be on the current line since -- a frame may be printed on more than one line when there is a lot @@ -432,21 +433,21 @@ package body Memroot is -- lines of input. procedure Find_Line; + pragma Inline (Find_Line); -- Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains -- the line number. procedure Find_Name; + pragma Inline (Find_Name); -- Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains -- the subprogram name. function Skip_To_Space (Pos : Integer) return Integer; + pragma Inline (Skip_To_Space); -- Scans Line starting with position Pos, returning the position -- immediately before the first space, or the value of Last if no -- spaces were found - - pragma Inline (Find_File, Find_Line, Find_Name, Skip_To_Space); - --------------- -- Find_File -- --------------- diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 541f485665b..794c102a40e 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -811,7 +811,7 @@ package body MLib.Prj is (B_Start & Get_Name_String (Data.Library_Name) & ".adb"); Add_Argument ("-L" & Get_Name_String (Data.Library_Name)); - -- Check if Binder'Default_Switches ("Ada) is defined. If it is, + -- Check if Binder'Default_Switches ("Ada") is defined. If it is, -- add these switches to call gnatbind. declare diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index b10696dc863..916c667eb0a 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -120,7 +120,6 @@ package body Namet is end loop; end Add_Str_To_Name_Buffer; - -------------- -- Finalize -- -------------- @@ -314,7 +313,6 @@ package body Namet is Insert_Character (Character'Val (Hex (2))); end if; - -- WW (wide wide character insertion) elsif C = 'W' diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 3a3e5e03748..2434dd72005 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -61,7 +61,6 @@ package Namet is -- followed by an upper case letter (other than the WW -- sequence), or an underscore. - -- Operator symbols Stored with an initial letter O, and the remainder -- of the name is the lower case characters XXX where -- the name is Name_Op_XXX, see Snames spec for a full diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index d04ab20bd6f..f1c9c0fc0b7 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -119,8 +119,6 @@ package body Prj.Makr is is Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; - - Path_Name : String (1 .. File_Path'Length + Project_File_Extension'Length); Path_Last : Natural := File_Path'Length; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 7ccd5750cf3..e351f7a9ca4 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -2185,7 +2185,6 @@ package body Prj.Proc is Location_Of (From_Project_Node, From_Project_Node_Tree); - begin Project := Processed_Projects.Get (Name); diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads index 72a31edb1fd..902cabe85ab 100644 --- a/gcc/ada/repinfo.ads +++ b/gcc/ada/repinfo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2005 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- -- @@ -55,7 +55,7 @@ package Repinfo is -- For composite types, there are three cases: -- 1. In some cases the front end knows the values statically, - -- for example in the ase where representation clauses or + -- for example in the case where representation clauses or -- pragmas specify the values. -- 2. If Backend_Layout is True, then the backend is responsible diff --git a/gcc/ada/s-finimp.adb b/gcc/ada/s-finimp.adb index 0ef7443a3a8..6f40fa3f2cf 100644 --- a/gcc/ada/s-finimp.adb +++ b/gcc/ada/s-finimp.adb @@ -85,9 +85,6 @@ package body System.Finalization_Implementation is return SSE.Storage_Count; pragma Import (Ada, Parent_Size, "ada__tags__parent_size"); - function Parent_Tag (T : Ada.Tags.Tag) return Ada.Tags.Tag; - pragma Import (Ada, Parent_Tag, "ada__tags__parent_tag"); - function Get_Deep_Controller (Obj : System.Address) return RC_Ptr; -- Given the address (obj) of a tagged object, return a -- pointer to the record controller of this object. @@ -473,7 +470,7 @@ package body System.Finalization_Implementation is -- when there are no controller at this level while Offset = -2 loop - The_Tag := Parent_Tag (The_Tag); + The_Tag := Ada.Tags.Parent_Tag (The_Tag); Offset := RC_Offset (The_Tag); end loop; diff --git a/gcc/ada/s-restri.adb b/gcc/ada/s-restri.adb index be39f231831..da6d2856230 100644 --- a/gcc/ada/s-restri.adb +++ b/gcc/ada/s-restri.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 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- -- @@ -145,4 +145,3 @@ begin end loop; end Acquire_Restrictions; end System.Restrictions; - diff --git a/gcc/ada/s-restri.ads b/gcc/ada/s-restri.ads index fc0e3e93776..6aec4e2dd28 100644 --- a/gcc/ada/s-restri.ads +++ b/gcc/ada/s-restri.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 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- -- @@ -65,5 +65,3 @@ package System.Restrictions is -- must be False, and Max_Tasks must not be set to zero. end System.Restrictions; - - diff --git a/gcc/ada/s-tasinf.adb b/gcc/ada/s-tasinf.adb index 86aa5a4fa7e..9ad8bb0c82c 100644 --- a/gcc/ada/s-tasinf.adb +++ b/gcc/ada/s-tasinf.adb @@ -4,10 +4,10 @@ -- -- -- S Y S T E M . T A S K _ I N F O -- -- -- --- S p e c -- +-- B o d y -- -- (Compiler Interface) -- -- -- --- Copyright (C) 1998-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2005 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- -- @@ -40,5 +40,4 @@ -- implementation of the Task_Info pragma. package body System.Task_Info is - end System.Task_Info; diff --git a/gcc/ada/s-traent-vms.adb b/gcc/ada/s-traent-vms.adb index 532acad6e32..157c3e01137 100644 --- a/gcc/ada/s-traent-vms.adb +++ b/gcc/ada/s-traent-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -65,4 +65,3 @@ package body System.Traceback_Entries is end TB_Entry_For; end System.Traceback_Entries; - diff --git a/gcc/ada/s-traent-vms.ads b/gcc/ada/s-traent-vms.ads index 0d27c197fff..d79e20036f5 100644 --- a/gcc/ada/s-traent-vms.ads +++ b/gcc/ada/s-traent-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -56,4 +56,3 @@ package System.Traceback_Entries is function TB_Entry_For (PC : System.Address) return Traceback_Entry; end System.Traceback_Entries; - diff --git a/gcc/ada/s-traent.adb b/gcc/ada/s-traent.adb index a1437146ea1..27fe9c431b6 100644 --- a/gcc/ada/s-traent.adb +++ b/gcc/ada/s-traent.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -35,7 +35,6 @@ -- -- ------------------------------------------------------------------------------ - package body System.Traceback_Entries is ------------ diff --git a/gcc/ada/s-traent.ads b/gcc/ada/s-traent.ads index d0c0865561a..33e4dff0953 100644 --- a/gcc/ada/s-traent.ads +++ b/gcc/ada/s-traent.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -58,5 +58,3 @@ package System.Traceback_Entries is -- Returns an entry representing a frame for a call instruction at PC. end System.Traceback_Entries; - - diff --git a/gcc/ada/s-valint.adb b/gcc/ada/s-valint.adb index 9d8b6b1fbea..6e4b6eea1bc 100644 --- a/gcc/ada/s-valint.adb +++ b/gcc/ada/s-valint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -44,8 +44,7 @@ package body System.Val_Int is function Scan_Integer (Str : String; Ptr : access Integer; - Max : Integer) - return Integer + Max : Integer) return Integer is Uval : Unsigned; -- Unsigned result @@ -79,7 +78,6 @@ package body System.Val_Int is else return Integer (Uval); end if; - end Scan_Integer; ------------------- @@ -89,7 +87,6 @@ package body System.Val_Int is function Value_Integer (Str : String) return Integer is V : Integer; P : aliased Integer := Str'First; - begin V := Scan_Integer (Str, P'Access, Str'Last); Scan_Trailing_Blanks (Str, P); diff --git a/gcc/ada/s-vallli.adb b/gcc/ada/s-vallli.adb index 14ecb2b4172..56e830bd537 100644 --- a/gcc/ada/s-vallli.adb +++ b/gcc/ada/s-vallli.adb @@ -4,9 +4,9 @@ -- -- -- S Y S T E M . V A L _ L L I -- -- -- --- S p e c -- +-- B o d y -- -- -- --- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -44,8 +44,7 @@ package body System.Val_LLI is function Scan_Long_Long_Integer (Str : String; Ptr : access Integer; - Max : Integer) - return Long_Long_Integer + Max : Integer) return Long_Long_Integer is Uval : Long_Long_Unsigned; -- Unsigned result @@ -80,7 +79,6 @@ package body System.Val_LLI is else return Long_Long_Integer (Uval); end if; - end Scan_Long_Long_Integer; ----------------------------- @@ -95,7 +93,6 @@ package body System.Val_LLI is V := Scan_Long_Long_Integer (Str, P'Access, Str'Last); Scan_Trailing_Blanks (Str, P); return V; - end Value_Long_Long_Integer; end System.Val_LLI; diff --git a/gcc/ada/s-vallli.ads b/gcc/ada/s-vallli.ads index 7b5222069fb..3efb1d0c728 100644 --- a/gcc/ada/s-vallli.ads +++ b/gcc/ada/s-vallli.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -40,8 +40,7 @@ pragma Pure (Val_LLI); function Scan_Long_Long_Integer (Str : String; Ptr : access Integer; - Max : Integer) - return Long_Long_Integer; + Max : Integer) return Long_Long_Integer; -- This function scans the string starting at Str (Ptr.all) for a valid -- integer according to the syntax described in (RM 3.5(43)). The substring -- scanned extends no further than Str (Max). There are three cases for the diff --git a/gcc/ada/s-valllu.adb b/gcc/ada/s-valllu.adb index 2403e9d2337..bfb1b5dc94c 100644 --- a/gcc/ada/s-valllu.adb +++ b/gcc/ada/s-valllu.adb @@ -4,9 +4,9 @@ -- -- -- S Y S T E M . V A L _ L L U -- -- -- --- S p e c -- +-- B o d y -- -- -- --- Copyright (C) 1992-1997 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -43,8 +43,7 @@ package body System.Val_LLU is function Scan_Long_Long_Unsigned (Str : String; Ptr : access Integer; - Max : Integer) - return Long_Long_Unsigned + Max : Integer) return Long_Long_Unsigned is P : Integer; -- Local copy of the pointer @@ -286,8 +285,7 @@ package body System.Val_LLU is ------------------------------ function Value_Long_Long_Unsigned - (Str : String) - return Long_Long_Unsigned + (Str : String) return Long_Long_Unsigned is V : Long_Long_Unsigned; P : aliased Integer := Str'First; @@ -296,7 +294,6 @@ package body System.Val_LLU is V := Scan_Long_Long_Unsigned (Str, P'Access, Str'Last); Scan_Trailing_Blanks (Str, P); return V; - end Value_Long_Long_Unsigned; end System.Val_LLU; diff --git a/gcc/ada/s-valllu.ads b/gcc/ada/s-valllu.ads index 8311f524e08..c3a6c2bb378 100644 --- a/gcc/ada/s-valllu.ads +++ b/gcc/ada/s-valllu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -42,8 +42,7 @@ pragma Pure (Val_LLU); function Scan_Long_Long_Unsigned (Str : String; Ptr : access Integer; - Max : Integer) - return System.Unsigned_Types.Long_Long_Unsigned; + Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned; -- This function scans the string starting at Str (Ptr.all) for a valid -- integer according to the syntax described in (RM 3.5(43)). The substring -- scanned extends no further than Str (Max). There are three cases for the @@ -71,8 +70,7 @@ pragma Pure (Val_LLU); -- is greater than Max as required in this case. function Value_Long_Long_Unsigned - (Str : String) - return System.Unsigned_Types.Long_Long_Unsigned; + (Str : String) return System.Unsigned_Types.Long_Long_Unsigned; -- Used in computing X'Value (Str) where X is a modular integer type whose -- modulus exceeds the range of System.Unsigned_Types.Unsigned. Str is the -- string argument of the attribute. Constraint_Error is raised if the diff --git a/gcc/ada/s-valrea.adb b/gcc/ada/s-valrea.adb index 28f687e8ca2..0c5128e5dff 100644 --- a/gcc/ada/s-valrea.adb +++ b/gcc/ada/s-valrea.adb @@ -4,9 +4,9 @@ -- -- -- S Y S T E M . V A L _ R E A L -- -- -- --- S p e c -- +-- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -43,8 +43,7 @@ package body System.Val_Real is function Scan_Real (Str : String; Ptr : access Integer; - Max : Integer) - return Long_Long_Float + Max : Integer) return Long_Long_Float is procedure Reset; pragma Import (C, Reset, "__gnat_init_float"); @@ -369,7 +368,6 @@ package body System.Val_Real is return Uval; end if; end if; - end Scan_Real; ---------------- @@ -384,7 +382,6 @@ package body System.Val_Real is V := Scan_Real (Str, P'Access, Str'Last); Scan_Trailing_Blanks (Str, P); return V; - end Value_Real; end System.Val_Real; diff --git a/gcc/ada/s-valrea.ads b/gcc/ada/s-valrea.ads index 94e40584f59..2d01468f408 100644 --- a/gcc/ada/s-valrea.ads +++ b/gcc/ada/s-valrea.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -37,8 +37,7 @@ pragma Pure (Val_Real); function Scan_Real (Str : String; Ptr : access Integer; - Max : Integer) - return Long_Long_Float; + Max : Integer) return Long_Long_Float; -- This function scans the string starting at Str (Ptr.all) for a valid -- real literal according to the syntax described in (RM 3.5(43)). The -- substring scanned extends no further than Str (Max). There are three diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index b83be649810..3cbce8c5bd2 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -45,8 +45,8 @@ package body Scn is -- keyword as an identifier once for a given keyword). procedure Check_End_Of_Line; - -- Called when end of line encountered. Checks that line is not - -- too long, and that other style checks for the end of line are met. + -- Called when end of line encountered. Checks that line is not too long, + -- and that other style checks for the end of line are met. function Determine_License return License_Type; -- Scan header of file and check that it has an appropriate GNAT-style diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c index 15cda4fdbf4..c1ee9ca1ba4 100644 --- a/gcc/ada/seh_init.c +++ b/gcc/ada/seh_init.c @@ -36,7 +36,6 @@ #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" -#include <sys/stat.h> /* We don't have libiberty, so us malloc. */ #define xmalloc(S) malloc (S) diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 188190f05af..cc71e21f358 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -425,7 +425,6 @@ package body Sem_Dist is (Loc, New_External_Name ( Chars (User_Type), 'R')); - Full_Obj_Type : constant Entity_Id := Make_Defining_Identifier (Loc, Chars (Obj_Type)); diff --git a/gcc/ada/sem_elim.ads b/gcc/ada/sem_elim.ads index 4e9911f8850..50c46591a72 100644 --- a/gcc/ada/sem_elim.ads +++ b/gcc/ada/sem_elim.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2005 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- -- @@ -58,6 +58,4 @@ package Sem_Elim is -- subprogram. N is the node for the call, and E is the entity of -- the subprogram being eliminated. - - end Sem_Elim; diff --git a/gcc/ada/system-hpux-ia64.ads b/gcc/ada/system-hpux-ia64.ads new file mode 100644 index 00000000000..c507d972bfc --- /dev/null +++ b/gcc/ada/system-hpux-ia64.ads @@ -0,0 +1,153 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (HP-UX/ia64 Version) -- +-- -- +-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System is +pragma Pure (System); +-- Note that we take advantage of the implementation permission to make this +-- unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada 2005, this is +-- Pure in any case (AI-362). + + type Name is (SYSTEM_NAME_GNAT); + System_Name : constant Name := SYSTEM_NAME_GNAT; + + -- System-Dependent Named Numbers + + Min_Int : constant := Long_Long_Integer'First; + Max_Int : constant := Long_Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; + Max_Nonbinary_Modulus : constant := Integer'Last; + + Max_Base_Digits : constant := Long_Long_Float'Digits; + Max_Digits : constant := Long_Long_Float'Digits; + + Max_Mantissa : constant := 63; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.01; + + -- Storage-related Declarations + + type Address is private; + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := 64; + Memory_Size : constant := 2 ** 64; + + -- Address comparison + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + -- Other System-Dependent Declarations + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := High_Order_First; + + -- Priority-related Declarations (RM D.1) + + Max_Priority : constant Positive := 30; + Max_Interrupt_Priority : constant Positive := 31; + + subtype Any_Priority is Integer range 0 .. 31; + subtype Priority is Any_Priority range 0 .. 30; + subtype Interrupt_Priority is Any_Priority range 31 .. 31; + + Default_Priority : constant Priority := 15; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + -------------------------------------- + -- System Implementation Parameters -- + -------------------------------------- + + -- These parameters provide information about the target that is used + -- by the compiler. They are in the private part of System, where they + -- can be accessed using the special circuitry in the Targparm unit + -- whose source should be consulted for more detailed descriptions + -- of the individual switch values. + + AAMP : constant Boolean := False; + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := False; + Command_Line_Args : constant Boolean := True; + Compiler_System_Version : constant Boolean := False; + Configurable_Run_Time : constant Boolean := False; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Functions_Return_By_DSP : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + OpenVMS : constant Boolean := False; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := False; + Support_64_Bit_Divides : constant Boolean := True; + Support_Aggregates : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := False; + GCC_ZCX_Support : constant Boolean := False; + Front_End_ZCX_Support : constant Boolean := False; + + -- Obsolete entries, to be removed eventually (bootstrap issues!) + + High_Integrity_Mode : constant Boolean := False; + Long_Shifts_Inlined : constant Boolean := True; + +end System; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index afbb50a5a39..c3fda4a640f 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -628,7 +628,6 @@ package body Targparm is end loop; end if; - if Fatal then raise Unrecoverable_Error; end if; diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 7353c9fcff4..114d2a3ab9c 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -527,8 +527,7 @@ package body Uname is function New_Child (Old : Unit_Name_Type; - Newp : Unit_Name_Type) - return Unit_Name_Type + Newp : Unit_Name_Type) return Unit_Name_Type is P : Natural; diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads index 2439b9d4211..d96780a46c5 100644 --- a/gcc/ada/uname.ads +++ b/gcc/ada/uname.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1998, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -140,8 +140,7 @@ package Uname is function New_Child (Old : Unit_Name_Type; - Newp : Unit_Name_Type) - return Unit_Name_Type; + Newp : Unit_Name_Type) return Unit_Name_Type; -- Old is a child unit name (for either a body or spec). Newp is the -- unit name of the actual parent (this may be different from the -- parent in old). The returned unit name is formed by taking the diff --git a/gcc/ada/vxaddr2line.adb b/gcc/ada/vxaddr2line.adb index 6d79cfc5c48..35afbcc1766 100644 --- a/gcc/ada/vxaddr2line.adb +++ b/gcc/ada/vxaddr2line.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004 Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -83,6 +83,7 @@ procedure VxAddr2Line is type Architecture is (SOLARIS_I586, WINDOWS_POWERPC, + WINDOWS_I586, WINDOWS_M68K, SOLARIS_POWERPC, DEC_ALPHA); @@ -121,6 +122,11 @@ procedure VxAddr2Line is Nm_Binary => null, Addr_Digits_To_Skip => 0, Bt_Offset_From_Call => -4), + WINDOWS_I586 => + (Addr2line_Binary => null, + Nm_Binary => null, + Addr_Digits_To_Skip => 0, + Bt_Offset_From_Call => -2), SOLARIS_POWERPC => (Addr2line_Binary => null, Nm_Binary => null, diff --git a/gcc/ada/xeinfo.adb b/gcc/ada/xeinfo.adb index 272112d77b4..f48561446e4 100644 --- a/gcc/ada/xeinfo.adb +++ b/gcc/ada/xeinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -25,7 +25,7 @@ ------------------------------------------------------------------------------ -- Program to construct C header file a-einfo.h (C version of einfo.ads spec) --- for use by Gigi. This header file contaInF all definitions and access +-- for use by Gigi. This header file contains all definitions and access -- functions, but does not contain set procedures, since Gigi is not allowed -- to modify the GNAT tree) diff --git a/gcc/ada/xnmake.adb b/gcc/ada/xnmake.adb index e4802f2b2f3..bddbfc83f3e 100644 --- a/gcc/ada/xnmake.adb +++ b/gcc/ada/xnmake.adb @@ -283,8 +283,12 @@ begin end loop; end if; + -- Loop keeps going until "package" keyword written + exit when Match (Line, "package"); + -- Deal with WITH lines, writing to body or spec as appropriate + if Match (Line, Body_Only, M) then Replace (M, X); WriteB (Line); @@ -293,6 +297,8 @@ begin Replace (M, X); WriteS (Line); + -- Change header from Template to Spec and write to spec file + else if Match (Line, Templ, M) then Replace (M, A & " S p e c "); @@ -300,6 +306,8 @@ begin WriteS (Line); + -- Write header line to body file + if Match (Line, Spec, M) then Replace (M, A & "B o d y"); end if; diff --git a/gcc/ada/xsinfo.adb b/gcc/ada/xsinfo.adb index c6ade51f7a4..6e8948eca6f 100644 --- a/gcc/ada/xsinfo.adb +++ b/gcc/ada/xsinfo.adb @@ -88,9 +88,12 @@ procedure XSinfo is M : Match_Result; - procedure Getline; - -- Get non-comment, non-blank line. Also skips "for " rep clauses. + -- Get non-comment, non-blank line. Also skips "for " rep clauses + + ------------- + -- Getline -- + ------------- procedure Getline is begin diff --git a/gcc/ada/xsnames.adb b/gcc/ada/xsnames.adb index d93cfbd8d3e..5f80ac5ba89 100644 --- a/gcc/ada/xsnames.adb +++ b/gcc/ada/xsnames.adb @@ -24,10 +24,11 @@ -- -- ------------------------------------------------------------------------------ --- This utility is used to make a new version of the Snames package when --- new names are added to the spec, the existing versions of snames.ads and --- snames.adb are read, and updated to match the set of names in snames.ads. --- The updated versions are written to snames.ns and snames.nb (new spec/body) +-- This utility is used to make a new version of the Snames package when new +-- names are added to the spec, the existing versions of snames.ads and +-- snames.adb and snames.h are read, and updated to match the set of names in +-- snames.ads. The updated versions are written to snames.ns, snames.nb (new +-- spec/body), and snames.nh (new header file). with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; @@ -44,6 +45,8 @@ procedure XSnames is InS : File_Type; OutS : File_Type; OutB : File_Type; + InH : File_Type; + OutH : File_Type; A, B : VString := Nul; Line : VString := Nul; @@ -74,12 +77,90 @@ procedure XSnames is M : Match_Result; + type Header_Symbol is (None, Attr, Conv, Prag); + -- A symbol in the header file + + -- Prefixes used in the header file + + Header_Attr : aliased String := "Attr"; + Header_Conv : aliased String := "Convention"; + Header_Prag : aliased String := "Pragma"; + + type String_Ptr is access all String; + Header_Prefix : constant array (Header_Symbol) of String_Ptr := + (null, + Header_Attr'Access, + Header_Conv'Access, + Header_Prag'Access); + + -- Patterns used in the spec file + + Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1; + Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1; + Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1; + + type Header_Symbol_Counter is array (Header_Symbol) of Natural; + Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0); + + Header_Current_Symbol : Header_Symbol := None; + Header_Pending_Line : VString := Nul; + + ------------------------ + -- Output_Header_Line -- + ------------------------ + + procedure Output_Header_Line (S : Header_Symbol) is + begin + -- Skip all the #define for S-prefixed symbols in the header. + -- Of course we are making implicit assumptions: + -- (1) No newline between symbols with the same prefix. + -- (2) Prefix order is the same as in snames.ads. + + if Header_Current_Symbol /= S then + declare + Pat : String := "#define " & Header_Prefix (S).all; + In_Pat : Boolean := False; + + begin + if Header_Current_Symbol /= None then + Put_Line (OutH, Header_Pending_Line); + end if; + + loop + Line := Get_Line (InH); + + if Match (Line, Pat) then + In_Pat := true; + elsif In_Pat then + Header_Pending_Line := Line; + exit; + else + Put_Line (OutH, Line); + end if; + end loop; + + Header_Current_Symbol := S; + end; + end if; + + -- Now output the line + + Put_Line (OutH, "#define " & Header_Prefix (S).all + & "_" & Name1 & (30 - Length (Name1)) * ' ' + & Header_Counter (S)); + Header_Counter (S) := Header_Counter (S) + 1; + end Output_Header_Line; + +-- Start of processing for XSnames + begin Open (InB, In_File, "snames.adb"); Open (InS, In_File, "snames.ads"); + Open (InH, In_File, "snames.h"); Create (OutS, Out_File, "snames.ns"); Create (OutB, Out_File, "snames.nb"); + Create (OutH, Out_File, "snames.nh"); Anchored_Mode := True; Oname := Nul; @@ -99,6 +180,13 @@ begin if not Match (Line, Name_Ref) then Put_Line (OutS, Line); + if Match (Line, Get_Attr) then + Output_Header_Line (Attr); + elsif Match (Line, Get_Conv) then + Output_Header_Line (Conv); + elsif Match (Line, Get_Prag) then + Output_Header_Line (Prag); + end if; else Oval := Lpad (V (Val), 3, '0'); @@ -144,6 +232,13 @@ begin Put_Line (OutB, Line); while not End_Of_File (InB) loop - Put_Line (OutB, Get_Line (InB)); + Line := Get_Line (InB); + Put_Line (OutB, Line); + end loop; + + Put_Line (OutH, Header_Pending_Line); + while not End_Of_File (InH) loop + Line := Get_Line (InH); + Put_Line (OutH, Line); end loop; end XSnames; |