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 \
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 \
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 \
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 \
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 \
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 \
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 \
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
# 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,
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
-- 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.
-- 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
-- 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;
-
-
-- --
-- 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 --
-- --
------------------------------------------------------------------------------
-
with Ada.IO_Exceptions;
with System.Direct_IO;
with Interfaces.C_Streams;
-- --
-- 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 --
-- --
------------------------------------------------------------------------------
--- 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;
-- 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
-- --
-- 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- --
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
-- --
-- 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- --
Last_Chance_Handler (Excep.all);
end Unhandled_Exception_Terminate;
-
------------------------------------
-- Handling GNAT.Exception_Traces --
------------------------------------
-- --
-- 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 --
RI := RI + 1;
end loop;
end Ada.Strings.Less_Case_Insensitive;
-
-
-- --
-- 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 --
-- --
------------------------------------------------------------------------------
-
package Ada.Streams is
pragma Pure (Streams);
(Key : Wide_Wide_String) return Containers.Hash_Type;
pragma Pure (Ada.Strings.Wide_Wide_Hash);
-
-
-
-- --
-- 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 --
(AF.Controlled with
Character_Ranges'Unrestricted_Access);
-
Lower_Case_Mapping : aliased constant Wide_Character_Mapping_Values :=
(Length => 56,
(AF.Controlled with
Character_Ranges'Unrestricted_Access);
-
Lower_Case_Mapping : aliased constant Wide_Wide_Character_Mapping_Values :=
(Length => 56,
-- --
-- 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- --
(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.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
End_Line;
end if;
-
Write_Str
("| Use a subject line meaningful to you" &
" and us to track the bug.");
end;
end if;
-
-- If an exception occurrence is present, then we must declare it
-- and initialize it from the value stored in the TSD
Name_Buffer (Name_Len) := ASCII.NUL;
end if;
-
if Opt.Exception_Locations_Suppressed then
Name_Len := 0;
end if;
end if;
end On_Lhs_Of_Assignment;
-
end Exp_Smem;
-- --
-- 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- --
return;
end if;
-
Name_Len := Last - First + 1;
Name_Buffer (1 .. Name_Len) := SP (First .. Last);
Uname := Find_Name;
-- --
-- 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- --
end Bounded_Buffer;
-
end GNAT.Bounded_Buffers;
-- --
-- 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- --
sec : aliased C.long;
usec : aliased C.long;
-
begin
timeval_to_duration (T, sec'Access, usec'Access);
return Duration (sec) + Duration (usec) / Micro;
-- --
-- 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- --
-- 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;
-- --
-- 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- --
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;
-- -- not about the Constraint_Error exception being handled
-- -- by the current handler code.
-
end GNAT.Most_Recent_Exception;
-- 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- --
-- Expression_Error is raised if the given expression is not a legal
-- regular expression.
-
procedure Match
(Expression : String;
Data : String;
-- --
-- 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- --
-- --
-- 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- --
-- This is the Windows/NT version of this package
-
package GNAT.Sockets.Linker_Options is
private
pragma Linker_Options ("-lwsock32");
** **
** 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- **
#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;
#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) */
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("-- --")
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- --")
#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
#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
}
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;
-- --
-- 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- --
null;
end Obsolescent_Check;
-
---------------
-- Post_Scan --
---------------
-- --
-- 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- --
type Signed_32 is range -2 ** 31 .. 2 ** 31 - 1;
for Signed_32'Size use 32;
-
end Interfaces.C.Extensions;
-- --
-- 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- --
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
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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
-- 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");
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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
-- 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");
-- 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.
-- --
-- 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- --
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
-- 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 --
---------------
(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
end loop;
end Add_Str_To_Name_Buffer;
-
--------------
-- Finalize --
--------------
Insert_Character (Character'Val (Hex (2)));
end if;
-
-- WW (wide wide character insertion)
elsif C = 'W'
-- 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
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;
Location_Of
(From_Project_Node, From_Project_Node_Tree);
-
begin
Project := Processed_Projects.Get (Name);
-- --
-- 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- --
-- 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
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.
-- 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;
-- --
-- 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- --
end loop;
end Acquire_Restrictions;
end System.Restrictions;
-
-- --
-- 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- --
-- must be False, and Max_Tasks must not be set to zero.
end System.Restrictions;
-
-
-- --
-- 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- --
-- implementation of the Task_Info pragma.
package body System.Task_Info is
-
end System.Task_Info;
-- --
-- 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 --
end TB_Entry_For;
end System.Traceback_Entries;
-
-- --
-- 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 --
function TB_Entry_For (PC : System.Address) return Traceback_Entry;
end System.Traceback_Entries;
-
-- --
-- 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 --
-- --
------------------------------------------------------------------------------
-
package body System.Traceback_Entries is
------------
-- --
-- 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 --
-- Returns an entry representing a frame for a call instruction at PC.
end System.Traceback_Entries;
-
-
-- --
-- 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- --
function Scan_Integer
(Str : String;
Ptr : access Integer;
- Max : Integer)
- return Integer
+ Max : Integer) return Integer
is
Uval : Unsigned;
-- Unsigned result
else
return Integer (Uval);
end if;
-
end Scan_Integer;
-------------------
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);
-- --
-- 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- --
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
else
return Long_Long_Integer (Uval);
end if;
-
end Scan_Long_Long_Integer;
-----------------------------
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;
-- --
-- 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- --
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
-- --
-- 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- --
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
------------------------------
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;
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;
-- --
-- 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- --
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
-- 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
-- --
-- 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- --
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");
return Uval;
end if;
end if;
-
end Scan_Real;
----------------
V := Scan_Real (Str, P'Access, Str'Last);
Scan_Trailing_Blanks (Str, P);
return V;
-
end Value_Real;
end System.Val_Real;
-- --
-- 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- --
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
-- 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
#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)
(Loc, New_External_Name (
Chars (User_Type), 'R'));
-
Full_Obj_Type : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars (Obj_Type));
-- --
-- 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- --
-- subprogram. N is the node for the call, and E is the entity of
-- the subprogram being eliminated.
-
-
end Sem_Elim;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
end loop;
end if;
-
if Fatal then
raise Unrecoverable_Error;
end if;
-- --
-- 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- --
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;
-- --
-- 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- --
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
-- --
-- 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- --
type Architecture is
(SOLARIS_I586,
WINDOWS_POWERPC,
+ WINDOWS_I586,
WINDOWS_M68K,
SOLARIS_POWERPC,
DEC_ALPHA);
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,
-- --
-- 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- --
------------------------------------------------------------------------------
-- 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)
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);
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 ");
WriteS (Line);
+ -- Write header line to body file
+
if Match (Line, Spec, M) then
Replace (M, A & "B o d y");
end if;
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
-- --
------------------------------------------------------------------------------
--- 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;
InS : File_Type;
OutS : File_Type;
OutB : File_Type;
+ InH : File_Type;
+ OutH : File_Type;
A, B : VString := Nul;
Line : VString := Nul;
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;
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');
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;
projects / thirdparty / gcc.git / commitdiff
