[multiple changes]
2005-06-10 Arnaud Charlet <charlet@adacore.com> * Makefile.in: Add initialize.o when needed. Adapt to new VMS package body Symbols and subunits No specialized version of a-sytaco is needed for VxWorks. * a-wichun.ads, a-wichun.adb, a-zchuni.ads, a-zchuni.adb: New files. * a-zchara.ads, a-widcha.ads: New files. * system-hpux-ia64.ads: New file. * i-vxwork-x86.ads, i-vxwork.ads (intContext): Add this function which is imported from the VxWorks kernel. 2005-06-14 Robert Dewar <dewar@adacore.com> * g-soliop-mingw.ads, g-soccon-vms.adb, a-swmwco.ads, exp_smem.adb, fmap.adb, a-szmzco.ads, s-traent-vms.adb, s-traent-vms.ads, a-direio.ads, a-exctra.ads, a-exexda.adb, a-exextr.adb, a-stream.ads, s-restri.ads, s-restri.adb, s-traent.adb, s-traent.ads, a-slcain.adb, a-stzhas.ads, a-tiinau.adb, comperr.adb, exp_ch11.adb, g-boubuf.adb, g-calend.adb, g-debpoo.ads, g-moreex.ads, gprep.adb, g-regpat.ads, i-cexten.ads, i-os2thr.ads, makeutl.ads, memroot.adb, mlib-prj.adb, namet.adb, namet.ads, prj-makr.adb, prj-proc.adb, sem_dist.adb, sem_elim.ads, s-valint.adb, s-vallli.adb, s-vallli.adb, s-vallli.ads, s-valllu.adb, s-valllu.ads, s-valrea.adb, s-valrea.ads, scn.adb, s-tasinf.adb, targparm.adb, uname.adb, uname.ads, xnmake.adb, xsinfo.adb, a-direct.ads: Remove extra blank lines. Minor reformatting. 2005-06-14 Thomas Quinot <quinot@adacore.com> * xeinfo.adb: Fix typo in comment 2005-06-14 Javier Miranda <miranda@adacore.com> * repinfo.ads: Fix typo in comment 2005-06-14 Gary Dismukes <dismukes@adacore.com> * s-finimp.adb (Parent_Tag): Delete this imported function (function Parent_Tag is now in the visible part of Ada.Tags). (Get_Deep_Controller): Call Ada.Tags.Parent_Tag directly instead of using imported function. 2005-06-14 Bernard Banner <banner@adacore.com> * vxaddr2line.adb: Add support for Windows hosted x86 vxworks. Should also apply for handling support for VxSim 653. 2005-06-14 Eric Botcazou <ebotcazou@adacore.com> * xsnames.adb: Add automatic generation of snames.h. 2005-06-14 Thomas Quinot <quinot@adacore.com> * gen-soccon.c: Add IP_MULTICAST_IF constant Minor reformatting and adjustments to prevent warnings. 2005-06-14 Pascal Obry <obry@adacore.com> * seh_init.c: Do not include <sys/stat.h>. This is not needed. From-SVN: r101072
This commit is contained in:
Arnaud Charlet
parent
0453ca3d72
commit
84fdd8a35e
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 --
|
||||
------------------------------------
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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,
|
||||
|
||||
|
||||
@ -182,7 +182,6 @@ private
|
||||
(AF.Controlled with
|
||||
Character_Ranges'Unrestricted_Access);
|
||||
|
||||
|
||||
Lower_Case_Mapping : aliased constant Wide_Wide_Character_Mapping_Values :=
|
||||
(Length => 56,
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
167
gcc/ada/a-wichun.adb
Executable file
167
gcc/ada/a-wichun.adb
Executable file
@ -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;
|
||||
190
gcc/ada/a-wichun.ads
Executable file
190
gcc/ada/a-wichun.ads
Executable file
@ -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;
|
||||
21
gcc/ada/a-widcha.ads
Executable file
21
gcc/ada/a-widcha.ads
Executable file
@ -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;
|
||||
18
gcc/ada/a-zchara.ads
Executable file
18
gcc/ada/a-zchara.ads
Executable file
@ -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;
|
||||
167
gcc/ada/a-zchuni.adb
Executable file
167
gcc/ada/a-zchuni.adb
Executable file
@ -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;
|
||||
188
gcc/ada/a-zchuni.ads
Executable file
188
gcc/ada/a-zchuni.ads
Executable file
@ -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;
|
||||
@ -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.");
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -492,5 +492,4 @@ package body Exp_Smem is
|
||||
end if;
|
||||
end On_Lhs_Of_Assignment;
|
||||
|
||||
|
||||
end Exp_Smem;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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- --
|
||||
|
||||
@ -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");
|
||||
|
||||
@ -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
|
||||
#ifndef IP_MULTICAST_IF
|
||||
#define IP_MULTICAST_IF -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")
|
||||
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;
|
||||
|
||||
@ -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 --
|
||||
---------------
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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");
|
||||
|
||||
@ -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");
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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 --
|
||||
---------------
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -2185,7 +2185,6 @@ package body Prj.Proc is
|
||||
Location_Of
|
||||
(From_Project_Node, From_Project_Node_Tree);
|
||||
|
||||
|
||||
begin
|
||||
Project := Processed_Projects.Get (Name);
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
------------
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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));
|
||||
|
||||
@ -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;
|
||||
|
||||
153
gcc/ada/system-hpux-ia64.ads
Normal file
153
gcc/ada/system-hpux-ia64.ads
Normal file
@ -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;
|
||||
@ -628,7 +628,6 @@ package body Targparm is
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
if Fatal then
|
||||
raise Unrecoverable_Error;
|
||||
end if;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user